vendredi 29 novembre 2019

TCheckBox that autoresize (like TLabel)

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