4

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?

Gabriel
  • 20,797
  • 27
  • 159
  • 293
  • 1
    Obviously, the problem lies in `if HandleAllocated then` of `AjustBounds` method. Because due of nature `TPageControl` (saving resources) *non-active pages are not allocated* until you select appropriate tab. You can easily check it by compiling your app and call for `MyCheckBox.HandleAllocated` that is placed on *non-active page*. That's why `AdjustBounds` method has no effect. – Josef Švejk Nov 29 '19 at 18:14
  • @Dima - It worked. If you post your comment as an answer I will accept it. – Gabriel Nov 29 '19 at 18:20

1 Answers1

7

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.

Josef Švejk
  • 1,047
  • 2
  • 12
  • 23
  • @SertacAkyuz, where can I read about this constant? I actively use `docs` (formerly known as `msdn`), but never see detailed description of this. Could you share some link or something else please? Besides, in VCL `GetDesktopWindow` often used while `HWND_DESKTOP` used only in `Grids.pas` unit. – Josef Švejk Nov 29 '19 at 18:53
  • 1
    In TCustomLabel.AdjustBounds, Embarcadero uses GetDC(0). – Gabriel Nov 29 '19 at 19:08
  • 1
    I'll try to convince you again... There are 2 minor issues with this code. Really minor. First is, you don't have to exit even if GetDesktopWindow returns 0 (which I have no idea if it does ever return 0). Because 0 is perfectly fine to pass to GetDC if you want a DC for the entire screen. You can verify this by referring to the documentation of GetDC. – Sertac Akyuz Nov 29 '19 at 22:08
  • 2
    2nd is, since 0 is perfectly fine to pass to GetDC, you don't even need to call GetDesktopWindow at all. If VCL has code that does, it is a minor issue in VCL code. – Sertac Akyuz Nov 29 '19 at 22:09
  • HWND_DESKTOP is a constant that can be used as a pseudo handle to the desktop window, it's value is 0. You can decide to use that, which makes for a more readable code, when you need a pseudo handle for the desktop window. Or, if you want to stick with the documentation, you can use 0 instead when calling GetDC[Ex]. – Sertac Akyuz Nov 29 '19 at 22:12
  • @SertacAkyuz well long time ago I've used `HWND_DESKTOP`, but only when copied code from Internet and don't understadnd how it works. Since that time I opened for myself `MSDN/DOCS` and found `GetDesktopWindow` very useful. What about `GetDC(0)` - I knew that passing `0` is valid but always thought it is more safer to use `GetDesktopWindow` to obtain `DC` that is related with screen. Well, it is time to change some my views (and some code). Thank you very much! – Josef Švejk Nov 30 '19 at 06:56
  • @WeGoToMars I check it and some other units (f.e. `VCL.Forms`, `VCL.Graphics`) also use it! But I never paid attention to this. Thank you! – Josef Švejk Nov 30 '19 at 07:02
  • I tried to adjust only the height of the checkbox. But by doing so parentfont of my checkbox is suddenly false and not true anymore. And automatic rescaling of the font (moving form from 96 ppi to 144 ppi monitor) does not work anymore – Jens Dec 10 '19 at 09:28
  • Why does CMTextChanged uses invalidate? Inherited solved my resizing problem when I moved the form to another monitor. Parentfont also does not seem to be a problem anymore. – Jens Dec 10 '19 at 10:04
  • @Jens, `Invalidate` is used to make control to repaint itself after text has been changed. What about chaos with adjusting only height of the control - it is hard to say something without seeing actual code. If you have problems with your component - make a new question! ;) – Josef Švejk Dec 13 '19 at 13:33
  • What happens if the canvas of the desktop is not of the same "quality" as the canvas of the app? Could this happen if the app is running virtualized, because of DPI incompatibilities? – Gabriel Mar 10 '22 at 14:01