Mega Code Archive
Draw a highlight box around the control under the mouse
<![CDATA[
{
This tip might be useful if you want to program
a screen capture tool and show a bounding box
around a control or for a spy tool like winsight to
highlight a object on the screen.
}
{
Dieser Tipp könnte vielleicht nützlich sein, wenn
man einen Printscreen machen möchte und das Control
unter der Maus hervorheben möchte. Auch für ein Spy
Programm könnte man diese Funktion gebrauchen, um
ein bestimmtes Control hervorzuheben (siehe Winsight)
}
var
hOldWnd :HWND;
procedure FrameWindow(Wnd: HWnd);
var
Rect: TRect;
DC: hDC;
OldPen, Pen: hPen;
OldBrush, Brush: hBrush;
X2, Y2: Integer;
begin
{ Get the target window's rect and DC }
GetWindowRect(Wnd, Rect);
DC := GetWindowDC(Wnd);
{ Set ROP appropriately for highlighting }
SetROP2(DC, R2_NOT);
{ Select brush and pen }
Pen := CreatePen(PS_InsideFrame, 4, 0);
OldPen := SelectObject(DC, Pen);
Brush := GetStockObject(Null_Brush);
OldBrush := SelectObject(DC, Brush);
{ Set dimensions of highlight }
X2 := Rect.Right - Rect.Left;
Y2 := Rect.Bottom - Rect.Top;
{ Draw highlight box }
Rectangle(DC, 0, 0, X2, Y2);
{ Clean up }
SelectObject(DC, OldBrush);
SelectObject(DC, OldPen);
ReleaseDC(Wnd, DC);
{ Do NOT delete the brush, because it was a stock object }
DeleteObject(Pen);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
hNewWnd: HWnd;
begin
hNewWnd := WindowFromPoint(Mouse.CursorPos);
{ To avoid flickering, remove the old frame ONLY if moved to new window }
if hNewWnd <> hOldWnd then
begin
if hOldWnd <> 0 then
FrameWindow(hOldWnd);
if hNewWnd <> 0 then
FrameWindow(hNewWnd);
hOldWnd := hNewWnd;
end;
end;
]]>