Create transparent menus (2000/XP)

Author: Thomas Stutz

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;