var
hHookID: HHOOK;
implementation
{$R *.dfm}
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 = $80001;
var
hUser32: HMODULE;
SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
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);
SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);
Result := True;
end;
end;
end;
function SubClassWndProc(Wnd: HWND; uMsg: Longword; wParam: wParam;
lParam: lParam): Longint; stdcall;
var
OldWndProc: THandle;
begin
OldWndProc := GetProp(Wnd, 'OldWndProc');
case uMsg of
WM_CREATE:
begin
MakeWndTrans(Wnd);
end;
WM_DESTROY:
begin
RemoveProp(Wnd, 'OldWndProc');
SetWindowLong(Wnd, GWL_WNDPROC, Integer(OldWndProc));
end;
end;
try
Result := CallWindowProc(@OldWndProc, Wnd, uMsg, wParam, lParam); // Error !!!!
except
RaiseLastWin32Error
end;
end;
function HookCallWndProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
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, '#32768') = 0) then
begin
// Subclassing stuff
lRet := SetWindowLong(cwps.hwnd, GWL_WNDPROC, Integer(@SubClassWndProc));
// replace Window Proc
SetProp(cwps.hwnd, 'OldWndProc', lRet);
// Save Old Proc.
end;
end;
end;
end;
// Call the next hook in the chain
Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
tpid: DWORD;
begin
// retrieve the identifier of the thread that created the specified window
tpid := GetWindowThreadProcessId(
Handle, nil);
// Install a WH_CALLWNDPROC hook
hHookID := SetWindowsHookEx(WH_CALLWNDPROC, HookCallWndProc, 0, tpid);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if (hHookID <> 0) then
// Removes the hook procedure
UnhookWindowsHookEx(hHookID);
end;