How to create transparent menus

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;