I want to create a checkbox that can automatically resize its width, exactly like TLabel. 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 custom checkbox, at aplication start up only the checkbox in the current open tab will be correctly resized. When I click the other tab, the checks will have the original width (the one set at design time).
UNIT cvCheckBox;
{--------------------------------------------------------------------------------------------------
A checkbox that autoresizes exactly like TLabel
It incercepts CMTextChanged where it recomputes the new Width
Features:
+ Autoresize width to fix the text inside
+ property AutoSize;
--------------------------------------------------------------------------------------------------}
INTERFACE
{$DEBUGINFO ON}
{$WARN GARBAGE OFF} {Silence the: 'W1011 Text after final END' warning }
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;
procedure Register;
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
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;
procedure Register;
begin
RegisterComponents('test', [TcCheckBox]);
end;
{
procedure TcCheckBox.SetText(const Value: TCaption);
begin
if GetText <> Value then
begin
SetTextBuf(PChar(Value));
if FAutoSize then AdjustBounds;
end;
end;
function TcCheckBox.GetText: TCaption;
var
Len: Integer;
begin
Len := GetTextLen;
SetString(Result, PChar(nil), Len);
if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1);
end; }
end.
I do set the size of the font for the entire form at program startup (after Form Create, with PostMessage(Self.Handle, MSG_LateInitialize) ).
Why my checkbox is not announced that the font has changed?
procedure TForm5.FormCreate(Sender: TObject);
begin
PostMessage(Self.Handle, MSG_LateInitialize, 0, 0);
end;
procedure TForm5.LateInitialize(var message: TMessage);
begin
Font:= 22;
end;
Aucun commentaire:
Enregistrer un commentaire