|
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 は 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 を描いて,線の太さと色を変えている
|
最初の線は,実線の両端をフラットにして描画します.Direct2D のデフォルトはこのフラットです.
太い点線,一転鎖線等も描画できます.一番下は始点と終点を丸にしています. |
|
図4
実行結果 |
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.
Direct2D では,少なくとも線を描画する時は,デフォルトでアンチエイリアス処理をしてくれるようです.そのテストです.もう少し太い線でテストした方が効果を確認しやすいかも知れません. |
|
図5
設計時画面
- TPaintBox を 2 つ配置.ここに直線を描画する
|
|
図6
実行画面 |
実行結果の直線を拡大した図です.アンチエイリアスの効果があることが確認できます. |
|
図7
描画した直線を拡大した図
- 左が Direct2D で描画した直線
アンチエイリアス処理が行われている
- 右は通常の TCanvas に描画した直線
|
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.
JPEG 画像ファイルをディスクから読み出して表示する簡単なサンプルです.画像の加工や処理は一切ありません.StretchDraw 関数の引数に,透明度を指定する引数があるので,テストしてみました.
画像を扱うのに,Delphi 2010 から実装された TWICImage を使用しています. |
[備考]
Windows API の AlphaBlend 関数を使用すると,Delphi 2009 よりも前の Delphi でも画像を半透明で表示できます. |
|
図8
設計時画面 |
|
図9
実行して Button1 をクリック
|
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.
放射状のグラデーションのサンプルです.
ID2D1RadialGradientBrush インターフェイスを使用しています. |
|
図10
実行画面 |
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);
上のサンプルでは,ブラシは単色でした.
MSDN のブラシの種類の記事にあるように,ID2D1BitmapBrush インターフェイスを使用して,画像もブラシとして使用できます.画像をブラシにして,グラデーション効果の処理をすると,また違う印象の画像となります.
本サンプルでは,上のサンプルと同じように,放射状のグラデーションにして,ちょっとメルヘンチックな画像にしてみます.見た目では,周辺に「ぼかし」が入ったような画像となります.処理の方式は少し違いますが,[R230] [10_画像の放射状グラデーション表示] の Direct2D 版です.
画像から ID2D1Bitmap のインターフェイスのビットマップを生成しますが,MSDN の [ファイルからビットマップを読み込む方法] の記事のような面倒なことをしなくても,Delphi の TWICImageを使用すれば,ID2D1Bitmap のインスタンスを作成できます. |
|
図12
設計時画面 |
|
図13
添付の画像ファイルを表示
- グラデーションの始点 (アルファ値が 0) の位置は,画像の中央
|
|
図14
グラデーション始点変更
- グラデーションの開始と終点位置の値は 0.0 から 1.0 の相対値
|
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.
|