围绕 window 画框时出现问题

Question

在 Delphi 10.4.2 Win32 VCL 应用程序 Windows 10 中，我尝试围绕 window(-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;

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

这适用于 window 上的控件：

当光标下的window句柄(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：这仅适用于 window 上的控件，而不适用于整个 window（例如，当鼠标光标位于记事本的标题栏上时），尽管 window 整个 window 的句柄是正确的：没有在整个 window 周围绘制框架。

问题 #2：有时帧损坏：

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

如何解决这些问题？

Answer 1

抱歉，我还不能发表评论。但是如果你想在另一个应用程序中绘制，可以使用学习程序挂钩之类的东西。我不记得它的名字了。我不确定是不是这个：CBTHookEvents

我想我在 2001 年左右使用了类似的东西来跟踪应用程序以围绕它绘制学习体验。但它似乎已经过时了。也许有人也有想法或更好的片段。

Answer 2

我已经彻底打消了在桌面上画画的念头。现在我使用透明点击 window 并将其放在目标 window:

上

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);
// 
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

围绕 window 画框时出现问题

Problems when drawing a frame around a window

delphi

winapi

delphi-10.4-sydney