Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年08月08日] [更新 2013年01月26日]　Delphi サンプルプログラム集
   
194_線の端点形状の変更と Direct2D
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
Window Vista(SP2) より前では動作不可．Delphi 2010 より前ではコンパイル不可
194_Direct2DBasic.zip　[2,931 KB]　2013年01月26日版 (EXE 同梱)



  • 2013年01月26日
  • ページ構成を変更して，サンプル [4] [5] を追加



Direct2D


Direct2D は Windows 7 で正式に導入された機能です．
[190_線の端点形状を変更] では GDI を，[192_線の端点形状を変更 GDI+ 使用] では GDI+ を使用して線の端点の形状の変更と太い点線の描画をしました．今回は，Delphi 2010 で使用可能となった，この機能を使用して描画してみます．Direct2D の簡単なテストもしてみました．
Direct2D を使用するには，uses に Direct2D, D2D1 を追加します．

Direct2D ではアンチエイリアス，画像の回転などが比較的簡単にできます． Windows Vista の SP2 以降で使用可能です．


まず，Delphi XE の [サンプル] フォルダ内にある Direct2D のデモプログラムを実行してみました．その図です．いろいろいな図形の線の太さ，色を変更して，リサイズができます．


図1
設計時画面
  • プロジェクトを起動した時のフォーム
図2
実行画面の例
  • JPEG 画像を読み込んで，リサイズ中
  • 表示される小さな○のグラブハンドルを「マウスで掴んで」ドラッグする
図3
図形をリサイズ中
  • RoundRectangle を描いて，線の太さと色を変えている




01_線の端点形状と太い点線


最初の線は，実線の両端をフラットにして描画します．Direct2D のデフォルトはこのフラットです．
太い点線，一転鎖線等も描画できます．一番下は始点と終点を丸にしています．


図4
実行結果

リスト1
線の端点形状と太い点線 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Direct2D, D2D1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Direct2Dを使用した描画
//  線の端点形状の変更と太い点線
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  D2Canvas            : TDirect2DCanvas;
  D2Brush             : ID2D1SolidColorBrush;
  D2StrokeStyle       : ID2D1StrokeStyle;
  D2StrokeStyleProper : TD2D1StrokeStyleProperties;
  D2Point1            : D2D_POINT_2F;
  D2Point2            : D2D_POINT_2F;
begin
　if not TDirect2DCanvas.Supported then exit;

  //Direct2DのCanvasを生成
  D2Canvas := TDirect2DCanvas.Create(PaintBox1.Canvas, PaintBox1.ClientRect);
  try
    //背景を塗り潰す
    PaintBox1.Canvas.Brush.Color := clWhite;
  　PaintBox1.Canvas.Brush.Style := bsSolid;
    PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);


    //描画コード開始宣言
    D2Canvas.BeginDraw;


    //最初の線
    D2Canvas.Pen.Color := clRed;
    D2Canvas.Pen.Width := 14;
    D2Canvas.Pen.Color := clBlue;
    D2Canvas.MoveTo (20, 40);
    D2Canvas.LineTo (PaintBox1.Width - 20, 40);


    //2番目の線
    D2Canvas.Pen.Style := psDot;
    D2Canvas.MoveTo (20, 70);
    D2Canvas.LineTo (PaintBox1.Width - 20, 70);


    //3番目の線

    //Brushの設定(IBrushに設定内容が出力される)
    D2Canvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clGreen), nil, D2Brush);
    //ストロークスタイルの設定(ここでは両端を丸にする)
    //JOINの仕様を設定する引数もある
    D2StrokeStyleProper := D2D1StrokeStyleProperties(
                                             D2D1_CAP_STYLE_ROUND,
                                             D2D1_CAP_STYLE_ROUND);
    //設定したストロークからIStrokStyleに値を取り出す
    D2DFactory.CreateStrokeStyle(D2StrokeStyleProper, nil, 0, D2StrokeStyle);

    D2Point1 :=  D2D1PointF(20, 100);
    D2Point2 :=  D2D1PointF(PaintBox1.Width - 20, 100);
    D2Canvas.RenderTarget.DrawLine(D2Point1,       //描画開始点
                                   D2Point2,       //描画終了点
                                   D2Brush,        //Brush
                                   14,             //太さ
                                   D2StrokeStyle); //ストロークの形状

    //描画コードの終了宣言
    //このメソッドで実際の描画が実行される
    D2Canvas.EndDraw;
  finally
    D2Canvas.Free;
  end;
end;

end.



02_アンチエイリアスの効果を確認


Direct2D では，少なくとも線を描画する時は，デフォルトでアンチエイリアス処理をしてくれるようです．そのテストです．もう少し太い線でテストした方が効果を確認しやすいかも知れません．


図5
設計時画面
  • TPaintBox を 2 つ配置．ここに直線を描画する
図6
実行画面

実行結果の直線を拡大した図です．アンチエイリアスの効果があることが確認できます．


図7
描画した直線を拡大した図
  • 左が Direct2D で描画した直線
    アンチエイリアス処理が行われている
  • 右は通常の TCanvas に描画した直線

リスト2
アンチエイリアスの効果を確認 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Direct2D, D2D1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Direct2Dを使用した描画
//  アンチエイリアスの効果を確認
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  D2ACanvas : TDirect2DCanvas;
  D2Point1  : D2D_POINT_2F;
  D2Point2  : D2D_POINT_2F;
begin
　if not TDirect2DCanvas.Supported then exit;

  //Direct2DのCanvasを生成
  D2ACanvas := TDirect2DCanvas.Create(PaintBox1.Canvas, PaintBox1.ClientRect);

  try
    //描画開始
    D2ACanvas.BeginDraw;

    //PaintBox1に斜め直線を引く
    D2Point1 :=  D2D1PointF(0,  0);
    D2Point2 :=  D2D1PointF(10, 40);
    D2ACanvas.DrawLine(D2Point1, D2Point2);

    //描画終了
    D2ACanvas.EndDraw;
  finally
    D2ACanvas.Free;
  end;

  //PaintBox2に斜め直線を引く
  PaintBox2.Canvas.MoveTo(0,  0);
  PaintBox2.Canvas.LineTo(10, 40);
end;

end.



03_JPEG 画像を TImage に描画


JPEG 画像ファイルをディスクから読み出して表示する簡単なサンプルです．画像の加工や処理は一切ありません．StretchDraw 関数の引数に，透明度を指定する引数があるので，テストしてみました．
画像を扱うのに，Delphi 2010 から実装された TWICImage を使用しています．


[備考]
Windows API の AlphaBlend 関数を使用すると，Delphi 2009 よりも前の Delphi でも画像を半透明で表示できます．



図8
設計時画面
図9
実行して Button1 をクリック
  • 右下に半透明画像を表示

リスト3
JPEG 画像を TImage に描画 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Direct2D, D2D1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Direct2Dを使用した描画
//  JPEG画像をTImageに描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  D2Canvas     : TDirect2DCanvas;
  WIC          : TWICImage;
  FileFullPath : String;
  ARect        : TRect;
begin
　if not TDirect2DCanvas.Supported then exit;

  //TWICImageのインスタンスとDirect2DのCanvasを生成
  WIC      := TWICImage.Create;
  D2Canvas := TDirect2DCanvas.Create(Image1.Canvas, Image1.ClientRect);
  try
    //JPEG画像を読み出す
    FileFullPath := ExtractFilePath(Application.ExeName) + '001.JPG';
    WIC.LoadFromFile(FileFullPath);

    //描画開始
    D2Canvas.BeginDraw;

    //JPEG画像を描画
    D2Canvas.StretchDraw(Image1.ClientRect, WIC);

    //TImageの右下半分の位置に，同じ画像の半透明画像を描画
    ARect := Bounds(Image1.Width  div 2,
                    Image1.Height div 2,
                    Image1.Width  div 2,
                    Image1.Height div 2);
    D2Canvas.StretchDraw(ARect, WIC, 150);

    //描画終了
    D2Canvas.EndDraw;
  finally
    D2Canvas.Free;
    WIC.Free;
  end;
end;

end.



04_放射状グラデーションブラシ


放射状のグラデーションのサンプルです．
ID2D1RadialGradientBrush インターフェイスを使用しています．


図10
実行画面

リスト4
放射状グラデーションブラシ 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Direct2D, D2D1;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  OnPaintイベント
//  放射状のグラデーションブラシ
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  D2Canvas          : TDirect2DCanvas;
  D2GradBrush       : ID2D1RadialGradientBrush;
  DrawRect          : TRect;
  D2RGBProper       : TD2D1RadialGradientBrushProperties;
  D2arrGradientStop : array[0..1] of TD2D1GradientStop;
  D2GradientStops   : ID2D1GradientStopCollection;
begin
　if not TDirect2DCanvas.Supported then exit;

  //描画先のCanvasの指定
  D2Canvas := TDirect2DCanvas.Create(Canvas, ClientRect);

  //そのCanvasのこの範囲に描画
  DrawRect := Rect(30, 30, ClientWidth - 30, ClientHeight - 30);


  //グラデーションブラシ境界の相対位置を示す値
  D2arrGradientStop[0].position := 0.0;
  D2arrGradientStop[1].position := 1.0;

  //グラデーション境界の色(開始色と終値色)
  D2arrGradientStop[0].color := D2D1ColorF(clWhite);
  D2arrGradientStop[1].color := D2D1ColorF(clBlack);

  //ID2D1GradientStopCollection オブジェクトの作成
  //グラデーション境界の位置や色情報を格納したオブジェクトD2GradientStopsの生成)
  D2Canvas.RenderTarget.CreateGradientStopCollection(
                         @D2arrGradientStop[0],
                         Length(D2arrGradientStop),
                         D2D1_GAMMA_2_2,
                         D2D1_EXTEND_MODE_CLAMP,
                         D2GradientStops);


  //上で設定したコレクションを使用して放射状グラデーションブラシを作成
  //まず，グラデーション楕円の中心位置
  D2RGBProper.center := D2D1PointF(ClientWidth / 2, ClientHeight / 2);
  //グラデーションの原点(中心から)のオフセット
  D2RGBProper.gradientOriginOffset := D2D1PointF(0, 0);
  //グラデーション楕円のサイズ(楕円の半径)
  D2RGBProper.radiusX := (DrawRect.Right  - DrawRect.Left) / 2;
  D2RGBProper.radiusY := (DrawRect.Bottom - DrawRect.Top)  / 2;

  //楕円領域内の放射状ブラシD2GradBrushを生成
  D2Canvas.RenderTarget.CreateRadialGradientBrush(D2RGBProper,
                                                  nil,
                                                  D2GradientStops,
                                                  D2GradBrush);
  //生成したブラシをこのCanvasのブラシとする
  D2Canvas.Brush.Handle := D2GradBrush;

  //現在のブラシで楕円内を塗り潰す
  D2Canvas.Pen.Width := 0;
  D2Canvas.BeginDraw;
  D2Canvas.Ellipse(DrawRect);
  D2Canvas.EndDraw;

  D2Canvas.Free;
end;

//=============================================================================
//  OnResizeイベント
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.


コード中の数値をいろいろ変更すると，グラデーション効果の結果が変わります．
例えば，以下の図はグラデーションの開始座標のオフセットを変更した例です．


図11
グラデーション開始位置を変更 

  //グラデーションの原点(中心から)のオフセット
  D2RGBProper.gradientOriginOffset := D2D1PointF(50, 0);



05_画像ブラシの放射状グラデーション


上のサンプルでは，ブラシは単色でした．
MSDN のブラシの種類の記事にあるように，ID2D1BitmapBrush インターフェイスを使用して，画像もブラシとして使用できます．画像をブラシにして，グラデーション効果の処理をすると，また違う印象の画像となります．

本サンプルでは，上のサンプルと同じように，放射状のグラデーションにして，ちょっとメルヘンチックな画像にしてみます．見た目では，周辺に「ぼかし」が入ったような画像となります．処理の方式は少し違いますが，[R230] [10_画像の放射状グラデーション表示] の Direct2D 版です．

画像から ID2D1Bitmap のインターフェイスのビットマップを生成しますが，MSDN の [ファイルからビットマップを読み込む方法] の記事のような面倒なことをしなくても，Delphi の TWICImageを使用すれば，ID2D1Bitmap のインスタンスを作成できます．


図12
設計時画面
図13
添付の画像ファイルを表示
  • グラデーションの始点 (アルファ値が 0) の位置は，画像の中央
図14
グラデーション始点変更
  • グラデーションの開始と終点位置の値は 0.0 から 1.0 の相対値

リスト5
画像ブラシの放射状グラデーション 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Direct2D, D2D1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    FileOpenDialog1: TFileOpenDialog;
    TrackBar1: TTrackBar;
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private 宣言 }
    FileFullPath  : String;
    DefaultFolder : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  OnCreateイベント
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;

  with TrackBar1 do begin
    ShowSelRange := False;
    TickStyle    := tsNone;
    Min          := 0;
    Max          := 100;
    Position     := 0;
  end;
end;

//=============================================================================
//  [Button1]クリックイベント
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  with FileOpenDialog1.FileTypes.Add do begin
    DisplayName := '画像ファイル';
    FileMask := '*.bmp;*.jpg;*.gif;*.png';
  end;

  if DefaultFolder = '' then begin
    FileOpenDialog1.DefaultFolder := ExtractFilePath(Application.ExeName);
  end else begin
    FileOpenDialog1.DefaultFolder := DefaultFolder;
  end;

  if FileOpenDialog1.Execute then begin
    FileFullPath  := FileOpenDialog1.FileName;
    DefaultFolder := ExtractFilePath(FileFullPath);
    Invalidate;
  end;
end;

//=============================================================================
//  TrackBar1のOnChangeイベント
//=============================================================================
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Invalidate;
end;

//=============================================================================
//  OnPaintイベント
//  画像ブラシの放射状グラデーション
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  WIC                 : TWICImage;
  ABitmap             : TBitmap;
  D2Canvas            : TDirect2DCanvas;
  D2BitmapPic         : ID2D1Bitmap;
  D2BitmapBrush       : ID2D1BitmapBrush;
  D2RectF             : TD2DRectF;
  D2SizeF             : TD2DSizeF;
  D2RadialGradBrush   : ID2D1RadialGradientBrush;
  D2arrGradientStop   : array[0..1] of TD2D1GradientStop;
  D2GradientStops     : ID2D1GradientStopCollection;
  D2RGBProper         : TD2D1RadialGradientBrushProperties;
  D2RectangleGeometry : ID2D1RectangleGeometry;
begin
　if not TDirect2DCanvas.Supported then exit;
  if FileFullPath = '' then exit;

  //Direct2DのCanvasを生成
  D2Canvas := TDirect2DCanvas.Create(Canvas, ClientRect);

  //TBitmapからDirect2Dのビットマップ(D2BitmapPic)を作成
  //いろいろな画像を読み込めるのでTWICImageを使用
  ABitmap := TBitmap.Create;
  WIC     := TWICImage.Create;
  try
    WIC.LoadFromFile(FileFullPath);
    ABitmap.Assign(WIC);

    D2BitmapPic := D2Canvas.CreateBitmap(ABitmap);
  finally
    WIC.Free;
    ABitmap.Free;
  end;


  //ビットマップからブラシ(D2BitmapBrush)を作成
  D2Canvas.RenderTarget.CreateBitmapBrush(D2BitmapPic, nil, nil, D2BitmapBrush);

  //画像のサイズを取得してその画像の描画範囲を設定
  D2BitmapPic.GetSize(D2SizeF);
  D2RectF := D2D1RectF(0, 0, D2SizeF.width, D2SizeF.height);


  //グラデーションブラシ境界の相対位置を示す値
  D2arrGradientStop[0].position := TrackBar1.Position / 100.0;
  D2arrGradientStop[1].position := 1.0;

  //グラデーション境界の色(開始色と終値色)と透過度の設定
  D2arrGradientStop[0].color := D2D1ColorF(clWhite, 1.0);
  D2arrGradientStop[1].color := D2D1ColorF(clWhite, 0.0);

  //上の値からID2D1GradientStopCollection オブジェクトの作成
  //グラデーション境界の位置や色情報を格納したオブジェクトD2GradientStopsを生成)
  D2Canvas.RenderTarget.CreateGradientStopCollection(@D2arrGradientStop[0],
                                                     Length(D2arrGradientStop),
                                                     D2D1_GAMMA_2_2,
                                                     D2D1_EXTEND_MODE_CLAMP,
                                                     D2GradientStops);


  //上で設定したコレクションを使用して放射状グラデーションブラシを作成
  //まず，グラデーション楕円の中心位置
  D2RGBProper.center := D2D1PointF(D2RectF.right / 2, D2RectF.bottom / 2);
  //グラデーションの原点(中心から)のオフセット
  D2RGBProper.gradientOriginOffset := D2D1PointF(0, 0);

  //グラデーション楕円のサイズ(楕円の半径)
  D2RGBProper.radiusX := (D2RectF.Right  - D2RectF.Left) / 2.0;
  D2RGBProper.radiusY := (D2RectF.Bottom - D2RectF.Top)  / 2.0;

  //楕円領域内の放射状ブラシD2GradBrushを生成
  D2Canvas.RenderTarget.CreateRadialGradientBrush(D2RGBProper,
                                                  nil,
                                                  D2GradientStops,
                                                  D2RadialGradBrush);

  D2Canvas.BeginDraw;
  //背景を白で塗り潰す
  D2Canvas.RenderTarget.Clear(D2D1ColorF(clWhite));
  //画像の描画中心位置を指定
  D2Canvas.RenderTarget.SetTransform(
            TD2DMatrix3x2F.Translation((ClientWidth  - D2SizeF.width) /  2,
                                       (ClientHeight - D2SizeF.height) / 2 + 15));
  //アンチエイリアス処理が必要なら以下を追加
  //D2Canvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE);

  //描画領域のジオメトリ(四角形)を取得
  D2DFactory.CreateRectangleGeometry(D2RectF, D2RectangleGeometry);
  //指定されたジオメトリの内部を描画
  //ただし，放射状グラデーションは楕円なので楕円の領域内となる
  D2Canvas.RenderTarget.FillGeometry(D2RectangleGeometry,
                                     D2BitmapBrush,
                                     D2RadialGradBrush);

  D2Canvas.EndDraw;
  D2Canvas.Free;
end;

//=============================================================================
//  OnResizeイベント
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.