javierma
asked on
Transparent window
I've wasted one whole day trying to create a stupid aplication with just a form (BorderStyle=0) and a command button. I want the form to turn transparent when I click the button. Using SetWindowLong I make the form transparent but for it to show its transparency I need to cover and uncover it.
I tried: sending WM_PAINT to force redrawing, using UpdateWindow, Invalidating the window; and Nothing.
I prevented the WM_ERASEBKGND message to be sent to the form.
I tried: sending WM_PAINT to force redrawing, using UpdateWindow, Invalidating the window; and Nothing.
I prevented the WM_ERASEBKGND message to be sent to the form.
ASKER
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
https://www.experts-exchange.com/comp/lang/visualbasic/Q.10153378
ASKER
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(Pictur e1) 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
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)"
http://www.vb-helper.com/
Look under "HowTo"/"Advanced" and get:
"Make a form with a transparent background (3K)"
ASKER
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.
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.
ASKER
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'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
ASKER
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...
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...
ASKER
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
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
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
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
ASKER
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
Thanks again
Javier M
' 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.Le
hFrame = CreateRectRgn(rctFrame.Lef
'// 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