Поддержка / Donate
 

WebMoney

Яндекс.Деньги

SMS.Копилка
Деньги@Mail.ru
Rupay
E-gold
PayPal

 

Благодарю за поддержку!

Лента RSS - Новости сайта Новости сайта
Лента RSS - Новости форума Новости форума
Добавить в закладки и поделиться Bookmark and Share

 

Архив исходников

 


Automatic translation

 
English German French
Italian Spanish Portuguese
Greece Japan Chinese
  Korean  

  

 

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

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


{ 
  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;




Источник - Проект "Delphi World" © Выпуск 2002 - 2004
Автор проекта: Акулов Николай

|  Где купить надежный теплоизоляционный материал в Екатеринбурге легко. | \"Азия Моторс\", автосервис nexia, Узнайте цены!  |

   Rambler's Top100             Яндекс цитирования