I want to create a checkbox that can automatically resize its width, exactly like 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.
But I have a problem. The checkboxes placed in non-active tabs of a PageControl won't automatically recompute their size. In other words, if I have two tabs that contain a checkbox, at application start up, only the checkbox in the current open tab will be correctly resized. When I click the other tab, the checkbox will have the original size (the one set at design time).
I do set the size of the font for the entire form at program startup (after Form Create, with 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;
Why the checkbox in the non-active tab is not announced that the font has changed?
As I have stated in comment to the question, the problem lies in the fact that TPageControl
initializes only the page that is currently selected. It means that another pages will have no valid handle. Since this, all components that are placed on them have no handle as well. This is a reason for which AdjustBounds
method does not work at all.
But this bad situation can be solved with getting DeviceContext
in other manner using constant HWND_DESKTOP
(see Update part for details).
See the code below:
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;
Update
Since some useful comments have been posted, I changed the code to get rid of call to GetDesktopWindow
function. Instead, code uses HWND_DESKTOP
constant that being passed to GetDC function allows obtain DeviceContext
for the entire screen.