How to create transparent menus (Views: 32)
Problem/Question/Abstract: How to create transparent menus Answer: This works only for Win 2000 and XP: { ... } var hHookID: HHOOK; {Function to make the menu transparent } function MakeWndTrans(Wnd: HWND; nAlpha: Integer = 10): Boolean; type TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte; dwFlags: Longint): Longint; stdcall; const {Use crKey as the transparency color} LWA_COLORKEY = 1; {Use bAlpha to determine the opacity of the layered window} LWA_ALPHA = 2; WS_EX_LAYERED = $80000; var hUser32: HMODULE; SetLayeredWindowAttributes: TSetLayeredWindowAttributes; i: Integer; begin Result := False; {Here we import the function from USER32.DLL} hUser32 := GetModuleHandle('USER32.DLL'); if hUser32 <> 0 then begin @SetLayeredWindowAttributes := GetProcAddress(hUser32, 'SetLayeredWindowAttributes'); {If the import did not succeed, make sure your app can handle it!} if @SetLayeredWindowAttributes <> nil then begin {Check the current state of the dialog, and then add the WS_EX_LAYERED attribute} SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED); {The SetLayeredWindowAttributes function sets the opacity and transparency color key of a layered window} SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA); Result := True; end; end; end; {Hook procedure} function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall; const MENU_CLASS = '#32768'; N_ALPHA = 60; var cwps: TCWPStruct; lRet: THandle; szClass: array[0..8] of char; begin if (nCode = HC_ACTION) then begin CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT)); case cwps.message of WM_CREATE: begin GetClassName(cwps.hwnd, szClass, Length(szClass) - 1); {Window name for menu is #32768} if (lstrcmpi(szClass, MENU_CLASS) = 0) then begin MakeWndTrans(cwps.hwnd, N_ALPHA {Alphablending}); end; end; end; end; {Call the next hook in the chain} Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam); end; {Install the hook in the OnCreate Handler} procedure TForm1.FormCreate(Sender: TObject); var tpid: DWORD; begin {Retrieve the identifier of the thread that created the specified window} tpid := GetWindowThreadProcessId(Handle, nil); {The SetWindowsHookEx function installs an application-defined hook procedure into a hook chain} hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid); end; {Stop the hook in the OnDestroy Handler} procedure TForm1.FormDestroy(Sender: TObject); begin if (hHookID <> 0) then {Removes the hook procedure} UnhookWindowsHookEx(hHookID); end; |