首页  编辑  

给指定控件画一个边框

Tags: /超级猛料/Picture.图形图像编程/控件和绘图/   Date Created:

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 ;