Search code examples
delphicanvasvcllazarus

Why Canvas is "hidden" in all VCL controls?


I want to do a basic procedure that draws something (let's say a triangle, for simplicity) on any control's (button, panel, etc) canvas:

procedure DrawTriangle(Control: TCustomControl);

In this function I need to use Control.Width & Control.Height to know how big is the control. Turns out to be more difficult than imagined because Canvas is protected.

A solution would be to obtain the canvas of the control inside the procedure:

VAR
   ParentControl: TWinControl;
   canvas: TCanvas;
begin
 ParentControl:= Control.Parent;
 Canvas:= TCanvas.Create;
 TRY
  Canvas.Handle:= GetWindowDC(ParentControl.Handle);
  WITH Canvas DO
    xyz
 FINALLY
   FreeAndNil(canvas);
 END;
end;

But seems such a waste of CPU to create and destroy a canvas each time I want to paint something...

So, my questions are:

  1. Why was canvas hidden (protected) by design?
  2. How to solve this elegantly (one single parameter) and without wasting CPU?

Now I am overriding the Paint method, but this means duplication the painting code in several places. Of course, the DrawTriangle could receive more parameters (Canvas, Control Width/Height etc), .... but well... with an exposed Paint method, everything would have been so much more elegant.


Solution

  • In a comment to the question it turns out that

    1. it is enough for this solution to be restricted to TCustomControl descendants, and
    2. it is "elegant" enough if the drawing procedure can obtain the canvas from the argument control with a simple function call.

    If so, the following solution is possible:

    //
    // Infrastructure needed
    //
    
    type
      TCustomControlCracker = class(TCustomControl)
      end;
    
    function CustomControlCanvas(AControl: TCustomControl): TCanvas;
    begin
      Result := TCustomControlCracker(AControl).Canvas;
    end;
    
    //
    // My reusable drawing functions
    // (Can only be used in TCustomControl descendants)
    //
    
    procedure DrawFrog(AControl: TCustomControl);
    var
      Canvas: TCanvas;
    begin
      Canvas := CustomControlCanvas(AControl);
      Canvas.TextOut(10, 10, 'Frog');
    end;
    

    Notice that DrawFrog only takes a single parameter, the control itself. And it can then obtain the control's canvas using a simple function call with extremely little CPU overhead.

    Full example:

    unit Unit1;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
    
    type
      TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    type
      TTestControl = class(TCustomControl)
      protected
        procedure Paint; override;
      end;
    
    type
      TCustomControlCracker = class(TCustomControl)
      end;
    
    function CustomControlCanvas(AControl: TCustomControl): TCanvas;
    begin
      Result := TCustomControlCracker(AControl).Canvas;
    end;
    
    procedure DrawFrog(AControl: TCustomControl);
    var
      Canvas: TCanvas;
    begin
      Canvas := CustomControlCanvas(AControl);
      Canvas.TextOut(10, 10, 'Frog');
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      with TTestControl.Create(Self) do
      begin
        Parent := Self;
        Top := 100;
        Left := 100;
        Width := 400;
        Height := 200;
      end;
    end;
    
    { TTestControl }
    
    procedure TTestControl.Paint;
    begin
      inherited;
      Canvas.Brush.Color := clSkyBlue;
      Canvas.FillRect(ClientRect);
      DrawFrog(Self); // use my reusable frog-drawing function
    end;
    
    end.
    

    All this being said, however, I would personally still use the standard approach of passing a TCanvas (or even a HDC) instead of a control, together with some dimensions:

    procedure DrawFrog(ACanvas: TCanvas; const ARect: TRect);
    

    This will allow me to use it for other controls as well (not only TCustomControl descendants), as well as printer canvases etc.