Warm tip: This article is reproduced from serverfault.com, please click

delphi-为什么在所有VCL控件中“隐藏”了Canvas?

(delphi - Why Canvas is "hidden" in all VCL controls?)

发布于 2020-11-28 14:07:32

我想做一个基本的过程,在任何控件(按钮,面板等)的画布上绘制一些东西(为简单起见,假设为三角形):

procedure DrawTriangle(Control: TCustomControl);

在此函数中,我需要使用Control.Width和Control.Height来知道控件的大小。事实证明,这比想象的要困难得多,因为Canvas受了保护。

一种解决方案是在过程内部获取控件的画布:

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;

但是每次我想画些东西时似乎浪费了CPU来创建和销毁画布...

因此,我的问题是:

  1. 为什么画布被设计隐藏(保护)?
  2. 如何优雅地解决这个问题(一个参数)而又不浪费CPU?

现在,我将重写Paint方法,但这意味着在几个地方重复绘制代码。当然,DrawTriangle可以接收更多参数(画布,控制宽度/高度等),.....但是,好吧……使用公开的Paint方法,一切都会变得更加优雅。

Questioner
Gravity
Viewed
11
Andreas Rejbrand 2020-11-29 00:54:30

在对问题的评论中,事实证明

  1. 仅将此解决方案限于TCustomControl后代,并且
  2. 如果绘制过程可以通过一个简单的函数调用从参数控件中获取画布,则“足够优雅”。

如果是这样,则可以采用以下解决方案:

//
// 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;

注意,DrawFrog只有一个参数,即控件本身。然后,它可以使用简单的函数调用获得控件的画布,而CPU开销却非常小。

完整示例:

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.

尽管如此,我个人仍然会使用传递一个TCanvas(甚至一个HDC)而不是一个控件以及一些尺寸的标准方法

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

这将使我也可以将其用于其他控件(不仅是TCustomControl后代),还可以用于打印机画布等。