Anonymní metody jsou silně nedoceněnou vlastností nových Delphi.
Jen pro zajímavost jsem orientačně porovnával rychlost TDirect2DCanvas a TCanvas. Při té příležitosti jsem narazil na problém jehož řešení velmi zjednodušilo použití anonymních metod.
Laskavý čtenář si podrobnosti o obou tématech najde za pomoci tagu dole, já jen připomenu TDirect2DCanvas je od Delphi 2010 a anonymní metody od Delphi 2009.
TDirect2DCanvas a TCanvas jsou následníkem TCustomCanvas, kterážto třída obsahuje většinu metod (abstractních) dříve definovaných přímo v TCanvas. Bohužel neobsahuje TPen a některé další property, už jen z toho důvodu, že implementačně je to dost odlišné. Příslušné property obsahují následníci, čímž zachovávají rozhraní aspoň pro kompilaci. Než bych zduplikoval testovací metodu tak jsem raději použil anonymní metodu pro nastavení barvy pera.
Z mého hlediska to bylo těžší, jelikož jsem potřeboval mít stejnou metodu pro kreslení, kterou bych jednou provedl pro klasické GDI TCanvas a podruhé pro HW akcelerované TDirect2DCanvas. Připomínám, že druhé je dostupné na Windows 7 a pravděpodobně Vista - což mimochodem znamená, že jsem konečně přešel z Windows XP SP3 na Windows 7 64bit jako svůj primární OS (používám tam Delphi 5, Delphi 2007 s 64bit patchem - už se to zde probíralo - a Delphi XE).
Společná testovací metoda (viz listing) je
procedure mPaint(c:TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
kde SetColor je anonymní metoda
type
TSetColorProc = reference to procedure (color: TColor);
všimněte si prosím ve výpisu jak se mPaint volá
mPaint(LD2DCanvas, ClientRect.Right, ClientRect.Bottom,
procedure (c:TColor)
begin
LD2DCanvas.Pen.Color := c;
end
);
pro upřesnění: LD2DCanvas.Pen je platné v místě volání mPaint, ale už není platné v těle metody. Kompilátor to přeloží zhruba jako proceduru, kde budou absolutní odkazy do správné struktury a do volané procedury předá jen referenci na tuto "dočasnou" proceduru.
V těle metody mPaint se programátor odkazuje na anonymní metodu a vše je OK.
No a pro zajímavost výsledek testu:
- kreslení GDI (tj. std. TCanvas) - cca 220ms silně závisející na rozlišení (100 - 700ms)
- kreslení Direct2D (TDirect2DCanvas) - 16ms bez závislosti na rozlišení (první volání 200ms z IDE, bez IDE 40ms)
Tj. druhá možnost je řádově rychlejší bez závislosti na rozlišení. Zbytek programu jsou jen opičky kolem.
zdrojové kódy a přeložená aplikace (0.5M)
Výpis programu
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Direct2D, Menus;
type
TSetColorProc = reference to procedure (color: TColor);
TModePaint = (mpNone, mpGDI, mpDirect2D);
TForm1 = class(TForm)
MainMenu1: TMainMenu;
GDI1: TMenuItem;
Direct2D1: TMenuItem;
procedure GDI1Click(Sender: TObject);
procedure Direct2D1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
mp: TModePaint;
procedure mPaint(c:TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
procedure Draw2D;
procedure DrawGDI;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
D2D1, Diagnostics;
{$R *.dfm}
procedure TForm1.Direct2D1Click(Sender: TObject);
begin
mp := mpDirect2D;
invalidate;
end;
procedure TForm1.Draw2D;
var
LD2DCanvas: TDirect2DCanvas;
begin
LD2DCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
with LD2DCanvas do
try
Font.Name := Canvas.Font.Name;
Font.Size := Canvas.Font.Size;
Font.Style := Canvas.Font.Style;
Font.Pitch := Canvas.Font.Pitch;
Font.Orientation := Canvas.Font.Orientation;
RenderTarget.BeginDraw;
pen.Width := 1;
Brush.Style := bsClear;
LD2DCanvas.Brush.Style := bsSolid;
LD2DCanvas.Brush.Color := clWhite;
RenderTarget.Clear(D2D1ColorF(1.0,1.0,1.0,1.0));
// RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE);
RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_ALIASED);
mPaint(LD2DCanvas, ClientRect.Right, ClientRect.Bottom,
procedure (c:TColor)
begin
LD2DCanvas.Pen.Color := c;
end
);
RenderTarget.EndDraw;
finally
ld2dcanvas.free;
end;
end;
procedure TForm1.DrawGDI;
begin
with Canvas do
try
Font.Name := Canvas.Font.Name;
Font.Size := Canvas.Font.Size;
Font.Style := Canvas.Font.Style;
Font.Pitch := Canvas.Font.Pitch;
Font.Orientation := Canvas.Font.Orientation;
Lock;
pen.Width := 1;
Brush.Style := bsClear;
Brush.Style := bsSolid;
Brush.Color := clWhite;
mPaint(Canvas, ClientRect.Right, ClientRect.Bottom,
procedure (c:TColor)
begin
Canvas.Pen.Color := c;
end
);
finally
Unlock;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if not TDirect2DCanvas.Supported then
begin
ShowMessage('Direct2D není podporován!');
end;
mp := mpNone;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
mp1: TModePaint;
begin
mp1 := mp;
mp := mpNone;
case mp1 of
mpNone: ;
mpGDI: DrawGDI;
mpDirect2D: Draw2D;
end;
end;
procedure TForm1.GDI1Click(Sender: TObject);
begin
mp := mpGDI;
invalidate;
end;
procedure TForm1.mPaint(c: TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
var
sw: TStopWatch;
i: Integer;
begin
sw:= TStopwatch.Create;
sw.Start;
RandSeed := 1000;
for i := 0 to 10000 do
begin
SetColor(RGB(Random(255), Random(255), Random(255)));
c.MoveTo(Random(xMax), Random(yMax));
c.LineTo(Random(xMax), Random(yMax));
end;
sw.Stop;
c.FillRect(Rect(100, 100, 100, 100));
c.TextOut(100, 100, IntToStr(sw.ElapsedMilliseconds));
end;
end.
RSS