我想做一个基本的过程,在任何控件(按钮,面板等)的画布上绘制一些东西(为简单起见,假设为三角形):
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来创建和销毁画布...
因此,我的问题是:
现在,我将重写Paint方法,但这意味着在几个地方重复绘制代码。当然,DrawTriangle可以接收更多参数(画布,控制宽度/高度等),.....但是,好吧……使用公开的Paint方法,一切都会变得更加优雅。
在对问题的评论中,事实证明
TCustomControl
后代,并且如果是这样,则可以采用以下解决方案:
//
// 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
后代),还可以用于打印机画布等。
仅供参考,VCL有一个可
TControlCanvas
用于绘制任何的类TControl
。因此,您无需TCustomControl.Canvas
手动破解。