Delphi 2010 - Direct2D

vložil Radek Červinka 14. března 2010 22:59

Ve Windows 7 je nová API možnost - Direct2D, tj. možnost použít část Direct X pro akcelerované zobrazení i v normálních aplikacích. Jedná se samozřejmě o nativní API (tj. je dostupné pro normální kompilované aplikace) - stejně jako všechny ostatní nové API. MS slibuje, že rozhraní bude dostupné i pro Windows Vista (aktuální stav nevím), o XP se jen uvažovalo. Proti klasickým DirectX aplikacím umožňuje Direct2D míchat normální (GDI) zobrazení a nové v jednom okně.

Delphi 2010 přináší pro toto rozhraní podporu a to velmi pěkným způsobem. Nově existuje následník klasické třídy TCanvas s názvem TDirect2DCanvas a tato třída (plus pár jednotek) zajišťuje slušnou podporu.

Nové API přináší kromě akcelerace i průhlednost, transformace, vyhlazování, ID2D1Geometry (teselace…) atd.

Pro programování je nutné použít tyto dvě jednotky: Direct2D, D2D1. Uvedená třída publikuje některé klasické metody, pokud potřebujete něco z Direct2D tak přes metodu RenderTarget. Implementace klasických metod Vám napoví ohledně implementace vlastních metod.

Aspoň malé demo. Mějme klasickou VCL aplikaci, s událostmi OnCreate, OnPaint. A pamatujte, že primární určení jsou Windows 7.

    1uses
    2  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    3  Dialogs, Direct2D, D2D1;
    4
    5type
    6  TForm1 = class(TForm)
    7    procedure FormCreate(Sender: TObject);
    8  private
    9    FCanvas: TDirect2DCanvas;
   10  protected
   11    procedure Paint; override;
   12  public
   13  end;
   14
   15var
   16  Form1: TForm1;
   17
   18implementation
   19
   20{$R *.dfm}
   21
   22
   23procedure TForm1.FormCreate(Sender: TObject);
   24begin
   25  if not TDirect2DCanvas.Supported then
   26  begin
   27    ShowMessage('Direct2D není podporován!');
   28    Application.Terminate;
   29  end;
   30end;
   31
   32procedure TForm1.Paint;
   33var
   34  I: Integer;
   35  d2dCanvas: TDirect2DCanvas;
   36begin
   37  d2dCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
   38  d2dCanvas.Brush.Assign(Canvas.Brush);
   39  d2dCanvas.BeginDraw;
   40  try
   41    d2dCanvas.Brush.Color := clGreen;
   42    d2dCanvas.Pen.Color := clBlue;
   43    for I := 1 to 10 do
   44    begin
   45      d2dCanvas.Brush.Handle.SetOpacity(0.1 * I);
   46      d2dCanvas.RoundRect(10, 10, 300 - I * 20, 300 - I * 20, 20, 20);
   47    end;
   48  finally
   49    d2dCanvas.EndDraw;
   50    d2dCanvas.Free;
   51  end;
   52end;
   53end.

Delphi Direct2D

Další příklady Chris Bensen, MSDN a hlavně v knize Delphi 2010 Handbook.

Jen ještě část rozhraní TDirect2DCanvas:

    1TDirect2DCanvas = class(TCustomCanvas)
    2//…………
    3  public
    4    class function Supported: Boolean; //Direct2D podporováno
    5
    6    constructor Create(DC: HDC; SubRect: TRect); overload;
    7    constructor Create(Canvas: TCanvas; SubRect: TRect); overload;
    8    constructor Create(Handle : HWND); overload;
    9
   10    function CreateBrush(Color: TColor): ID2D1Brush; overload;
   11    function CreateBrush(Bitmap: TBitmap): ID2D1Brush; overload;
   12    function CreateBrush(Colors: array of TColor; StartPoint, EndPoint: TD2D1Point2F):
   13           ID2D1Brush; overload;
   14    function CreateBrush(Colors: array of TColor; Center, Offset: TD2D1Point2F;
   15      RadiusX, RadiusY: Single): ID2D1Brush; overload;
   16
   17    function CreateBitmap(Bitmap: TBitmap): ID2D1Bitmap;
   18
   19    procedure BeginDraw;
   20    procedure EndDraw;
   21
   22    procedure DrawEllipse(const Ellipse: TD2D1Ellipse);
   23    procedure DrawGeometry(Geometry: ID2D1Geometry);
   24    procedure DrawLine(Point0, Point1: TD2DPoint2f);
   25    procedure DrawRectangle(const Rect: TD2D1RectF);
   26    procedure DrawRoundedRectangle(const RoundedRect: TD2D1RoundedRect);
   27
   28    procedure FillEllipse(const Ellipse: TD2D1Ellipse);
   29    procedure FillGeometry(Geometry: ID2D1Geometry);
   30    procedure FillRectangle(const Rect: TD2D1RectF);
   31    procedure FillRoundedRectangle(const roundedRect: TD2D1RoundedRect);
   32
   33    // Override common functions from TCustomCanvas
   34    procedure Arc(X1: Integer; Y1: Integer; X2: Integer; Y2: Integer;
   35      X3: Integer; Y3: Integer; X4: Integer; Y4: Integer); override;
   36    procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
   37    procedure FillRect(const Rect: TRect); override;
   38    procedure FrameRect(const Rect: TRect); override;
   39    procedure Ellipse(X1, Y1, X2, Y2: Integer); override;
   40    procedure Rectangle(X1, Y1, X2, Y2: Integer); override;
   41    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); override;
   42    procedure Draw(X, Y: Integer; Graphic: TGraphic); overload; override;
   43    procedure Draw(X, Y: Integer; Graphic: TGraphic; Opacity: Byte); overload; override;
   44    procedure StretchDraw(const Rect: TRect; Graphic: TGraphic); overload; override;
   45    procedure StretchDraw(const Rect: TRect; Graphic: TGraphic; 
   46          Opacity: Byte); reintroduce; overload;
   47    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); override;
   48    procedure PolyBezier(const Points: array of TPoint); override;
   49    procedure Polygon(const Points: array of TPoint); override;
   50    procedure Polyline(const Points: array of TPoint); override;
   51
   52    procedure LineTo(X, Y: Integer); override;
   53    procedure MoveTo(X, Y: Integer); override;
   54    procedure PolyBezierTo(const Points: array of TPoint); override;
   55    procedure Refresh; override;
   56
   57    function TextExtent(const Text: string): TSize; override;
   58    procedure TextOut(X, Y: Integer; const Text: string); override;
   59    procedure TextRect(var Rect: TRect; var Text: string; 
   60            TextFormat: TTextFormat = []); overload; override;
   61    procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string); overload; override;
   62
   63    // Operations from TCustomCanvas that are invalid on a TDirect2DCanvas
   64    procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
   65      const Source: TRect; Color: TColor); override;
   66    procedure DrawFocusRect(const Rect: TRect); override;  
   67          // Doesn't have a concept of XOR brushes/pens
   68    procedure FloodFill(X, Y: Integer; Color: TColor; 
   69          FillStyle: TFillStyle); override;
   70
   71// zpristupnení zbytku rozhraní Direct2D
   72    property RenderTarget : ID2D1RenderTarget read GetRenderTarget;
   73    property Brush: TDirect2DBrush read GetBrush write SetBrush;
   74    property Pen: TDirect2DPen read GetPen write SetPen;
   75    property Font: TDirect2DFont read GetFont write SetFont;
   76  end;


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

Tagy: , ,

Recenze

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