Anonymní metody a TCustomCanvas

vložil Radek Červinka 26. března 2011 00:20

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).

TDirect2DCanvas

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    { Public declarations }
   28  end;
   29
   30var
   31  Form1: TForm1;
   32
   33implementation
   34uses
   35  D2D1, Diagnostics;
   36{$R *.dfm}
   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//    RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE);
   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.


Nabízíme Delphi školení na různá témata, primárně ve Vaší firmě.

Tagy: , , , ,

Novinky v Delphi

Komentáře

26.3.2011 8:55:23 #

pepak

Abych se přiznal, nevidím v tom příkladu moc motivaci na použití anonymní metody. Co konkrétního pozitivního mi použití anonymní metody přineslo? Velikost kódu zůstala stejná, délka zdrojového kódu taky (tzn. prsty jsem neušetřil):

mPaint(..., procedure ABC() begin ... end)

vs.

procedure ABC() begin ... end;
mPaint(..., @ABC)

(no dobrá, ušetřil jsem středník, enter a @ABC), ale zato jsem získal nekompatibilitu s Delphi staršími než 2009 a docela hnusně nepřehledný kód (a také mimochodem nezparsovatelný řadou standardních nástrojů, třeba DxGetText, UsgParse atd.). Chápal bych použití anonymních metod v jazycích jako PHP, u kterých nemám možnost nadeklarovat nějakou metodu jako privátní pro nějaký blok kódu, ale členění interface-implementation v pascalu mi přijde jako dostatečná ochrana před tím, aby tu "interní" metodu pro zápis pera nepoužil někdo nepovolaný.

pepak

26.3.2011 9:47:16 #

radekc

Přístup k lokálním proměnným. Tj. něco jako u OOP - zapouzdření - schování implementačních detailů.

Pokud bych použil to co navrhuješ: musel bych mít nejméně LD2DCanvas jako proměnnou třídy a mít dvě metody, které se budou referencovat. To ti přijde přehlednější? Mne tedy opravdu ne. Sorry :-)

S kompatibilitou máš pravdu - ale některé věci jako generika, Exit s parametrem mi starší Delphi stejně odříznou. A já za nebudu furt tahat kouli. Nejsem tvůrce komponent. Takže kompatibilita mne opravdu netočí.

radekc

26.3.2011 9:55:11 #

radekc

Aha, ty jsi to myslel jako lokální funkce v ramci těch metod - to pak jo.

radekc

26.3.2011 10:47:09 #

pepak

Přístup k lokálním proměnným stejně nedostaneš:

procedure mPaint(...);
var lokalni1: integer;
begin
end;

mPaint(procedure() begin lokalni1 := 1; end);

Dokonce nedostaneš ani přístup k parametrům:

procedure mPaint(param1: integer; ...);
begin
end;

mPaint(6, procedure() begin param1 := 2; end);

Dostaneš přístup právě jen k tomu, co do té procedury předáváš, a tam mi skutečně přijde podstatně přehlednější zápis se samostatnou pojmenovanou procedurou, která ten "lokální parametr" bude mít mezi svými parametry explicitně uvedený, než mít anonymní proceduru bez explicitního "lokálního parametru" (interně tam stejně je), zato umístěnou uvnitř volání jiné procedury. Ale to je jen záležitost zvyku, uznávám. (Osobně bych to vůbec řešil pěkně objektově, obalující třídou s požadovanými metodami.)

Moje základní námitka je, že u anonymních metod nevidím žádný reálný přínos proti existujícím mechanismům (stejně jako nevidím reálný přínos metod v recordech, když to jen duplikuje stejnou funkčnost u objectů), zato vidím řadu nevýhod (nekompatibilita s kompilátory i utilitami třetích stran). Generika jsou úplně jiný případ, tam mám naprosto evidentní výhody.

pepak

26.3.2011 12:05:38 #

radekc

No pockej: tady podle mne pravdu nemas.

v TForm1.Draw2D je lokalní LD2DCanvas: TDirect2DCanvas;
a k té mám přístup.

      procedure (c:TColor)
      begin
        LD2DCanvas.Pen.Color := c;
      end

radekc

26.3.2011 12:57:17 #

pepak

mPaint je definovaná takhle:

procedure TForm1.mPaint(c: TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);

Tudíž kdybych měl mít přístup k jejím lokálním parametrům, tak bych se na ně odkazoval jako c nebo xMax. Což by byla pochopitelně blbost (jak má volající vědět, jak se ty parametry interně jmenují). Ty (pochopitelně) používáš lokální proměnnou volající metody, ne volané.

Aby bylo zřejmé, co mám přesně na mysli, tak si místo proměnné LD2DCanvas představ nějakou funkci:

mPaint(VratMujUzasnyCanvas(1,2,3), ClientRect.Right, ClientRect.Bottom,
      procedure (c:TColor)
      begin
        VratMujUzasnyCanvas(1,2,3).Pen.Color := c;
      end
      );

No a rázem je veškerá potenciální přehlednost v pytli - a dokonce to nemusí správně fungovat (pokud VratMujUzasnyCanvas vrátí pokaždé jiný objekt, třeba proto, že si ho vždy znovu vytváří). srovnej s řešením, kdy mám Canvas v té barvu nastavující proceduře deklarovaný explicitně a mPaint mi ho skutečně předává:

type TSetColorProc = procedure(c: TCustomCanvas; col: TColor);

procedure TForm1.mPaint(c: TCustomCanvas; xMax, yMax: Integer; SetColor:TSetColorProc);
begin
  SetColor(c, clYellow);
  ...
end;

procedure NastavBarvu(c: TCustomCanvas; color: TColor);
begin
  (c as TDirect2DCanvas).Pen.Color := color;
end;

pepak

27.3.2011 13:16:18 #

PS

GDI: 200 ms
Direct2D: Access violation at address 004B4DB4 in module 'Project1.exe'. Read of address 00000000.
Vista 32bit. Business, HW Aero. Nekompilovane len spusteny .exe. Tak neviem no.

PS

27.3.2011 14:34:07 #

radekc

Hmm, tak to vypadá, že do Direct2D je ve Vistach možno používat jen po nějakých aktualizacích.

http://support.microsoft.com/kb/971644
http://support.microsoft.com/kb/971512

Kazdopadne jsem do FormCreate doplnil informaci, zda byla podpora detekovana. Aktualizovan jak výpis - tak Exe.

Sorry - to jsem nevěděl. Teda pokud je to tím.

radekc

27.3.2011 14:54:35 #

PS

Mám preinštalovanú Vistu bez SP2 zatiaľ. Teraz už vypíše, že Direct2D nepodporované :) .. takže asi musia byť tie aktualizácie ...

PS

28.3.2011 14:33:14 #

JaroB

Zkusil jsem to na Vistách a bez problémů. Zkusil jsem implementaci i pro některé funkce DelphiX a taktéž bez porblémů.

JaroB

28.3.2011 14:53:47 #

radekc

>JaroB
DelphiX je předpokládám časově srovnatelné s Direct2D, že? To je zajímavá alternativa.

radekc

28.3.2011 15:00:37 #

JaroB

Pro kreslení čar se asi moc nehodí, není to příliš optimalizované. Časově to vychází cca 6-7x pomalejší něž Direct2D (možná je to tím, že většina funkcí na DDS není inline, nebo jsem prostě špatně implementoval algoritmus kreslení čáry)

JaroB

28.3.2011 15:14:42 #

JaroB

Jo, moje výsledky na intel Q45 expres (průměry asi z 10-12 spuštění)

GDI .. cca 81 (ale s rozptylem od 78 do 121)
Direct2D .. cca 17 (az 18, jen pár spuštění, vysoce stabilní výsledky)
DelphiX GDI Canvas ..cca 51 (ale s rozptylem od 48 do 62)
DelphiX DDS PokeLine . cca 85 (ale s rozptylem od 71 do 88)

JaroB

28.3.2011 18:04:20 #

Radim

No myslite, ze je uz nadesel cas odseknut uzivatelov XP-eciek pouzitim Direct2D?

Radim

28.3.2011 18:16:55 #

radekc

To neříkám. To dělá jen MS u svého nového IE. Jelikož používá právě Direct2D a proto (nejméně proto) nejde na XP.

Jen říkám, že je to zajímavá možnost a pokud člověk zjistí, že je Direct2D podporováno tak ho může využít.

radekc

8.4.2011 18:59:33 #

PS

po doinštalovaní horeuvedných aktualizácii do Windows VIsta Direct2D funguje (nie sú súčasťou SP2).
Avšak sú v systéme ako optional aktualizácie, takže tak ...

PS

Komentování ukončeno

Naše nabídka

Partial English version.

MVP
Ing. Radek Červinka - Embarcadero MVP
profil na linkedin, Twitter:@delphicz

Nabízím placené poradenství a konzultace v oblasti programování a vývoje SW.
Dále nabízíme i vývoj speciálního software na zakázku.

Neváhejte nás kontaktovat (i ohledně reklamy nebo burzy práce).

Pokud chcete podpořit tento server libovolnou částkou, můžete použít PayPal. Moc děkuji.

Delphi Certified Developer

O Delphi.cz

Delphi je jediný moderní RAD nástroj podporující tvorbu nativních aplikací pro platformu Win32, Win64 , Mac OSX a na iPhone a Android (s výhledem na další platformy díky FireMonkey) na současném trhu (včetně Windows 8.1).

V současnosti je světová komunita přes dva miliónů vývojářů.

Delphi.cz je nezávislý portál pro uživatele Delphi. Portál není koncipován pro úplné začátečníky, i když i ti se zde nebudou nudit, ale spíše na programátory, kteří již něco znají a chtějí své znalosti dále rozvíjet a sledovat novinky.

Anketa

Poslední komentáře

Comment RSS