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

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.

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

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

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.

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.

Poslední komentáře

Comment RSS