Delphi 如何在将screen对象句柄设置为DrawFocusRect时消除屏幕闪烁

我正试图在我多年前开发的“理解屏幕捕获”组件中，围绕选定的屏幕对象绘制一个聚焦矩形。我可以通过使用句柄获取光标下对象的句柄来DrawFocusRect:=WindowFromPoint（P）；但这要求我先隐藏，然后展示自我，让它发挥作用，否则自我的句柄就会返回

不幸的是，当我隐藏和显示窗体时，它会在窗体被隐藏和显示时导致闪烁

我可以毫无问题地获得所选对象的位图，只需绘制所选对象就让我抓狂

有没有人建议在选定的对象周围绘制一个FocusedRect，这样就不会闪烁？如果窗体位于屏幕上，是否有API来获取屏幕句柄

我尝试使用句柄：=WindowFromDC（ScreenDC），因此我不必隐藏和显示表单，但WindowFromDC仍然返回表单而不是屏幕

TCaptureObjectForm是透明的，位于屏幕上。我需要组件中的TCaptureObjectForm

//FormMouseMove事件-于2011年8月2日添加

procedure TCaptureObjectForm.FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
const
  crHand = -18;
var
  P: TPoint;
  Handles: HWND;
  Rect: TRect;
  ScreenDC: HDC;
begin
  // hide the TCaptureObjectForm form so the screen is found by WindowFromPoint
  Self.Hide;
  // get the object on the screen
  GetCursorPos( P );
  Handles := WindowFromPoint( P );
  // tried this but it returns self.handle rather than the screen handle
  //ScreenDC := GetDC( 0 );
  //Handles := WindowFromDC(ScreenDC);
  //ReleaseDC( 0, ScreenDC );
  // restore the TCaptureObjectForm
  Self.Show;
  // get object rect
  GetWindowRect( Handles, Rect );
  // draw a rect to show it is focused
  Self.Canvas.DrawFocusRect( Rect );
end;

我用这个

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.DoubleBuffered:=True;
end;

是Microsoft Visual Basic中的一个示例，它所做的工作与您所需要的非常相似

他们采取以下方法：

以

形式捕获鼠标\u MouseDown

当鼠标移动时，在鼠标指向的窗口周围绘制一个矩形：

Form\u MouseMove

在

窗体中释放鼠标，并使整个屏幕无效，以擦除最后绘制的矩形

他们直接在选择的窗口中绘制。我不认为使用透明窗口方法可以避免所有闪烁

该代码示例似乎不完整且工作不正常，因此我对其进行了修改（并翻译为Delphi）：

//不是全局变量，而是私有形式变量
变量
HwndLastTracked:HWND；
CapturedMouse：布尔值；
过程跟踪程序（HWND窗口：HWND）；
变量
rc:TRect；
dc:HDC；
钢笔，旧钢笔：HPEN；
老布什：HBRUSH；
风格，exStyle：长型；
cx，cy：整数；
开始
GetWindowRect（hwndWindow，rc）；
//窗口原点（左上角）的窗口坐标为（0，0）
偏置（rc，-rc.左，-rc.上）；
//GetWindowDC返回的DC覆盖整个窗口区域，但在Windows中
//Vista/7由于以下原因，它似乎被剪裁为不包括非客户端区域
//DWM处理非客户端绘图，因此不允许在其上进行绘制。
//因此，我们需要跳过这个非客户端区域，这就是我调整
//窗口rect以匹配客户端区域。使用GetClientRect而不是
//GetWindowRect不适用于排除滚动条和子对象
//用WM_NCPAINT绘制的部件，如Windows的WS_Exeges和Delphi的
//斜面。
样式：=GetWindowLong（hwndWindow，GWL_样式）；
exStyle:=GetWindowLong（hwndWindow，GWL_exStyle）；
如果样式和WS_标题为0，则开始
如果exStyle和WS_EX_工具窗口为0，则
cy:=GetSystemMetrics（SM_CYSMCAPTION）
其他的
cy:=GetSystemMetrics（SM_CYCAPTION）；
//丢弃标题所覆盖的区域
股份有限公司（位于西西里州的rc.Top）；
结束；
如果样式和宽度为0，则开始
cx:=GetSystemMetrics（SM_CXFRAME）；
cy:=GetSystemMetrics（SM_CYFRAME）；
结束
否则，如果样式和WS_DLGFRAME 0，则开始
cx:=GetSystemMetrics（SM_CXDLGFRAME）；
cy:=GetSystemMetrics（SM_CYDLGFRAME）；
结束
否则，如果样式和WS_边框为0，则开始
cx:=GetSystemMetrics（SM_CXBORDER）；
cy:=GetSystemMetrics（SM_CYBORDER）；
结束
否则开始
cx:=0；
cy:=0；
结束；
如果是（cx 0）或（cy 0），则开始
//丢弃边界覆盖的区域
偏置（rc、cx、cy）；
12月（右区，cx*2）；
12月（钢筋混凝土底部，cy*2）；
结束；
//Windows API函数不会引发异常，所以我不使用try finally
dc:=GetWindowDC（hwndWindow）；
//选项1：聚焦矩形
//DrawFocusRect（dc、rc）；
//选项2：倒厚边框
SetROP2（dc，R2_非）；
pen:=CreatePen（PS_INSIDEFRAME，3*GetSystemMetrics（SM_CXBORDER），0）；
oldPen:=选择对象（dc，笔）；
oldBrush:=SelectObject（dc，GetStockObject（NULL_笔刷））；
矩形（dc，rc.左，rc.上，rc.右，rc.下）；
选择对象（dc、oldBrush）；
选择对象（dc、oldPen）；
删除对象（笔）；
//结束方案2
释放dc（hwndWindow，dc）；
结束；
步骤t用于m1.FormMouseDown（发送方：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
如果SetCapture（句柄）为0，则开始
CapturedMouse:=真；
HwndLastTracked:=0；
屏幕光标：=crCross；
结束；
结束；
过程TForm1.FormMouseMove（发送方：TObject；移位：TShiftState；
十、 Y：整数）；
变量
HWND：HWND；
开始
如果是CapturedMouse，则开始
hwndCaptured:=WindowFromPoint（客户端到屏幕（点（X，Y））；
//取消注释此跟踪根窗口而不是子窗口
//hwndCaptured:=GetSencenter（hwndCaptured，GA_根）；
如果hwndCaptured HwndLastTracked，则开始
如果HWNDLAST0，则
逆变器跟踪器（HwndLastTracked）；
反转跟踪器（HWNDF）；
HwndLastTracked:=hwndCaptured；
结束；
结束；
结束；
程序TForm1.FormMouseUp（发送方：TObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
如果是CapturedMouse，则开始
释放捕获；
CapturedMouse:=假；
如果为0，则开始
逆变器跟踪器（HwndLastTracked）；
HwndLastTracked:=0；
结束；
Screen.Cursor:=crDefault；
结束；
结束；

下面是微软如何在VisualStudio的Spy++中使用此技术的屏幕截图。红色气球和文字是我的

---

我将DoubleBuffered设置为true后，闪烁的次数减少了很多，但FocusedRect当然仍然闪烁。有更好的方法吗？对不起，我没有其他想法……也许大卫·赫弗南对这个问题的回答可以帮助你。这样做的缺点是它会阻止某些组件正确渲染

// Not global variables, but private form ones
var
  HwndLastTracked: HWND;
  CapturedMouse: boolean;

procedure InvertTracker(hwndWindow: HWND);
var
  rc: TRect;
  dc: HDC;
  pen, oldPen: HPEN;
  oldBrush: HBRUSH;
  style, exStyle: longint;
  cx, cy: integer;
begin
  GetWindowRect(hwndWindow, rc);

  // Window coordinates of the origin (top-left corner) of a window is (0, 0)
  OffsetRect(rc, -rc.Left, -rc.Top);

  // DC returned by GetWindowDC covers the full window area, but in Windows
  // Vista/7 it seems to be clipped excluding the nonclient region, due to
  // DWM handling nonclient drawing, so it doesn't allow painting over it.
  // Thus we need to skip this nonclient area and that is why I adjust the
  // window rect to match the client area. Using GetClientRect instead of
  // GetWindowRect is not suitable as excludes scroll bars and child 
  // parts drawed in WM_NCPAINT, such as Windows' WS_EXEDGEs and Delphi's
  // bevels.

  style := GetWindowLong(hwndWindow, GWL_STYLE);
  exStyle := GetWindowLong(hwndWindow, GWL_EXSTYLE);

  if style and WS_CAPTION <> 0 then begin
    if exStyle and WS_EX_TOOLWINDOW <> 0 then
      cy := GetSystemMetrics(SM_CYSMCAPTION)
    else
      cy := GetSystemMetrics(SM_CYCAPTION);

    // discard area covered by caption 
    Inc(rc.Top, cy);
  end;

  if style and WS_THICKFRAME <> 0 then begin
    cx := GetSystemMetrics(SM_CXFRAME);
    cy := GetSystemMetrics(SM_CYFRAME);
  end
  else if style and WS_DLGFRAME <> 0 then begin
    cx := GetSystemMetrics(SM_CXDLGFRAME);
    cy := GetSystemMetrics(SM_CYDLGFRAME);
  end
  else if style and WS_BORDER <> 0 then begin
    cx := GetSystemMetrics(SM_CXBORDER);
    cy := GetSystemMetrics(SM_CYBORDER);
  end
  else begin
    cx := 0;
    cy := 0;
  end;

  if (cx <> 0) or (cy <> 0) then begin
    // discard area covered by borders
    OffsetRect(rc, cx, cy);
    Dec(rc.Right, cx*2);
    Dec(rc.Bottom, cy*2);
  end;

  // Windows API functions don't raise exceptions, so I don't use try-finally

  dc := GetWindowDC(hwndWindow);

  // Option 1: focused rect
  //DrawFocusRect(dc, rc);

  // Option 2: inverted thick border
  SetROP2(dc, R2_NOT);
  pen := CreatePen(PS_INSIDEFRAME, 3 * GetSystemMetrics(SM_CXBORDER), 0);
  oldPen := SelectObject(dc, pen);
  oldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));

  Rectangle(dc, rc.Left, rc.Top, rc.Right, rc.Bottom);

  SelectObject(dc, oldBrush);
  SelectObject(dc, oldPen);
  DeleteObject(pen);
  // End option 2

  ReleaseDC(hwndWindow, dc);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if SetCapture(Handle) <> 0 then begin
    CapturedMouse := true;
    HwndLastTracked := 0;
    Screen.Cursor := crCross;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  hwndCaptured: HWND;
begin
  if CapturedMouse then begin
    hwndCaptured := WindowFromPoint(ClientToScreen(Point(X, Y)));

    // Uncomment this for track root windows instead of childs
    //hwndCaptured := GetAncestor(hwndCaptured, GA_ROOT);

    if hwndCaptured <> HwndLastTracked then begin
      if HwndLastTracked <> 0 then
        InvertTracker(HwndLastTracked);
      InvertTracker(hwndCaptured);
      HwndLastTracked := hwndCaptured;
    end;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if CapturedMouse then begin
    ReleaseCapture;
    CapturedMouse := false;

    if HwndLastTracked <> 0 then begin
      InvertTracker(HwndLastTracked);
      HwndLastTracked := 0;
    end;

    Screen.Cursor := crDefault;
  end;
end;