unit SizeGripHWND;
interface
uses
Windows, Messages;
procedure SetSizeGripHook(hWnd: HWND; IsDoubleBuffered: boolean = false);
procedure RemoveSizeGripHook(hWnd: HWND);
implementation
const
SizeGripProp = '
SizeGrip';
type
TWndProc =
function (hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
stdcall;
PGripInfo = ^TGripInfo;
TGripInfo =
record
OldWndProc: TWndProc;
GripRect: TRect;
DoubleBuffered: boolean;
end;
function SizeGripWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
stdcall;
var
Info: PGripInfo;
ps: TPaintStruct;
pt: TPoint;
// Invalidate the current grip rectangular
procedure InvalidateGrip;
begin
with Info^
do
if (GripRect.Right > GripRect.Left)
and
(GripRect.Bottom > GripRect.Top)
then
begin
if DoubleBuffered
then
InvalidateRect(hWnd,
nil, true)
else
InvalidateRect(hWnd, @GripRect, true);
end;
end;
// Update (and invalidate) the current grip rectangular
procedure UpdateGrip;
begin
with Info^
do
begin
GetClientRect(hWnd, GripRect);
GripRect.Left := GripRect.Right - GetSystemMetrics(SM_CXHSCROLL);
GripRect.Top := GripRect.Bottom - GetSystemMetrics(SM_CYVSCROLL);
end;
InvalidateGrip;
end;
begin
Info := PGripInfo(GetProp(hWnd, SizeGripProp));
if Info =
nil then
begin
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
exit;
end;
case Msg
of
WM_DESTROY:
begin
RemoveProp(hWnd, SizeGripProp);
SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@Info^.OldWndProc));
Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
Dispose(Info);
end;
WM_PAINT:
begin
if wParam = 0
then
begin
wParam := BeginPaint(hWnd, ps);
//try
if Info^.DoubleBuffered
then
SendMessage(hWnd, WM_ERASEBKGND, wParam, wParam);
Result := SendMessage(hWnd, WM_PAINT, wParam, lParam);
//finally
EndPaint(hWnd, ps);
//end;
end
else
begin
DrawFrameControl(wParam, Info^.GripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
end;
end;
WM_NCHITTEST:
begin
pt.x := TSmallPoint(lParam).x;
pt.y := TSmallPoint(lParam).y;
ScreenToClient(hWnd, pt);
if PtInRect(Info^.GripRect, pt)
then
Result := HTBOTTOMRIGHT
else
Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
end;
WM_SIZE:
begin
InvalidateGrip;
Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
UpdateGrip;
end;
else
Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
end;
end;
procedure SetSizeGripHook(hWnd: HWND; IsDoubleBuffered: boolean = false);
var
Info: PGripInfo;
begin
RemoveSizeGripHook(hWnd);
New(Info);
FillChar(Info^, SizeOf(TGripInfo), 0);
Info^.OldWndProc := TWndProc(Pointer(GetWindowLong(hWnd, GWL_WNDPROC)));
Info^.DoubleBuffered := IsDoubleBuffered;
SetProp(hWnd, SizeGripProp, Cardinal(Info));
SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@SizeGripWndProc));
end;
procedure RemoveSizeGripHook(hWnd: HWND);
var
Info: PGripInfo;
begin
Info := PGripInfo(GetProp(hWnd, SizeGripProp));
if Info <>
nil then
begin
RemoveProp(hWnd, SizeGripProp);
SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@Info^.OldWndProc));
Dispose(Info);
end;
end;
end.