AFsoft WebSite(エーエフソフト・ウェブサイト)
 

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

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

今回ももう少し、Direct2Dについて見ていきます。
前回までは、ペン(Pen)および線の描画 DrawLineメソッドについて見ました。DrawLineメソッドの引数は、2つのD2D1PointF型で、D2D1PointF型は Single型の X値・Y値を持ちます。但し、MoveTo/LineToと比較して効果のほどは?というと若干微妙です。
 
線の描画の次に、長方形(矩形)の描画 DrawRectangleメソッドについて見てみます。このメソッドの引数は、1つのD2D_RECT_F型となっており、D2D_RECT_F型は Single型の Left値・Top値・Right値・Bottom値を持ちます。この DrawRectangleメソッドには内部を塗り潰す機能はありません。ボタン1つ Button5 を追加し、それをクリックしたら長方形を描くテストを行ってみます。速度比較のため、GDIでも同じように描画させてみます。

procedure TForm1.Button5Click(Sender: TObject);
var
 t : TDateTime ;
 mes : string ;
 i,j : integer ;
 r : D2D_RECT_F ;
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)) ;
    Rectangle(Rect(i,i,200-i,200-i));
   end;
  end;
 end;
 mes := 'Rectangle:' + 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.left := i ;
    r.top := i ;
    r.right := 200 - i ;
    r.bottom := 200 - i ;
    DrawRectangle(r);
   end;
  end;
  EndDraw;
 end;
 mes := mes + ' DrawRectangle:' + TimeToStr(Now - t) ;
 
 StatusBar1.SimpleText := mes ;
end;
これを保存・コンパイル(再構築)・実行してみます。

これは明らかにGDIのRectangleメソッドよりも高速のようです。まぁGDIの場合には描画途中経過が目に見えますがDirect2Dの場合は見えませんのでその違いはあるとは思われますが。それでは、線幅を「3」にしてみます。

GDIの場合は遅くなりますが、Direct2Dの場合は然程速度は変わりません。次に線幅を「1」に、線種を破線(psDash)にしてみます。あまりにも遅いので1000回繰り返しを10回繰り返しに、つまり、1/100にします。



1/100にしても Direct2Dでは13秒も掛かってしまっています。実線の描画速度と比較すると単純計算で 1300倍遅い、という事になりますが、ペイントソフトならともかくCADソフトでは、これは流石に使えないかなという感じです。次に線幅を「3」に、線種を破線(psDashDot)にしてみます。繰り返し回数は1/100のままです。

GDIの場合、線幅が1より大きい場合には破線は描画出来ません。Direct2Dでは、線の描画同様、線種指定時は、線幅「1」よりも線幅「3」のほうが速いようです。しかし実線の描画速度と比較すると単純計算で 300倍ほど遅い、という事になりますがこれもやはりCADソフト的には無理がありそうです。
 
 
次に、塗り潰し長方形(矩形)の描画 FillRectangleメソッドについて見てみます。このメソッドの引数は、DrawRectangleメソッド同様、1つのD2D_RECT_F型となっており、D2D_RECT_F型は Single型の Left値・Top値・Right値・Bottom値を持ちます。ボタン1つ Button6 を追加し、それをクリックしたら塗り潰し長方形を描くテストを行ってみます。速度比較のため、GDIでも同じように描画させてみます。

procedure TForm1.Button6Click(Sender: TObject);
var
 t : TDateTime ;
 mes : string ;
 i,j : integer ;
 r : D2D_RECT_F ;
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)) ;
    Rectangle(Rect(i,i,200-i,200-i));
   end;
  end;
 end;
 mes := 'Rectangle:' + 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)) ;
    r.left := i ;
    r.top := i ;
    r.right := 200 - i ;
    r.bottom := 200 - i ;
    FillRectangle(r);
   end;
  end;
  EndDraw;
 end;
 mes := mes + ' DrawRectangle:' + TimeToStr(Now - t) ;
 
 StatusBar1.SimpleText := mes ;
end;
これを保存・コンパイル(再構築)・実行してみます。

ペンの線種が実線(psSolid)であれば速度的には良いのではないかと思います。それは良いのですが、上記の「EndDraw;」の直前に
  ・・・
  Pen.Style := psSolid ;
  Pen.Width := 1 ;
  Pen.Color := clRed ;
  Brush.Color := clBlue ;
  Brush.Style := bsSolid ;
  r.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(r);
  
  EndDraw;
 end;
 mes := mes + ' DrawRectangle:' + TimeToStr(Now - t) ;
 
 StatusBar1.SimpleText := mes ;
end;
のようにして実行しても

となり、ペン(Pen)での輪郭線が描画されません。ペンとブラシの順番を入れ替えても同じ、ブラシを「Brush.Handle := CreateBrush(clBlue);」のように置き換えても同じです。ヘルプには
FillRectangleを使用すると、Penで矩形を描画し、それをBrushで塗りつぶせます。
と記載されていますが、その「Penで矩形を描画し」の部分が全く無効化されている感じです。ですので、ペン(Pen)の線幅や線種を変えても、見た感じでの速度的な変化はないようです。
まぁ、プログラムでそのようにしたい場合には、FillRectangleメソッドを実行したあとにDrawRectangleメソッドを実行すれば良いだけですので別段どうという事はないのですが、これがDelphiの不具合なのか、マシン/VGAカードのハード的問題なのかソフト的問題なのか、ヘルプ記述ミスなのか、それとも、プログラミングの手順としておかしなことをやってしまったのか、等等、何なのかがイマイチ良く分かりません。
 
 
と、それは置いといて、次に、上記追加した箇所を CreateBrushを使うように変更してみます。速度比較はもういいので上の部分の繰り返し部を「2000」から「100」にしておきます。実行時間が勿体無いですので。
  ・・・
  (※Pen〜の部分は意味がないので削除)
  // Brush.Color := clBlue ;
  // Brush.Style := bsSolid ;
  Brush.Handle := CreateBrush(clAqua);
  r.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(r);
  
  EndDraw;
 end;
 ・・・
のようにして実行しても正常に塗り潰し長方形が作図されるのが分かります。

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

となります。
 
次に、線形グラデーションのブラシを作成してみます。
  ・・・
  // Brush.Handle := CreateBrush(clAqua);
  // Brush.Handle.SetOpacity(0.5);
  Brush.Handle := CreateBrush([clRed,clBlue]
           ,D2D1PointF(0,0), D2D1PointF(200,200));
  r.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(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.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(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.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(r);
  
  EndDraw;
 end;
 ・・・
保存・コンパイル(再構築)・実行を行います。

 
  ・・・
  bm := TBitmap.Create ;
  bm.LoadFromFile(ExtractFilePath(Application.ExeName)+'brush1.bmp');
  Brush.Handle := CreateBrush(bm);
  bm.Free ;
  Brush.Handle.SetOpacity(0.5);
  r.left := 50 ;
  r.top := 30 ;
  r.right := 240 ;
  r.bottom := 130 ;
  FillRectangle(r);
  
  EndDraw;
 end;
 ・・・
のように半透明にすることも出来ます。これはグラデーションの場合も同じです。

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