unit uNCPaintHook;
{$mode objfpc}{$H+}
interface
uses
Windows, LCLIntf, LCLType, Classes, Forms;
type _OnMsgHook = function(var Msg: TMsg): Boolean;
TNCPaintHook = class
private
FTarget: HWND;
FAttached: Boolean;
// Callback : True = handled (exit), False = continue to original
FOnNCPaint: function(var Msg: TMsg): Boolean;
public
constructor Create(ATarget: HWND; AOnNCPaint: _OnMsgHook);
destructor Destroy; override;
procedure Attach;
procedure Detach;
class var FOriginalProc: Windows.WNDPROC;
class var FHookMap: TNCPaintHook;
end;
function HookedWndProc(hwnd1: HWND; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
implementation
{ TNCPaintHook }
function HookedWndProc(hwnd1: HWND; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
var
Hook: TNCPaintHook;
WinMsg: TMsg;
Handled: Boolean;
begin
Hook := TNCPaintHook.FHookMap;
if (Hook <> nil) and (Hook.FAttached) and (hwnd1 = Hook.FTarget) then
begin
if Msg = WM_NCPaint then
begin
WinMsg := Default(tagMsg);
WinMsg.Hwnd := hwnd1;
WinMsg.Message := Msg;
WinMsg.WParam := wParam;
WinMsg.LParam := lParam;
Handled := Hook.FOnNCPaint(WinMsg);
if Handled then
begin
Result := 0; // Any value here
Exit;
end;
end;
end;
// Fallthrough: original WndProc (LCL)
if (Hook <> nil) and (Hook.FOriginalProc <> nil) then
Result := CallWindowProc(TNCPaintHook.FOriginalProc, hwnd1, Msg, wParam, lParam)
else
Result := DefWindowProc(hwnd1, Msg, wParam, lParam);
end;
constructor TNCPaintHook.Create(ATarget: HWND;
AOnNCPaint: _OnMsgHook);
begin
inherited Create;
TNCPaintHook.FHookMap := nil;
FTarget := ATarget;
FOnNCPaint := AOnNCPaint;
FAttached := False;
FOriginalProc := nil;
end;
destructor TNCPaintHook.Destroy;
begin
if FAttached then Detach;
inherited;
end;
procedure TNCPaintHook.Attach;
begin
if FAttached then Exit;
TNCPaintHook.FHookMap := Self;
FOriginalProc := Windows.WNDPROC(
GetWindowLongPtr(FTarget, GWLP_WNDPROC));
SetWindowLongPtr(FTarget, GWLP_WNDPROC,
LONG_PTR(@HookedWndProc));
FAttached := True;
end;
procedure TNCPaintHook.Detach;
begin
if not FAttached then Exit;
SetWindowLongPtr(FTarget, GWLP_WNDPROC,
LONG_PTR(FOriginalProc));
FAttached := False;
TNCPaintHook.FHookMap := nil;
end;
end.
