在窗口周围绘制框架时出现问题答案

【问题标题】：Problems when drawing a frame around a window在窗口周围绘制框架时出现问题
【发布时间】：2021-07-21 10:06:20
【问题描述】：

在 Windows 10 的 Delphi 10.4.2 Win32 VCL 应用程序中，我尝试在窗口周围绘制一个框架（-control）：

procedure FrameWindow(aHandle: HWND);
var
  Rect: TRect;
  DC: Winapi.Windows.HDC;
  OldPen, Pen: Winapi.Windows.HPEN;
  OldBrush, Brush: Winapi.Windows.HBRUSH;
  X2, Y2: Integer;
begin
  { Get the target window's rect and DC }
  Winapi.Windows.GetWindowRect(aHandle, Rect);
  DC := Winapi.Windows.GetWindowDC(aHandle);
  { Set ROP appropriately for highlighting }
  Winapi.Windows.SetROP2(DC, R2_NOT);
  { Select brush and pen }
  Pen := Winapi.Windows.CreatePen(PS_InsideFrame, 3, 0);
  OldPen := Winapi.Windows.SelectObject(DC, Pen);
  Brush := Winapi.Windows.GetStockObject(Null_Brush);
  OldBrush := Winapi.Windows.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(aHandle, DC);
  { Do NOT delete the brush, because it was a stock object }
  DeleteObject(Pen);
end;

（当使用相同的窗口句柄第二次调用 FrameWindow 过程时，框架将被擦除）。

这适用于窗口上的控件：

当光标下的窗口句柄（Target.WindowHandle）发生变化，需要擦除旧帧时，会定期调用 FrameWindow 过程来绘制新帧：

{ To avoid flickering, remove the old frame ONLY if moved to a new window }
if Target.WindowHandle <> FOldWindowHandle then
begin
  if FOldWindowHandle <> 0 then
    FrameWindow(FOldWindowHandle); // remove the old frame
  if Target.WindowHandle <> 0 then
    FrameWindow(Target.WindowHandle); // create new frame
  FOldWindowHandle := Target.WindowHandle; // remember new frame
end;

问题 #1：这仅适用于窗口上的控件，而不适用于整个窗口（例如，当鼠标光标位于记事本的标题栏上时），尽管整个窗口的窗口句柄是正确的：没有框架围绕整个窗口绘制。

问题 #2：有时帧已损坏：

问题 #3：如何将框架颜色设置为红色而不是黑色？

如何解决这些问题？

【问题讨论】：

您无法可靠地渲染到您不拥有的设备上下文中。
@IInspectable 这是什么意思？我怎样才能成为 DC 的所有者？
您不能“成为” DC 的所有者。您要么拥有它（例如，因为您创建了它，或者从您拥有的窗口请求了一个），要么不拥有它。没有从后者到前者的去向。如果你想渲染到显示器上，你将不得不创建一个窗口。
@IInspectable 所以你说这个过程不能避免重绘问题？
不，我是说没有可靠的方法可以将任何渲染到您不拥有的设备上下文中。您无法与 DC 的所有者交流，“嘿，看，我只是为了我的目的而使用了您的一些屏幕空间，您肯定不介意”，因此是没有办法让主人关心的。当它确定需要重绘时，它会继续重绘。

标签： delphi winapi delphi-10.4-sydney

【解决方案1】：

我已经完全放弃了在桌面上画画的想法。现在我使用 TRANSPARENT CLICK-THROUGH 窗口并将其放置在目标窗口上：

Here is the source code of the form unit:

unit Unit1;

interface

uses
  Winapi.Windows, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Win: HWND;
  R: TRect;
  offset: Integer;
begin
  Win := 135642;
  GetWindowRect(Win, R);
  offset := Panel2.Margins.Bottom;
  InflateRect(R, offset, offset);
  Self.BoundsRect := R;
  Self.Left := R.Left;
  Self.Top := R.Top;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
// https://stackoverflow.com/questions/11809973/click-through-transparent-form
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT;
end;

end.

这里是 DFM 代码：

object Form1: TForm1
  Left = 0
  Top = 0
  AlphaBlend = True
  BorderStyle = bsNone
  Caption = 'Form1'
  ClientHeight = 378
  ClientWidth = 589
  Color = clGreen
  TransparentColor = True
  TransparentColorValue = clGreen
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poDefault
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 589
    Height = 378
    Align = alClient
    BevelOuter = bvNone
    Color = clRed
    ParentBackground = False
    TabOrder = 0
    ExplicitLeft = 200
    ExplicitTop = 224
    ExplicitWidth = 185
    ExplicitHeight = 41
    object Panel2: TPanel
      AlignWithMargins = True
      Left = 3
      Top = 3
      Width = 583
      Height = 372
      Align = alClient
      BevelOuter = bvNone
      Color = clGreen
      ParentBackground = False
      ShowCaption = False
      TabOrder = 0
      ExplicitLeft = 200
      ExplicitTop = 176
      ExplicitWidth = 185
      ExplicitHeight = 41
    end
  end
end

【讨论】：

【解决方案2】：

抱歉，我还不能发表评论。但是，如果您想在另一个应用程序中绘图，则可以使用 Hook for Learning Programms 之类的东西。我不记得它的名字了。我不确定是不是这个：CBTHookEvents

我想我在 2001 年左右使用了类似的东西来跟踪应用程序以围绕它进行学习体验。但它似乎已经过时了。也许有人也有一个想法，甚至更好的sn-p。

【讨论】：