delphicheckboxdelphi-xe7autoresize

Autoresizing TCheckBox (like TLabel)


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?


Solution

  • 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.