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”中的客户区创建我需要的每个组件。事件并销毁＆＃39; OnDestroy事件中的那些组件我看到我最初在客户区放置组件后期望看到的内容。

我的问题。

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

Answer 1

你的错误是忽略了画布＆＃39;工作，而不是与api有关的任何事情。

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

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

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未检查返回，并且画布报告文本高度为＆＃39; 0＆＃39 ;。控件适当地缩放到宽度/高度0，有效地使它们不可见。

自定义标题栏按钮成功但

1 个答案: