首页  编辑  

Win2000/XP透明菜单

Tags: /超级猛料/VCL/Menu.菜单/   Date Created:

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;