AFsoft WebSite（エーエフソフト・ウェブサイト）
　

オペレーティング・システムについて

プログラミングについて
ホームページについて
キャドについて
電子カタログについて
書籍・雑誌
イベント
リンク集
Delphi2010　Direct2D(6)　2010/12/12

今回ももう少し、Direct2Dについて見ていきます。
前回は、長方形（矩形）の描画 DrawRectangleメソッド、および、塗り潰し長方形の描画 FillRectangleメソッドについて見ましたので、今回はまず、角の丸い長方形（矩形）の描画 DrawRoundedRectangleメソッドについて見てみます。恒例によりボタン１つ Button7 を追加し、それをクリックしたら描画テストを行うようにします。

　
長方形（矩形）の描画 DrawRectangleメソッド　および
塗り潰し長方形の描画 FillRectangleメソッド　での引数は
D2D_RECT_F型は Single型の Left値・Top値・Right値・Bottom値を持ちますが、この角の丸い長方形の描画 DrawRoundedRectangleメソッドでは、D2D1_ROUNDED_RECT型の引数を持ち、これは、D2D_RECT_F型のrect値、Single型の radiusX・radiusY値を持ちます。radiusX値・radiusY値は言うまでもなく、角の楕円弧の半径を意味します。まずは簡単なテストから。
procedure TForm1.Button7Click(Sender: TObject);
var
　r : D2D1_ROUNDED_RECT ;
begin
　if not(D2DCanvasFlag) then exit;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Color := clLime ;
　　Pen.Style := psSolid ;
　　Pen.Width := 1 ;
　　Brush.Color := clYellow ;
　　Brush.Style := bsSolid ;
　
　　r.rect.left := 40 ;
　　r.rect.top := 30 ;
　　r.rect.right := 200 ;
　　r.rect.bottom := 160 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　DrawRoundedRectangle(r);
　　
　　EndDraw;
　end;
end;
保存・コンパイル（再構築）・実行を行います。以下のようになります。

　
想定通り、という所でしょうか。ブラシの設定をしていますが無視されます。
　
それでは長方形の描画同様、速度チェックをしてみます。
procedure TForm1.Button7Click(Sender: TObject);
var
　t : TDateTime ;
　mes : string ;
　i,j : integer ;
　r : D2D1_ROUNDED_RECT ;
begin
　t := Now ;
　with PaintBox1.Canvas do begin
　　Pen.Style := psSolid ;
　　Pen.Width := 1 ;
　　Brush.Style := bsClear ;
　　for j:=1 to 1000 do begin
　　　for i:=0 to 200 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　RoundRect(i,i,200-i,200-i,10,5);
　　　end;
　　end;
　end;
　mes := 'GDI:' + TimeToStr(Now - t) ;
　
　if not(D2DCanvasFlag) then exit;
　t := Now ;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Style := psSolid ;
　　Pen.Width := 1 ;
　　Brush.Style := bsClear ;
　　for j:=1 to 1000 do begin
　　　for i:=0 to 200 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　RoundRect(i,i,200-i,200-i,10,5);
　　　end;
　　end;
　　EndDraw;
　end;
　mes := mes + ' BI:' + TimeToStr(Now - t) ;
　
　if not(D2DCanvasFlag) then exit;
　t := Now ;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Style := psSolid ;
　　Pen.Width := 1 ;
　　for j:=1 to 1000 do begin
　　　for i:=0 to 200 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　r.rect.left := i ;
　　　　r.rect.top := i ;
　　　　r.rect.right := 200 - i ;
　　　　r.rect.bottom := 200 - i ;
　　　　r.radiusX := 10 ;
　　　　r.radiusY := 5 ;
　　　　DrawRoundedRectangle(r);
　　　end;
　　end;
　　EndDraw;
　end;
　mes := mes + ' Direct2D:' + TimeToStr(Now - t) ;
　
　StatusBar1.SimpleText := mes ;
end;
間に Direct2DCanvasに GDIと同じコマンド名での実行テストも入れておきます。保存・コンパイル（再構築）・実行を行います。

GDI描画に比べて4倍程遅い感じです。それでは、線幅を「3」にしてみます。

これまで同様、GDIの場合はやはり遅くなりますが、Direct2Dの場合はやや速くなる感じです。次に線幅を「1」に、線種を破線（psDash）にしてみます。あまりにも遅いので1000回繰り返しを10回繰り返しに、つまり、1/100にします。

↓

↓

1/100にしても Direct2Dでは15秒も掛かってしまっています。次に線幅を「3」に、線種を破線（psDashDot）にしてみます。繰り返し回数は1/100のままです。GDIでは線幅指定時の線種指定は無効化され実線描画となります。

これまで同様、Direct2Dでは、線・長方形の描画同様、線種指定時は、線幅「1」よりも線幅「3」のほうが速いようです。
　
　
次に、塗り潰しの角の丸い長方形（矩形）の描画 FillRoundedRectangleメソッドについて見てみます。このメソッドの引数は、DrawRoundedRectangleメソッド同様、１つのD2D1_ROUNDED_RECT型の引数を持ち、これは、D2D_RECT_F型のrect値、Single型の radiusX・radiusY値を持ちます。radiusX値・radiusY値は言うまでもなく、角の楕円弧の半径を意味します。ボタン１つ Button8 を追加し、それをクリックしたら塗り潰しの角の丸い長方形を描くテストを行ってみます。まずは簡単なテストから。
procedure TForm1.Button8Click(Sender: TObject);
var
　r : D2D1_ROUNDED_RECT ;
begin
　if not(D2DCanvasFlag) then exit;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Color := clLime ;
　　Pen.Style := psSolid ;
　　Pen.Width := 1 ;
　　Brush.Color := clYellow ;
　　Brush.Style := bsSolid ;
　
　　r.rect.left := 40 ;
　　r.rect.top := 30 ;
　　r.rect.right := 200 ;
　　r.rect.bottom := 160 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
end;
保存・コンパイル（再構築）・実行を行います。以下のようになります。

こちらも FillRectangleメソッドと同様、ペン(Pen)での輪郭線が描画されません。ペンとブラシの順番を入れ替えても同じ、ブラシを「Brush.Handle := CreateBrush(clBlue);」のように置き換えても同じです。ヘルプには
FillRoundedRectangle を使用すると、Pen で矩形を描画し、それを Brush で塗りつぶせます。
と記載されていますが、その「Penで矩形を描画し」の部分が全く無効化されている感じです。ですので、ペン(Pen)の線幅や線種を変えても、見た感じでの速度的な変化はないようです。
　
それでは上記同様、速度チェックをしてみます。
procedure TForm1.Button8Click(Sender: TObject);
var
　t : TDateTime ;
　mes : string ;
　i,j : integer ;
　r : D2D1_ROUNDED_RECT ;
begin
　t := Now ;
　with PaintBox1.Canvas do begin
　　Pen.Style := psSolid;
　　Pen.Width := 1 ;
　　Brush.Style := bsSolid ;
　　for j:=1 to 2000 do begin
　　　for i:=0 to 100 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　Brush.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　RoundRect(i,i,200-i,200-i,10,5);
　　　end;
　　end;
　end;
　mes := 'GDI:' + TimeToStr(Now - t) ;
　
　if not(D2DCanvasFlag) then exit;
　t := Now ;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Style := psSolid;
　　Pen.Width := 1 ;
　　Brush.Style := bsSolid ;
　　for j:=1 to 2000 do begin
　　　for i:=0 to 100 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　Brush.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　RoundRect(i,i,200-i,200-i,10,5);
　　　end;
　　end;
　　EndDraw;
　end;
　mes := mes + ' BI:' + TimeToStr(Now - t) ;
　
　t := Now ;
　with D2DCanvas do begin
　　BeginDraw;
　　Pen.Style := psSolid;
　　Pen.Width := 1 ;
　　for j:=1 to 2000 do begin
　　　for i:=0 to 100 do begin
　　　　Pen.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　Brush.Color := RGB(Random(256),Random(256),Random(256)) ;
　　　　r.rect.left := i ;
　　　　r.rect.top := i ;
　　　　r.rect.right := 200 - i ;
　　　　r.rect.bottom := 200 - i ;
　　　　r.radiusX := 10 ;
　　　　r.radiusY := 5 ;
　　　　FillRoundedRectangle(r);
　　　end;
　　end;
　　EndDraw;
　end;
　mes := mes + ' Direct2D:' + TimeToStr(Now - t) ;
　
　StatusBar1.SimpleText := mes ;
end;
保存・コンパイル（再構築）・実行を行います。

　
次に、上記追加した箇所を CreateBrushを使うように変更してみます。速度比較はもういいので上の部分の繰り返し部を「2000」から「10」にしておきます。実行時間が勿体無いですので。
　　・・・
　　Brush.Handle := CreateBrush(clAqua);
　　r.rect.left := 50 ;
　　r.rect.top := 30 ;
　　r.rect.right := 220 ;
　　r.rect.bottom := 130 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
　・・・
のようにして実行しても正常に塗り潰しが描画されるのが分かります。

　
次に、半透明のブラシを作って描画してみます。ブラシの色はそのままとします。
　　・・・
　　Brush.Handle := CreateBrush(clAqua);
　　Brush.Handle.SetOpacity(0.5);
　　r.rect.left := 50 ;
　　r.rect.top := 30 ;
　　r.rect.right := 220 ;
　　r.rect.bottom := 130 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
　・・・
というようにして実行してみます。すると・・・

となります。
　
次に、線形グラデーションのブラシを作成してみます。
　　・・・
　　// Brush.Handle := CreateBrush(clAqua);
　　// Brush.Handle.SetOpacity(0.5);
　　Brush.Handle := CreateBrush([clRed,clBlue]
　　　　　　　　　　　,D2D1PointF(0,0), D2D1PointF(200,200));
　　r.rect.left := 50 ;
　　r.rect.top := 30 ;
　　r.rect.right := 220 ;
　　r.rect.bottom := 130 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
　・・・
というようにして実行してみます。すると・・・

という具合になります。半透明にすると以下のような感じ。

　
次に円形グラデーションのブラシを作成してみます。
　　・・・
　　// Brush.Handle := CreateBrush(clAqua);
　　// Brush.Handle.SetOpacity(0.5);
　　// Brush.Handle := CreateBrush([clRed,clBlue]
　　//　　　　　　　　　,D2D1PointF(0,0), D2D1PointF(200,200));
　　Brush.Handle := CreateBrush([clAqua,clBlue]
　　　　　　　,D2D1PointF(100,100),D2D1PointF(0,0),100,100);
　　r.rect.left := 50 ;
　　r.rect.top := 30 ;
　　r.rect.right := 220 ;
　　r.rect.bottom := 130 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
　・・・
保存・コンパイル（再構築）・実行を行います。

という具合になります。半透明にすると以下のような感じ。

　
次に、前回作成した画像ファイル「brush1.bmp」を指定したブラシを作成してみます。
var
　・・・
　bm : TBitmap ;
begin
　　// Brush.Handle := CreateBrush(clAqua);
　　// Brush.Handle.SetOpacity(0.5);
　　// Brush.Handle := CreateBrush([clRed,clBlue]
　　//　　　　　　　　　,D2D1PointF(0,0), D2D1PointF(200,200));
　　// Brush.Handle := CreateBrush([clAqua,clBlue]
　　//　　　　　,D2D1PointF(100,100),D2D1PointF(0,0),100,100);
　　bm := TBitmap.Create ;
　　bm.LoadFromFile(ExtractFilePath(Application.ExeName)+'brush1.bmp');
　　Brush.Handle := CreateBrush(bm);
　　bm.Free ;
　　r.rect.left := 50 ;
　　r.rect.top := 30 ;
　　r.rect.right := 220 ;
　　r.rect.bottom := 130 ;
　　r.radiusX := 20 ;
　　r.radiusY := 10 ;
　　FillRoundedRectangle(r);
　　
　　EndDraw;
　end;
　・・・
保存・コンパイル（再構築）・実行を行います。

という具合になります。半透明にすると以下のような感じ。

　
バッチファイル
ＢＡＳＩＣ
C言語のお勉強
拡張子な話
DOSプログラム
Delphi
>Delphi入門編
>Delphi2010
▲2010/12/11
　2010/12/12
▼2010/12/13
　
シェアウェア
Script!World
データベース
　
お問い合わせ
本サイトはリンクフリーです
リンクバナー
(C)Copyright 1999-2015. By AFsoft All Rights Reserved.