gpt4 book ai didi

delphi - 自动调整 TCheckBox 的大小(如 TLabel)

转载 作者:行者123 更新时间:2023-12-03 15:47:31 25 4
gpt4 key购买 nike

我想创建一个可以自动调整其宽度的复选框,就像 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 函数的调用。相反,代码使用传递给 GetDCHWND_DESKTOP 常量。函数允许获取整个屏幕的DeviceContext

关于delphi - 自动调整 TCheckBox 的大小(如 TLabel),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/59107255/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com