我想创建一个可以自动调整其宽度的复选框,就像 TLabel 一样。
UNIT cvCheckBox;
{ It incercepts CMTextChanged where it recomputes the new Width}
INTERFACE
USES
Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls;
TYPE
TcCheckBox = class(TCheckBox)
private
FAutoSize: Boolean;
procedure AdjustBounds;
procedure setAutoSize(b: Boolean); reintroduce;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
published
//property Caption read GetText write SetText;
property AutoSize: Boolean read FAutoSize write setAutoSize stored TRUE;
end;
IMPLEMENTATION
CONST
SysCheckWidth: Integer = 21; // In theory this can be obtained from the "system"
constructor TcCheckBox.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FAutoSize:= TRUE;
end;
procedure TcCheckBox.AdjustBounds;
VAR
DC: HDC;
Canvas: TCanvas;
begin
if not (csReading in ComponentState) and FAutoSize then
begin
// this caused the problem [solution provided by Dima]
if HandleAllocated then // Deals with the missing parent during Creation
begin
// We need a canvas but this control has none. So we need to "produce" one.
Canvas := TCanvas.Create;
DC := GetDC(Handle);
TRY
Canvas.Handle := DC;
Canvas.Font := Font;
Width := Canvas.TextWidth(Caption) + SysCheckWidth + 4;
Canvas.Handle := 0;
FINALLY
ReleaseDC(Handle, DC);
Canvas.Free;
END;
end;
end;
end;
procedure TcCheckBox.setAutoSize(b: Boolean);
begin
if FAutoSize <> b then
begin
FAutoSize := b;
if b then AdjustBounds;
end;
end;
procedure TcCheckBox.CMTextChanged(var Message:TMessage);
begin
Invalidate;
AdjustBounds;
end;
procedure TcCheckBox.CMFontChanged(var Message:TMessage);
begin
inherited;
if AutoSize
then AdjustBounds;
end;
procedure TcCheckBox.Loaded;
begin
inherited Loaded;
AdjustBounds;
end;
end.
但我有一个问题。放置在 PageControl 的非事件选项卡中的复选框不会自动重新计算其大小。换句话说,如果我有两个包含复选框的选项卡,则在应用程序启动时,只有当前打开的选项卡中的复选框会正确调整大小。当我单击另一个选项卡时,复选框将具有原始大小(设计时设置的大小)。
我确实在程序启动时设置了整个表单的字体大小(在 Form Create 之后,使用 PostMessage(Self.Handle, MSG_LateInitialize) )。
procedure TForm5.FormCreate(Sender: TObject);
begin
PostMessage(Self.Handle, MSG_LateInitialize, 0, 0);
end;
procedure TForm5.LateInitialize(var message: TMessage);
begin
Font:= 22;
end;
为什么非事件选项卡中的复选框没有宣布字体已更改?
最佳答案
正如我在对该问题的评论中所述,问题在于 TPageControl
仅初始化当前选定的页面。这意味着其他页面将没有有效的句柄。因此,放置在其上的所有组件也没有 handle 。这是 AdjustBounds
方法根本不起作用的原因。
但是这种糟糕的情况可以通过使用常量 HWND_DESKTOP
以其他方式获取 DeviceContext
来解决(有关详细信息,请参阅更新部分)。
请参阅下面的代码:
procedure TcCheckBox.AdjustBounds;
var
DC: HDC;
Canvas: TCanvas;
begin
if not (csReading in ComponentState) and FAutoSize then
begin
// Retrieve DC for the entire screen
DC := GetDC(HWND_DESKTOP);
try
// We need a canvas but this control has none. So we need to "produce" one.
Canvas := TCanvas.Create;
try
Canvas.Handle := DC;
Canvas.Font := Font;
Width := Canvas.TextWidth(Caption) + SysCheckWidth + 4;
Canvas.Handle := 0;
finally
Canvas.Free;
end;
finally
ReleaseDC(HWND_DESKTOP, DC);
end;
end;
end;
更新
由于已经发布了一些有用的注释,我更改了代码以消除对 GetDesktopWindow
函数的调用。相反,代码使用传递给 GetDC 的 HWND_DESKTOP
常量。函数允许获取整个屏幕的DeviceContext
。
关于delphi - 自动调整 TCheckBox 的大小(如 TLabel),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/59107255/