Author: Jonas Bilinkevicius
How to create transparent menus
Answer:
This works only for Win 2000 and XP:
1 { ... }
2 var
3 hHookID: HHOOK;
4
5 {Function to make the menu transparent }
6
7 function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean;
8 type
9 TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte;
10 dwFlags: Longint): Longint; stdcall;
11 const
12 {Use crKey as the transparency color}
13 LWA_COLORKEY = 1;
14 {Use bAlpha to determine the opacity of the layered window}
15 LWA_ALPHA = 2;
16 WS_EX_LAYERED = $80000;
17 var
18 hUser32: HMODULE;
19 SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
20 i: Integer;
21 begin
22 Result := False;
23 {Here we import the function from USER32.DLL}
24 hUser32 := GetModuleHandle('USER32.DLL');
25 if hUser32 <> 0 then
26 begin
27 @SetLayeredWindowAttributes := GetProcAddress(hUser32,
28 'SetLayeredWindowAttributes');
29 {If the import did not succeed, make sure your app can handle it!}
30 if @SetLayeredWindowAttributes <> nil then
31 begin
32 {Check the current state of the dialog, and then add the
33 WS_EX_LAYERED attribute}
34 SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE)
35 or WS_EX_LAYERED);
36 {The SetLayeredWindowAttributes function sets the opacity and transparency
37 color
38 key of a layered window}
39 SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)),
40 LWA_ALPHA);
41 Result := True;
42 end;
43 end;
44 end;
45
46 {Hook procedure}
47
48 function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
49 const
50 MENU_CLASS = '#32768';
51 N_ALPHA = 60;
52 var
53 cwps: TCWPStruct;
54 lRet: THandle;
55 szClass: array[0..8] of char;
56 begin
57 if (nCode = HC_ACTION) then
58 begin
59 CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
60 case cwps.message of
61 WM_CREATE:
62 begin
63 GetClassName(cwps.hwnd, szClass, Length(szClass) - 1);
64 {Window name for menu is #32768}
65 if (lstrcmpi(szClass, MENU_CLASS) = 0) then
66 begin
67 MakeWndTrans(cwps.hwnd, N_ALPHA {Alphablending});
68 end;
69 end;
70 end;
71 end;
72 {Call the next hook in the chain}
73 Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
74 end;
75
76 {Install the hook in the OnCreate Handler}
77
78 procedure TForm1.FormCreate(Sender: TObject);
79 var
80 tpid: DWORD;
81 begin
82 {Retrieve the identifier of the thread that created the specified window}
83 tpid := GetWindowThreadProcessId(Handle, nil);
84 {The SetWindowsHookEx function installs an application-defined
85 hook procedure into a hook chain}
86 hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
87 end;
88
89 {Stop the hook in the OnDestroy Handler}
90
91 procedure TForm1.FormDestroy(Sender: TObject);
92 begin
93 if (hHookID <> 0) then
94 {Removes the hook procedure}
95 UnhookWindowsHookEx(hHookID);
96 end;
|
