自定义标题栏按钮成功但

Question

我的代码。乞讨和借来。

unit uFrm_Details;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Buttons;

const
  BTN_TOP = 10;

type
  TFFrm_Details = class(TForm)
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FDownButton: TRect;
    FUpButton: TRect;
    FCloseButton: TRect;
    FCBMP, FDBMP, FUBMP: TBitmap;
    FYCaption, FXTtlBit, FYTtlBit: Integer;
    FHandle: TCanvasDC;
    procedure DrawTitleButton;
    procedure DrawFinalize;
    procedure FoldDown;
    procedure FoldUp;
    {Paint-related messages}
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
    {Mouse down-related messages}
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message WM_NCLBUTTONUP;

  public
    { Public declarations }
  end;

const
  htCloseBtn = htSizeLast + 100;
  htDropBtn =  htSizeLast + 101;
  htCloseUpBtn = htSizeLast + 102;

var
  FFrm_Details: TFFrm_Details;

implementation

{$R *.dfm}

uses uFrm_Main;

{ TTitleBtnForm }

procedure TFFrm_Details.DrawFinalize;
begin
  with FCloseButton do
    Canvas.Draw(Left, Top, FCBMP);

  with FDownButton do
    Canvas.Draw(Left, Top, FDBMP);

  with FUpButton do
    Canvas.Draw(Left, Top, FUBMP);

  ReleaseDC(Self.Handle, FHandle);
  FCBMP.Free;
  FDBMP.Free;
  FUBMP.Free;
  FHandle:= 0;
end;

procedure TFFrm_Details.DrawTitleButton;
begin
  FXTtlBit:= GetSystemMetrics(SM_CXSIZE); {Button Width}
  FYTtlBit:= GetSystemMetrics(SM_CYSIZE); {Button Height}
  FYCaption:= GetSystemMetrics(SM_CYCAPTION); {Caption Height}

  FCloseButton:= Bounds(Width - FXTtlBit - 5, BTN_TOP, FXTtlBit, FYTtlBit);
  FDownButton:= Bounds(Width - (2 * FXTtlBit) - 3, BTN_TOP, FXTtlBit, FYTtlBit);
  FUpButton:= Bounds(Width - (3 * FXTtlBit) - 1, BTN_TOP, FXTtlBit, FYTtlBit);

  Canvas.Handle := GetWindowDC(Self.Handle);
  FHandle:= Canvas.Handle;

  FCBMP:= TBitmap.Create;
  FDBMP:= TBitmap.Create;
  FUBMP:= TBitmap.Create;

end;

procedure TFFrm_Details.FoldDown;
begin
  if ClientHeight = 0 then
    ClientHeight:= 100;
end;

procedure TFFrm_Details.FoldUp;
begin
  if ClientHeight > 0 then
    ClientHeight:= 0;
end;

procedure TFFrm_Details.FormResize(Sender: TObject);
begin
  inherited;
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

procedure TFFrm_Details.WMNCActivate(var Msg: TWMNCActivate);
begin
  inherited;

  DrawTitleButton;

  with FFrm_Main.ImageList1 do
  begin
    if Msg.Active = True then
    begin
      GetBitmap(1, FCBMP);
      GetBitmap(5, FDBMP);
      GetBitmap(9, FUBMP);
    end
    else
    begin
      GetBitmap(0, FCBMP);
      GetBitmap(4, FDBMP);
      GetBitmap(8, FUBMP);
    end;
  end;

  DrawFinalize;

end;

procedure TFFrm_Details.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;

  {Check to see if the mouse was clicked in the area of the button}
  with Msg do
  begin
    if PtInRect(FCloseButton, Point(XPos - Left, YPos - Top)) then
    begin
      DrawTitleButton;

      with FFrm_Main.ImageList1 do
      begin
        GetBitmap(2, FCBMP);
        GetBitmap(5, FDBMP);
        GetBitmap(9, FUBMP);
      end;

      DrawFinalize;

      Result:= htCloseBtn;
    end;

    if PtInRect(FDownButton, Point(XPos - Left, YPos - Top)) then
    begin
      DrawTitleButton;

      with FFrm_Main.ImageList1 do
      begin
        GetBitmap(1, FCBMP);
        GetBitmap(6, FDBMP);
        GetBitmap(9, FUBMP);
      end;

      DrawFinalize;

      Result:= htDropBtn;
    end;

    if PtInRect(FUpButton, Point(XPos - Left, YPos - Top)) then
    begin
      DrawTitleButton;

      with FFrm_Main.ImageList1 do
      begin
        GetBitmap(1, FCBMP);
        GetBitmap(5, FDBMP);
        GetBitmap(10, FUBMP);
      end;

      DrawFinalize;

      Result:= htCloseUpBtn;
    end;
  end;
end;

procedure TFFrm_Details.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
  inherited;

  if (Msg.HitTest = htCloseBtn) then
  begin
    DrawTitleButton;

    with FFrm_Main.ImageList1 do
    begin
      GetBitmap(3, FCBMP);
      GetBitmap(5, FDBMP);
      GetBitmap(10, FUBMP);
    end;

    DrawFinalize;
  end;

  if (Msg.HitTest = htDropBtn) then
  begin
    DrawTitleButton;

    with FFrm_Main.ImageList1 do
    begin
      GetBitmap(1, FCBMP);
      GetBitmap(7, FDBMP);
      GetBitmap(10, FUBMP);
    end;

    DrawFinalize;
  end;

  if (Msg.HitTest = htCloseUpBtn) then
  begin
    DrawTitleButton;

    with FFrm_Main.ImageList1 do
    begin
      GetBitmap(1, FCBMP);
      GetBitmap(5, FDBMP);
      GetBitmap(11, FUBMP);
    end;

    DrawFinalize;
  end;

end;

procedure TFFrm_Details.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
  inherited;
  if (Msg.HitTest = htCloseBtn) then
    Hide;

  if (Msg.HitTest = htDropBtn) then
    FoldDown;

  if (Msg.HitTest = htCloseUpBtn) then
    FoldUp;
end;

procedure TFFrm_Details.WMNCPaint(var Msg: TWMNCPaint);
begin
  inherited;
  DrawTitleButton;

  with FFrm_Main.ImageList1 do
  begin
    GetBitmap(1, FCBMP);
    GetBitmap(5, FDBMP);
    GetBitmap(9, FUBMP);
  end;

  DrawFinalize;

end;

procedure TFFrm_Details.WMSetText(var Msg: TWMSetText);
begin
  inherited;
  DrawTitleButton;

  with FFrm_Main.ImageList1 do
  begin
    GetBitmap(1, FCBMP);
    GetBitmap(5, FDBMP);
    GetBitmap(9, FUBMP);
  end;

  DrawFinalize;
end;

end.

到目前为止，一切都按预期工作。代码远非完美，我将对其进行调整以获得更好的性能等。 我将另一个组件放到客户区并运行程序。 无论如何，在表单的客户区域中什么都看不到。 这让我很难过。

如果我在 'OnCreate' 事件中在客户区创建我需要的每个组件，并在 'OnDestroy 事件中销毁这些组件，我会看到最初将组件放在客户区后我期望看到的内容。

我的问题。

为什么会这样？我在 winapi 文档中遗漏了什么？

Answer 1

您的错误是忽略了“画布”的工作原理，而不是与 api 相关的任何内容。

procedure TFFrm_Details.DrawTitleButton;
begin
  ...
  Canvas.Handle := GetWindowDC(Self.Handle);
  FHandle:= Canvas.Handle;
  ...
end;

在这里您检索一个窗口 DC 并将其分配给画布句柄。 'FHandle' 字段是您要优化的内容之一。

procedure TFFrm_Details.DrawFinalize;
begin
  ...
  ReleaseDC(Self.Handle, FHandle);
  FCBMP.Free;
  FDBMP.Free;
  FUBMP.Free;
  FHandle:= 0;
end;

在这里，您使画布处于不确定状态。据它所知，它有一个有效的设备上下文。但是你把它从它的脚下拉出来。要更正，请将画布句柄设置为 0。

  ...
  Canvas.Handle := 0;
  ReleaseDC(Self.Handle, FHandle);
  ...

问题在表单流式传输时表现出来。这就是为什么如果您在运行时创建控件它可以工作。

特别是，TCustomForm.ReadState 检查字体大小是否与设计时的字体大小不同，以适当地缩放控件。无效的设备上下文句柄导致画布无法获取字体高度：api 调用 GetTextExtentPoint32 失败，VCL 不检查返回，并且画布报告文本高度为“0”。控件被适当地缩放到宽度/高度 0，有效地使它们不可见。