Transparent window

I found some code and tested it. Just make your border style to 0. '***************************************************************
' Name: Make Form Transparent.
' Description:Makes a Form Trans Parent
' By: Kalani COM
'(http://www.PlanetSourceCode.com)



Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long


Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long


Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long


Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long


Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long


Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
    Public Const RGN_AND = 1
    Public Const RGN_COPY = 5
    Public Const RGN_DIFF = 4
    Public Const RGN_OR = 2
    Public Const RGN_XOR = 3


Type POINTAPI
    x As Long
    Y As Long
    End Type


Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type
Public Sub MakeTransparent(frm As Form)

    'This code was takin from a AOL Visual Basic
    'Message Board. It was submited by: SOOPRcow
    Dim rctClient As RECT, rctFrame As RECT
    Dim hClient As Long, hFrame As Long
    '// Grab client area and frame area
    GetWindowRect frm.hWnd, rctFrame
    GetClientRect frm.hWnd, rctClient
    '// Convert client coordinates to screen coordinates
    Dim lpTL As POINTAPI, lpBR As POINTAPI
    lpTL.x = rctFrame.Left
    lpTL.Y = rctFrame.Top
    lpBR.x = rctFrame.Right
    lpBR.Y = rctFrame.Bottom
    ScreenToClient frm.hWnd, lpTL
    ScreenToClient frm.hWnd, lpBR
    rctFrame.Left = lpTL.x
    rctFrame.Top = lpTL.Y
    rctFrame.Right = lpBR.x
    rctFrame.Bottom = lpBR.Y
    rctClient.Left = Abs(rctFrame.Left)
    rctClient.Top = Abs(rctFrame.Top)
    rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
    rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
    rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
    rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
    rctFrame.Top = 0
    rctFrame.Left = 0
    '// Convert RECT structures to region handles
    hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
    hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
    '// Create the new "Transparent" region
    CombineRgn hFrame, hClient, hFrame, RGN_XOR
    '// Now lock the window's area to this created region
    SetWindowRgn frm.hWnd, hFrame, True
End Sub


On your form put a command button and call it

Private Sub Command1_Click()
Call MakeTransparent(Me)
End Sub

Ok this is very close but (there's always a but) the command button has to remain visible so that when clicked again togles the transparency

OK,if that's the case then save yourself the points, see question:

https://www.experts-exchange.com/comp/lang/visualbasic/Q.10153378

I copied Waty's module (from the other question) in a new proyect with a form, a command button and a picture control. The picture control was covering half the command button. I archieved the same optical results using MakeFormTransparent(Picture1) or Picture1.Visible = False. Also if I modify the function so that it accepts forms the command button disapears.

You have to play whith the transparency of the form

Save points reading an EE answered question. Try:
http://www.vb-helper.com/
Look under "HowTo"/"Advanced" and get:
     "Make a form with a transparent background (3K)"

bhamilto, this example works good. The problem is that all the aproachs given here make the form holow, like a frame. When you click the "transparent" part what is below the window receives the click. If a form really is transparent you can "see" through the window but when you click it is the transparent window who reacts.

For this to happen is necesary to set the WS_EX_TRANSPARENT bit for the windows.
Try this example and then answer my question:
****** In a bass module *******
     Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex as Long)
     Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex as Long, ByVal dwNewLong as Long)

****************************


******** In a form *********
Private Sub Form_Initialize()
     Dim Back as Long

     Const GWL_EXSTYLE& = (-20)
     Const WS_EX_TRANSPARENT& = &H20&

     Back = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
     Back = Back Or WS_EX_TRANSPARENT
     Back = SetWindowLong(Me.hWnd, GWL_EXSTYLE, Back)

End Sub
************************

After running the project cover and uncover the form, notice somethig diferent?
Even try addin a button to see the efect of a floating control.

Adjusted points to 100

javierma

I've had some experience changing form style bits for modifying border styles and the title bar but never played with the transparency bit. In my experience one or both of two things were sometimes required to make a style change take effect:

SetWindowPos - Frequently (but not always) required to effect the change.

Visible      - Making the form invisible before the style change and restoring the visibility after the change was required to effect a form title style change (e.g. change to "Tool window style"). This was annoying because the form flickers.

I also found that you can get inconsistent behaviour in compiled vs IDE operation. As I recall, compiling to PCode was more likely to work the same as the IDE.

I added Command1 button, moved your code to a Command1_Click and went from there.
I tried the following changes to your code and it seemed to do the right thing:

**** Add to Form General (or modify for the Bas) ****

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal _
hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long

Private Enum SetWindowPosStyles
    SWP_FRAMECHANGED = &H20
    SWP_NOMOVE = &H2
    SWP_NOREPOSITION = &H200
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
End Enum

******************************************************
**** Append SetWindowPos to Command1_Click ****

    Back = SetWindowLong(Me.hWnd, GWL_EXSTYLE, Back)  ' Existing code
   
    SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or _
                              SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED

I used your code and it was very useful, I played with it until I got it working the way I wanted. I know there is a smarter way to do it and that is emulating all the messages that are sent to the transparent window when it's covered and uncovered by other window. This way I won need to togle the visibility property or use the SetWindowPos. Anyway, your code did work and there are 100 points wanting for you. There is also a 20 point bonus if you (or anyone) find that smart way for a grand total of 120 juicy points, cool huh?. So want me to give you more time for the extra points? say 1-2 weeks. While you think about it check this code to see what I wanted.

Option Explicit
Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Enum SetWindowPosStyles
    SWP_FRAMECHANGED = &H20
    SWP_NOMOVE = &H2
    SWP_NOREPOSITION = &H200
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
End Enum
Private Sub Command1_Click()
    Dim Back As Long
    Const GWL_EXSTYLE& = (-20)
    Const WS_EX_TRANSPARENT& = &H20&

    Back = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
    If Back And WS_EX_TRANSPARENT Then
        Me.Visible = False
        Back = Back And Not WS_EX_TRANSPARENT
        Back = SetWindowLong(Me.hwnd, GWL_EXSTYLE, Back)
        Me.Visible = True
    Else
        Back = Back Or WS_EX_TRANSPARENT
        Back = SetWindowLong(Me.hwnd, GWL_EXSTYLE, Back)
        SetWindowPos hwnd, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED

    End If
End Sub

Thanks for your help and hope anyone finds the smart way...

I forgot, try to make the code above work for a PictureBox cause it only works for a form (I thought it could be the same for both).

javierma

I checked your code and it works fine.

I'm not sure what you mean by "the smart way". At a guess, sending window messages to emulate the above code will take far more code than this solution. What is the advantage?

What are you trying to do with the picture box? Do you want the form (or whatever container to show through) or do you want a hole in the form. (this really is a totally separate question by the way)

Regards - Bob Hamilton

javierma

Seperate question or not I was curious about why this wouldn't work for a picture box.
I added a picture box and replaced "Me" with "Picture1". This works fine if you simply want the form to show (not a hole in the form). I also added a picture to the form and you need to append DoEvents and force a paint with Refresh to make the picture show.

So are you trying to make a hole in the frame?

Regards - Bob Hamilton

Option Explicit
Public ContinueRunning As Boolean

Type WNDCLASS
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type

Type POINTAPI
        x As Long
        y As Long
End Type

Type MSG
    hwnd As Long
    message As Long
    wParam As Long

    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Type PAINTSTRUCT
        hdc As Long
        fErase As Long
        rcPaint As RECT
        fRestore As Long
        fIncUpdate As Long
        rgbReserved As Byte
End Type

Public Const WM_DESTROY = &H2
Public Const WM_PAINT = &HF
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000

Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const CS_HREDRAW = &H2
Public Const CS_VREDRAW = &H1
Public Const IDI_APPLICATION = 32512&
Public Const IDC_ARROW = 32512&
Public Const GRAY_BRUSH = 2
Public Const CW_USEDEFAULT = &H80000000

Public Const DT_SINGLELINE = &H20
Public Const DT_CENTER = &H1
Public Const DT_VCENTER = &H4
Public Const SW_SHOWNORMAL = 1
Public Const TRANSPARENT = 1
Public Const GWL_USERDATA = (-21)

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long

Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub Main()
    Dim WindowClass As WNDCLASS
    Const szAppName = "OFWin"
    Dim hwnd As Long
    Dim inMsg As MSG
   
    ContinueRunning = True
   
    '// Redraw the window if the size changes
    WindowClass.style = CS_HREDRAW Or CS_VREDRAW

    '// Define our procedure for message handling
    WindowClass.lpfnWndProc = AddrOf(AddressOf WindowProc)

    WindowClass.cbClsExtra = 0
    WindowClass.cbWndExtra = 0

    WindowClass.hInstance = App.hInstance

    '// Set default application icon
    WindowClass.hIcon = LoadIcon(0, IDI_APPLICATION)

    '// Set window cursor to be the standard arrow
    WindowClass.hCursor = LoadCursor(0, IDC_ARROW)

    '// Set gray brush for background color
    WindowClass.hbrBackground = GetStockObject(GRAY_BRUSH)

    WindowClass.lpszMenuName = 0

    WindowClass.lpszClassName = szAppName

    '// Now register our window class
    Call RegisterClass(WindowClass)

    '// Now we can create the window
    hwnd = CreateWindowEx(0&, szAppName, "A Basic Window the hard way", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, App.hInstance, 0)

    Call ShowWindow(hwnd, SW_SHOWNORMAL)
    Call UpdateWindow(hwnd)

    '// Keep the Program running untill we want to quit.

    While ContinueRunning
        DoEvents
    Wend
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hdc As Long
    Dim PaintSt As PAINTSTRUCT
    Dim aRect As RECT

    Select Case message
        Case WM_PAINT
            hdc = BeginPaint(hwnd, PaintSt)

            '// Get the upper left and lower right of client area
            Call GetClientRect(hwnd, aRect)

            Call SetBkMode(hdc, TRANSPARENT)

            '// Now draw the text in the window client area
            Call DrawText(hdc, "But, soft! What light through yonder window breaks?", -1, aRect, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)

            Call EndPaint(hwnd, PaintSt)
            WindowProc = 0

        Case WM_DESTROY
            ContinueRunning = False ' End the program.
            WindowProc = 0

        Case Else
            WindowProc = DefWindowProc(hwnd, message, wParam, lParam)

    End Select
End Function

' This may seem wierd to do this but this is the only way I could get the value from the AddressOf operator into a variable.
Function AddrOf(lpFunction As Long) As Long
    AddrOf = lpFunction
End Function

see https://www.experts-exchange.com/comp/lang/visualbasic/Q.10153378

Inteqan, the answer from Q.10153378 doesn't work. I'll check your code right away

bhamilton, don't worry the 100 points are yours, after all you did answer what I asked. What I'm trying to do is simulate Vb developing environment. To do it I'm intercepting the mouse down and moving a transparent picturebox over the control and drawing 8 squares just as Vb does. By using a transparent picture I can easily draw over the control and the form in one line. I got this from a book. I checked that the functions are working (they return true) but the picturebox does not turn transparent. I put a second button underneath and when I click the 1st command button I don't see the 2nd.

If you what your points right away I'll make another question for the picture. Just let me know...

Javier M

Ladies and Gentelmen we have a winner!!! . And he get's the bonus points also congratulations. No kidding thanks everyone who helped me out here specially Bob.

                        Thanks again

        Javier M