Cool! 将系统所有菜单变为半透明的代码
效果还是不是很理想。
主要是没有正确得到菜单中子菜单的句柄。高手们有没有好办法呢？
现在公开源代码，和大家一起研究研究。
如果这个问题解决，我想将功能扩张到拖动窗体时也将窗体变为半透明。这个功能我试
了，基本一能实现了。到时我也会将代码献出来给大家！
希望大家不会也UP一下！
(只适用Win2000以上的版本)
以下是代码，功能当然是使用钩子实现
library HookMenu;
{*************************************************************}
{* *}
{* HookMenu Library,Copyright lfpsoft 2002 *}
{* All rights reserverd. *}
{* Bug Report : lfpsoft@163.net *}
{* WEB : http://211.162.63.162/bbs ; *}
{* *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在WM_MENUSELECT这个消息里得到该子菜单的句柄 *}
{* 现在发布源代码，希望高手们指点指点，或者大家共同研究 *}
{* 还有手头上有基本实现当拖动窗体时就显示半透明的代码，过些天*}
{* 整理好后我会再放出来大家研究研究 *}
{*************************************************************}
uses
SysUtils,
Classes,
HookMenuProc in 'HooKMenuProc.pas';
{$R *.RES}
exports
EnableMenuHook,
DisableMenuHook,
MenuHookExit,
SetAlpha,
SetTrayAlpha;
begin
IntoShare;
end.
unit HooKMenuProc;
{*************************************************************}
{* *}
{* HookMenu Library,Copyright lfpsoft 2002 *}
{* All rights reserverd. *}
{* Bug Report : lfpsoft@163.net *}
{* WEB : http://211.162.63.162/bbs ; *}
{* *}
{* 效果不是很好，因为到现在我还没有想出如何得到菜单中的子菜单*}
{* 好方法，只能在WM_MENUSELECT这个消息里得到该子菜单的句柄 *}
{* 现在发布源代码，希望高手们指点指点，或者大家共同研究 *}
{* 还有手头上有基本实现当拖动窗体时就显示半透明的代码，过些天*}
{* 整理好后我会再放出来大家研究研究 *}
{*************************************************************}
interface
uses
Windows, Messages, SysUtils;
var
hNextHookProc: HHook;
procSaveExit: Pointer;
function MenuHookHandler(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
function EnableMenuHook: BOOL; export;
function DisableMenuHook: BOOL; export;
procedure MenuHookExit; far;
procedure IntoShare; stdcall;export;
procedure SetAlpha( bAlpha: Byte );stdcall; export;
procedure SetTrayAlpha( bAlpha: Byte);stdcall; export;
implementation
type
TGoData = record //将设置半透明的值共享到内存中的数据结构
bAlpha: byte;
end;
PGoData = ^TGoData;
const
user32 = 'user32.dll';
var
GoData : PGoData;
MemFile : THandle;
procedure GetWindowsVersion(var Major : integer;var Minor : integer);
var
l : longint;
begin
l := GetVersion;
Major := LoByte(LoWord(l));
Minor := HiByte(LoWord(l));
end;
procedure SetAlpha( bAlpha: Byte );stdcall; export; //设置半透明值
begin
if bAlpha <10 then bAlpha :=10;
GoData^.bAlpha := bAlpha;
end;
procedure SetWndAlpha(MenuHwnd:hwnd;const Alpha: Byte); // 设置半透明
var
major, minor : integer;
User32: Cardinal;
l: Longint;
SetLayeredWindowAttributes: function (hwnd: LongInt; crKey: byte; bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;
begin
GetWindowsVersion(major, minor);
if ((major >= 5) and (minor >= 0)) then //判断是否是WIN2000以上的版本。
begin
User32 := LoadLibrary('user32');
if User32 <> 0 then
try
SetLayeredWindowAttributes := GetProcAddress(user32, 'SetLayeredWindowAttributes');
if @SetLayeredWindowAttributes <> nil then
begin
l := GetWindowLong(MenuHwnd, GWL_EXSTYLE);
l := l or WS_EX_LAYERED;
SetWindowLong(MenuHwnd, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(MenuHwnd,0,Alpha,LWA_ALPHA);
end;
finally
FreeLibrary(User32);
end;
end;
end;
//枚举所有窗体，如果是菜单或是历史菜单就设置半透明
function EnumWindowsProc(hWindow:hWnd;lParam:LongInt) : Bool {$IFDEF Win32} stdcall;{$ELSE}:Export;{$ENDIF}
var
csCompare,csClassName:String;
szClassname:Array[0..128] of Char;
begin
if ((lParam = 0) or (lParam = 2)) then csCompare := 'BaseBar'
else if (lParam = 1) then csCompare := '#32768';
GetClassName(hWindow, szClassname, 128);
csClassName := Trim(szClassname);
if csClassName = csCompare then
begin
if (lParam = 2) then SetWndAlpha(hWindow,255)
else
SetWndAlpha(hWindow,GoData^.bAlpha);
end;
result :=true;
end;
//钩子程序
function MenuHookHandler(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
var
szClassname:Array[0..128] of Char;
cwp: CWPRETSTRUCT;
hwndMenu:HWND;
csClassname:String;
begin
Result := 0;
If iCode < 0 Then
begin
Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);
Exit;
end;
cwp := PCWPRETSTRUCT(lParam)^;
if((cwp.message = WM_CREATE) or (cwp.message = WM_INITMENUPOPUP) or
(cwp.message = WM_INITMENU) or (cwp.message = WM_MENUSELECT)) then
begin
if cwp.message = WM_CREATE then
begin
hwndMenu := cwp.hwnd;
GetClassName(hwndMenu, szClassname, 128);//取得类名
csClassname := Trim(szClassname);
if ((csClassname ='#32768') or (csClassname = 'BaseBar')) then
begin //如果是菜单或历史菜单就...
SetWndAlpha(hwndMenu,GoData^.bAlpha) ;
end;
end
else
begin
EnumWindows(@EnumWindowsProc, 1);
end;
end;
Result := CallNextHookEx( hNextHookProc, iCode, wParam, lParam);
end;
//挂钩子
function EnableMenuHook: BOOL; export;
begin
Result := False;
EnumWindows(@EnumWindowsProc, 0);
if hNextHookProc <> 0 then Exit;
hNextHookProc := SetWindowsHookEx(WH_CALLWNDPROCRET,
MenuHookHandler,
HInstance,
0);
Result := hNextHookProc <> 0;
end;
//取消钩子
function DisableMenuHook: BOOL; export;
begin
if hNextHookProc <> 0 then
begin
SetWndAlpha(FindWindow('Shell_TrayWnd', nil),255);
EnumWindows(@EnumWindowsProc, 2);
UnhookWindowsHookEx(hNextHookProc);
hNextHookProc := 0;
end;
Result := hNextHookProc = 0;
end;
//退出钩子
procedure MenuHookExit;
begin
SetWndAlpha(FindWindow('Shell_TrayWnd', nil),255);
if hNextHookProc <> 0 then DisableMenuHook;
ExitProc := procSaveExit;
end;
//将要设置半透明的值共享到内存中去
procedure IntoShare; stdcall;export;
begin
MemFile := OpenFileMapping( FILE_MAP_WRITE, False, 'CCSOFT' );
if MemFile = 0 then
Memfile:=CreateFileMapping( $FFFFFFFF, nil,
PAGE_READWRITE, 0, SizeOf( TGoData ), 'CCSOFT');
GoData := MapViewOfFile( MemFile, FILE_MAP_WRITE, 0, 0, 0 );
if MemFile = 0 then
FillChar( GoData^, SizeOf( TGoData ),0);
end;
procedure SetTrayAlpha( bAlpha: Byte);stdcall;export; //设置任务栏半透明
begin
SetWndAlpha(FindWindow('Shell_TrayWnd', nil),bAlpha);
end;
end.
//测试代码
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//调用DLL
procedure EnableMenuHook; stdcall;external 'HookMenu.dll';
procedure MenuHookExit; stdcall;external 'HookMenu.dll';
procedure DisableMenuHook; stdcall;external 'HookMenu.dll';
procedure SetAlpha( bAlpha : Byte ); stdcall;external 'HookMenu.dll';
procedure SetTrayAlpha( bAlpha: Byte);stdcall; external 'HookMenu.dll';
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
setalpha(100);
SetTrayAlpha( 100);
EnableMenuHook;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MenuHookExit;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
setalpha(trackbar1.Position);
SetTrayAlpha( trackbar1.Position);
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
EnableMenuHook
else DisableMenuHook;
end;
end.