Transparent Form: Done differently by capturing form !

[Boleeman]

LV and myself have done it a different way by capturing underneath.

I tried doing layering the VB6 way but the form was always see through when clicking.

Find it a bit funny that good old VB6 could create and draw to a glass/transparent layer but Lazarus was not able to have the same click on glass layer behavior. Still searching for a way to tell Lazarus "if the layer is totally transparent then make an exception and draw to it" like VB6 does.

In Lazarus I came close to it, but the layer is slightly "frosty glass" in appearance.
(see last png attachment in this 1st message)













Hi All.

I have been wanting to create a Transparent Form where you Show All Controls
but the form is Not Click Through. The program like an overlayed tracing app.

I have found some code by KodeZwerg that Shows all Controls on the transparent form but when clicking on the transparent part I need to NOT click through the form but CLICK and DRAG ONTO IT (as I want to draw on it).

I have an old VB6 code that does it well that uses vbCyan as a Chroma Key to make the form perfectly transparent, but I can't seem to work out how to not click through the transparent form in Lazarus?
(the VB6 code uses api, I had to remove the VB6  Dialogue control as it did not work in Windows 10).
I have attached the VB6 source just in case someone wants to look at the original VB6 source.

What I was wanting to achieve is to use Lazarus to create a resizable and moveable transparent form that can be clicked onto, with the controls fully showing.

Not sure if TBgrabmp or TBGRAVirtualScreen might be better to use?

Hopefully someone can possibly help me out, as I seem to be stuck on being able to NOT CLICK THROUGH the Transparent Form but click onto it?

[circular]

Hi Boleeman,

There are two approaches I can imagine:
- To have the background of the form not totally transparent but a very transparent gray like BGRA(192, 192, 192, 1)
- To make a copy of the area of the screen and draw it inside the form, so the form would not be transparent, at least when you would like the user to draw

Regards

[Fred vS]

Hello.

I think that you can do it with MSEgui: https://github.com/mse-org/mseide-msegui/discussions/52

[Boleeman]

Thanks Guys for replying. I will try a few suggested things out.

Circular, I found a Lazarus sample code that uses in Form1:
  AlphaBlend := True;
  AlphaBlendValue := 10;  // set to 1 if no background is needed
  BorderStyle := bsNone;

and in Form 2 it uses a fixed array of 13 points arrPts: array[0..12] of TPoint;  to cut off everything outside the polygon but fully show the controls, with the transparent Form1 not click through.

which is similar to what you suggested:
have the background of the form not totally transparent but a very transparent gray like BGRA(192, 192, 192, 1) but uses AlphaBlendValue := 10; instead of 1.


Fred vS, I downloaded mseuniverse with that MSEgui example. I was always curious about MSEgui. I know it makes GUI's but never really used it but will also have a play with that new shape in optionswindow: wo_transparentbackground. Sounds interesting. Also read up about Martin Schreiber in the Biography of Martin. Very intelligent.


I also found a Lazarus example on the forum that uses a similar SetLayeredWindowAttributes api:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLType, LCLIntf;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     procedure FormCreate(Sender: TObject);
17.   private
18.  
19.   public
20.  
21.   end;
22.  
23. const
24.       LWA_COLORKEY = 1;
25.       LWA_ALPHA = 2;
26.       LWA_BOTH = 3;
27.       WS_EX_LAYERED = $80000;
28.       GWL_EXSTYLE = -20;
29.  
30. var
31.   Form1: TForm1;
32.  
33. implementation
34.  
35. {$R *.lfm}
36.  
37. {Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal Color As Long, ByVal X As Byte, ByVal alpha As Long) As Boolean }
38. function SetLayeredWindowAttributes(hWnd: longint; Color: longint;
39.   X: byte; alpha: longint): bool stdcall; external 'USER32';
40.  
41. {not sure how to alias these functions here ????   alias setwindowlonga!!}
42. {Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long }
43. function SetWindowLongA(hWnd: longint; nIndex: longint;
44.   dwNewLong: longint): longint stdcall; external 'USER32';
45.  
46. {Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long }
47. function GetWindowLongA(hWnd: longint; nIndex: longint): longint stdcall;
48.   external 'user32';
49.  
50. procedure SetTranslucent(ThehWnd: longint; Color: longint; nTrans: integer);
51. var
52.   Attrib: longint;
53. begin
54.   {SetWindowLong and SetLayeredWindowAttributes are API functions, see MSDN for details }
55.   Attrib := GetWindowLongA(ThehWnd, GWL_EXSTYLE);
56.   SetWindowLongA(ThehWnd, GWL_EXSTYLE, attrib or WS_EX_LAYERED);
57.   {anything with color value color will completely disappear if flag = 1 or flag = 3  }
58.   SetLayeredWindowAttributes(ThehWnd, Color, nTrans, 1);
59. end;
60.  
61. procedure TForm1.FormCreate(Sender: TObject);
62. var
63.   Transparency: longint;
64. begin
65.   Self.Color := clRed;
66.   Transparency := Self.Color;
67.   SetTranslucent(Self.Handle, Transparency, 0);
68. end;
69.  
70.  
71. end.

Looking at it and comparing it to the VB6 code:

Code: Pascal  [Select][+][-]

1.  ' Window Style
2. Public Const GWL_STYLE = (-16)
3. Public Const WS_SYSMENU = &H80000
4. Public Const WS_MINIMIZEBOX = &H20000
5. Private Const GWL_EXSTYLE = (-20)
6. Private Const WS_EX_LAYERED = &H80000
7.    
8. ' Transparency
9. Private Const LWA_COLORKEY = &H1
10. Private Const LWA_ALPHA = &H2
11.  
12. ' Mouse Capture
13. Public Const WM_NCLBUTTONDOWN = &HA1
14. Public Const HTCAPTION = 2
15.  
16. ' Window Position
17. Private Const GW_HWNDNEXT = 2
18.  
19. Public hTaskBar As Long
20.  
21. Public Sub SetTrans(oForm As Form, Optional bytAlpha As Byte = 255, Optional lColor As Long = 0)
22.     Dim lStyle As Long
23.     lStyle = GetWindowLong(oForm.hWnd, GWL_EXSTYLE)
24.     If Not (lStyle And WS_EX_LAYERED) = WS_EX_LAYERED Then _
25.         SetWindowLong oForm.hWnd, GWL_EXSTYLE, lStyle Or WS_EX_LAYERED
26.     SetLayeredWindowAttributes oForm.hWnd, lColor, bytAlpha, LWA_COLORKEY Or LWA_ALPHA
27. End Sub     Private Sub Form_Load()
28.     Set fEvents = frmBlank
29.    
30.     ' ShowInTaskBar
31.    SetWindowLong Me.hWnd, GWL_STYLE, GetWindowLong(Me.hWnd, GWL_STYLE) Or WS_SYSMENU Or WS_MINIMIZEBOX
32.    
33.    ' Set Transparency Colour
34.     Me.BackColor = vbCyan
35.     SetChildColour Me.BackColor
36.    
37.     ' Set Transparency
38.    SetTrans Me, , Me.BackColor
39.    SetTrans fEvents, 1
40.    ' If the mouse-clicks are passing through then try increasing the number
41.     ' e.g. SetTrans fEvents, 5
42.    
43.    'Center
44.     Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
45.     PopulateControls
46.        
47.     Me.Show
48.     ltbID = GetAppsID(Me.Caption)
49.     fEvents.Show
50.     Me.ZOrder
51. End Sub
52.  
53. Private Sub Form_Unload(Cancel As Integer)
54.     Me.Visible = False
55.     fEvents.Visible = False
56.     SetTrans Me
57.     SetTrans fEvents
58.     Unload fEvents
59.     Set fEvents = Nothing
60.     Set picUndo = Nothing
61. End Sub
62.  
63. ' General
64. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
65.    ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
66.    
67. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
68.    ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
69.    
70. ' Process And Memory
71. Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
72.     ByVal hWnd As Long, lpdwProcessId As Long) As Long
73.    
74. Private Declare Function OpenProcess Lib "kernel32" ( _
75.     ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
76.    
77. Private Declare Function CloseHandle Lib "kernel32" ( _
78.     ByVal hObject As Long) As Long
79.    
80. Private Declare Function VirtualFreeEx Lib "kernel32" ( _
81.     ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
82.    
83. Private Declare Function VirtualAllocEx Lib "kernel32" ( _
84.     ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, _
85.     ByVal flProtect As Long) As Long
86.    
87. Private Declare Function ReadProcessMemory Lib "kernel32" ( _
88.     ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, _
89.     Optional lpNumberOfBytesWritten As Long) As Long
90.  
91. ' Setting Window Style
92. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
93.    ByVal hWnd As Long, ByVal nIndex As Long) As Long
94.  
95. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
96.    ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
97.  
98. ' Transparency
99. Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
100.     ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
101.  
102. ' Control Position
103. Private Declare Function GetWindowRect Lib "user32" ( _
104.    ByVal hWnd As Long, lpRect As RECT) As Long
105.  
106. Private Declare Function ClientToScreen Lib "user32" ( _
107.    ByVal hWnd As Long, lpPoint As POINTAPI) As Long
108.  
109. ' Window Position
110. Private Declare Function GetWindow Lib "user32" ( _
111.     ByVal hWnd As Long, ByVal wCmd As Long) As Long
112.  
113. ' Mouse Capture
114. Public Declare Function ReleaseCapture Lib "user32" () As Long
115. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

As the Lazarus parts look similar to the VB6 api code I might be able to replicate the VB6 form transparency behaviour.

Attached below is the VB6 source in a text file, with the form code and module code that contains the api.

The vb6 code uses     Me.BackColor = vbCyan and SetChildColour Me.BackColor and  SetTrans fEvents, 1

The Lazarus code uses   Self.Color := clRed; and Transparency := Self.Color; and SetTranslucent(Self.Handle, Transparency, 0); 

[Fred vS]

Fred vS, I downloaded mseuniverse with that MSEgui example. I was always curious about MSEgui. I know it makes GUI's but never really used it but will also have a play with that new shape in optionswindow: wo_transparentbackground. Sounds interesting. Also read up about Martin Schreiber in the Biography of Martin. Very intelligent.

Hello Boleeman.

Yes, Martin is a extremely precious gem.

MSEgui is also fully compatible with BGRAbitmap, I  used some of your great code for a MSEgui app (see picture).

[Boleeman]

I have tried working on the VB6 Transparent Form conversion

Got Some Things Working OK and Others Not !

Consists of 2 Forms (Rendering and EventForm)

Working:
Got it Transparent.
On Top working.
Sizing and Moving Corner Controls are working.
Other controls are visible and aligned to left side.

Not Working:
Clicking onto canvas goes through Form.
Drawing lines and shapes onto canvas not rendering/working.

Attached below is what I have.

Perhaps someone else might be able to fix those faulty "needed features" so we get some rendering?

Screenshot is of Lazarus version showing transparency. Drawing features not working. Frustrating!

[Xenno]

Snippet below can make transparent form excluding title bar. Perhaps, it could help somehow.

Code: Pascal  [Select][+][-]

1. uses Windows;
2.  
3. procedure PrcTransparentForm(PrmForm: TForm; PrmClr: TColor);
4. begin
5.   PrmForm.Color := PrmClr; // unique mask color
6.   SetWindowLong(PrmForm.Handle, GWL_EXSTYLE,
7.       GetWindowLong(PrmForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
8.   SetLayeredWindowAttributes(PrmForm.Handle, PrmClr, 255, LWA_COLORKEY);
9. end;

[Boleeman]

Thanks Xenno.

Yes that is transparent, but it clicks through the form rather than onto it.

I am trying to work out how NOT to click through the form

[Xenno]

How about adding a "restricted area"?
Intercept WM_MOUSEMOVE and kick the cursor out when it was entering it.

[LV]

I believe you are looking for something like this. 🤔

[LV]

Oh, I forgot to attach the code. It was tested on Windows 11, using Laz 3.4 and FPC 3.2.2.

P.S. Essentially, what @circular mentioned earlier has been implemented here.
"To make a copy of the area of the screen and draw it inside the form, so the form would not be transparent, at least when you would like the user to draw"

[Boleeman]

Thanks LV for your sample code.
Believe it or not, I was doing something similar. Great minds think alike !

I sort of call it "the cheaters mode" as it really is capturing what is below, rather than having a floating layer.

I really wanted another invisible layer to be drawn on top, but beggars can't be choosers.

As the Lazarus form is fully maximized, use Alt F4 to exit out of program Probably need to set up a shortcut).

In the text mode, I wanted to add a blinking text but it was buggy.
Can change to size and color of the text, but perhaps angling would be nice.

Press Ctrl when drawing rectangles and ellipses makes them squares and circles.
Can also fill rectangles and ellipses.

I think the best way of loading the program is display what you want on desktop and have a shortcut in the taskbar to start the program.

Poly and Erase still to be done.
Undo needs some work.

Not sure why, but when doing text characters appear in the text size TSpinEdit seSize?
(seen in the screenshot)


Enjoy !

[LV]

I sort of call it "the cheaters mode"

I would call it the "David Copperfield mode". 😁