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
1unit Unit1;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, Direct2D, Menus;
8
9type
10 TSetColorProc = reference to procedure (color: TColor);
11 TModePaint = (mpNone, mpGDI, mpDirect2D);
12
13 TForm1 = class(TForm)
14 MainMenu1: TMainMenu;
15 GDI1: TMenuItem;
16 Direct2D1: TMenuItem;
17 procedure GDI1Click(Sender: TObject);
18 procedure Direct2D1Click(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure FormPaint(Sender: TObject);
21 private
22 mp: TModePaint;
23 procedure mPaint(c:TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
24 procedure Draw2D;
25 procedure DrawGDI;
26 public
27
28 end;
29
30var
31 Form1: TForm1;
32
33implementation
34uses
35 D2D1, Diagnostics;
36
37
38procedure TForm1.Direct2D1Click(Sender: TObject);
39begin
40 mp := mpDirect2D;
41 invalidate;
42end;
43
44procedure TForm1.Draw2D;
45var
46 LD2DCanvas: TDirect2DCanvas;
47begin
48 LD2DCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
49 with LD2DCanvas do
50 try
51 Font.Name := Canvas.Font.Name;
52 Font.Size := Canvas.Font.Size;
53 Font.Style := Canvas.Font.Style;
54 Font.Pitch := Canvas.Font.Pitch;
55 Font.Orientation := Canvas.Font.Orientation;
56 RenderTarget.BeginDraw;
57
58 pen.Width := 1;
59 Brush.Style := bsClear;
60 LD2DCanvas.Brush.Style := bsSolid;
61 LD2DCanvas.Brush.Color := clWhite;
62
63 RenderTarget.Clear(D2D1ColorF(1.0,1.0,1.0,1.0));
64
65 RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_ALIASED);
66
67 mPaint(LD2DCanvas, ClientRect.Right, ClientRect.Bottom,
68 procedure (c:TColor)
69 begin
70 LD2DCanvas.Pen.Color := c;
71 end
72 );
73 RenderTarget.EndDraw;
74 finally
75 ld2dcanvas.free;
76 end;
77end;
78
79procedure TForm1.DrawGDI;
80begin
81 with Canvas do
82 try
83 Font.Name := Canvas.Font.Name;
84 Font.Size := Canvas.Font.Size;
85 Font.Style := Canvas.Font.Style;
86 Font.Pitch := Canvas.Font.Pitch;
87 Font.Orientation := Canvas.Font.Orientation;
88
89 Lock;
90
91 pen.Width := 1;
92 Brush.Style := bsClear;
93 Brush.Style := bsSolid;
94 Brush.Color := clWhite;
95
96 mPaint(Canvas, ClientRect.Right, ClientRect.Bottom,
97 procedure (c:TColor)
98 begin
99 Canvas.Pen.Color := c;
100 end
101 );
102 finally
103 Unlock;
104 end;
105end;
106
107procedure TForm1.FormCreate(Sender: TObject);
108begin
109 if not TDirect2DCanvas.Supported then
110 begin
111 ShowMessage('Direct2D není podporován!');
112 end;
113
114 mp := mpNone;
115end;
116
117procedure TForm1.FormPaint(Sender: TObject);
118var
119 mp1: TModePaint;
120begin
121 mp1 := mp;
122 mp := mpNone;
123 case mp1 of
124 mpNone: ;
125 mpGDI: DrawGDI;
126 mpDirect2D: Draw2D;
127 end;
128end;
129
130procedure TForm1.GDI1Click(Sender: TObject);
131begin
132 mp := mpGDI;
133 invalidate;
134end;
135
136procedure TForm1.mPaint(c: TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
137var
138 sw: TStopWatch;
139 i: Integer;
140begin
141 sw:= TStopwatch.Create;
142 sw.Start;
143 RandSeed := 1000;
144 for i := 0 to 10000 do
145 begin
146 SetColor(RGB(Random(255), Random(255), Random(255)));
147 c.MoveTo(Random(xMax), Random(yMax));
148 c.LineTo(Random(xMax), Random(yMax));
149 end;
150 sw.Stop;
151 c.FillRect(Rect(100, 100, 100, 100));
152 c.TextOut(100, 100, IntToStr(sw.ElapsedMilliseconds));
153
154end;
155end.
RSS