围绕窗口绘制框架时出现的问题 [英] Problems when drawing a frame around a window

问题描述

在 Windows 10 中的 Delphi 10.4.2 Win32 VCL 应用程序中，我尝试在窗口周围绘制框架(-control):

In a Delphi 10.4.2 Win32 VCL Application in Windows 10, I try to draw a frame around a 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;

(当使用相同的窗口句柄第二次调用 FrameWindow 过程时，该框架将被擦除).

(When the FrameWindow procedure is called a second time with the same window handle, then the frame is erased).

这适用于窗口上的控件:

This works well with controls on a window:

当光标下的窗口句柄(Target.WindowHandle)发生变化，需要删除旧框架时，会周期性调用FrameWindow过程来绘制新框架:

The FrameWindow procedure is called periodically to draw a new frame when the window handle (Target.WindowHandle) under the cursor changes and the old frame needs to be erased:

{ 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:这仅适用于窗口上的控件，而不适用于整个窗口(例如，当鼠标光标位于记事本的标题栏上时)，尽管整个窗口的窗口句柄是正确的:无框架围绕整个窗口绘制.

Problem #1: This works only for controls on a window, not for the whole window (e.g., when the mouse cursor is over the title bar of Notepad), although the window handle for the whole window is correct: No frame is drawn around the whole window.

问题#2:有时帧损坏:

Problem #2: Sometimes the frame is corrupted:

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

Problem #3: How can I set the frame color to red instead of black?

如何解决这些问题?

推荐答案

我已经完全放弃了在桌面上绘画的想法.现在我使用一个透明的点击窗口并将其放置在目标窗口上:

I have completely given up the idea to draw on the desktop. Now I use a TRANSPARENT CLICK-THROUGH window and place it over the target 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);
// 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

这篇关于围绕窗口绘制框架时出现的问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！