На главную
Подписка
Новости


Рейтинг@Mail.ru











Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Графика / Нарисовать подсвеченный прямоугольник вокруг контрола под мышкой Сделать домашней страницей Добавить в избранное Написать писмо

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



{ 
  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 ©   "DELPHI WORLD"   E-mail:   delphiworld@mail.ru  http://www.delphiworld.narod.ru
Источник получения информации: http://www.delphiworld.narod.ru
Hosted by uCoz