Нарисовать подсвеченный прямоугольник вокруг контрола под мышкой
{
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.
}
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;
|
|