Нарисовать подсвеченный прямоугольник вокруг контрола под мышкой

Советы » Компоненты и Графика » Нарисовать подсвеченный прямоугольник вокруг контрола под мышкой

{ 
  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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com