Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年12月14日] [更新 2012年12月14日]　GDI+ 関係サンプル
GDI+ 関係サンプル　
G110_Warp 関数による描画領域の設定
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
G110_GDIPlus_Warp [1,735 KB]　2012年12月14日版 (EXE 同梱)






01_Warp 関数による描画領域の設定


TGPGraphicsPath の Warp 関数を使用した描画サンプルです．
Warp 関数は，TGPGraphicsPath にしかありません．パス専用の描画領域の設定関数です．描画の領域は，3 点または 4 点の座標値を，実数型の配列 TGPPointF に格納して使用します．
関数の定義と，引数の意味は表のようになっています． 

    function Warp(destPoints: PGPPointF; count: Integer; srcRect: TGPRectF;
      matrix: TGPMatrix = nil; warpMode: TWarpMode = WarpModePerspective;
      flatness: Single = FlatnessDefault): TStatus;

destPoints 3 点または 4 点の実数値配列へのポインター
3 点の場合は，平行四辺形．4 点の場合は，変形した四角形内に描画される
各座標値の位置は，以下のように，配列の要素番号に対して決められている
これを間違うと正常に描画されない

4 点の場合
destPoints[0] 左上の座標値
destPoints[1] 右上の座標値
destPoints[2] 左下の座標値
destPoints[3] 右下の座標値

3 点の場合
destPoints[0] 左上の座標値
destPoints[1] 右上の座標値
destPoints[3] 左下の座標値
count 使用する座標値の数．3 または 4
srcRect destPoints 内に描画する領域の指定
この範囲が destPoints で設定した範囲に変形されて描画される
matrix 座標値変換を追加する場合の TGPMatrix
warpMode 詳細不明．動作未確認．flatness と関係するようである
flatness 詳細不明．動作未確認．スプライン関数の平滑化係数のようなものかも知れない


4 点の配列要素を使用した描画例です．小さな黒い丸印が座標値です．


図1
設計時画面
図2
実行画面

リスト1
4 点を指定した描画領域の設定 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, GDIPOBJ, GDIPAPI, ComCtrls;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'GDI+ Warp  4 点指定による描画領域の設定';
end;

//=============================================================================
//  OnPaintイベント
//  実際の描画コード
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LPointsF        : array[0..3] of TGPPointF;
  LGPGraphic      : TGPGraphics;
  LGPBrush        : TGPHatchBrush;
  LGPPath         : TGPGraphicsPath;
  LGPRectF        : TGPRectF;
  LGPFontFamily   : TGPFontFamily;
  LGPStringFormat : TGPStringFormat;
  LGPPen          : TGPPen;
begin
  //描画領域の点．以下の順で指定する
  //左上
  //右上
  //左下
  //右下
  LPointsF[0] := MakePoint(40.0,   30.0);
  LPointsF[1] := MakePoint(230.0,  20.0);
  LPointsF[2] := MakePoint(30.0,  120.0);
  LPointsF[3] := MakePoint(280.0, 190.0);

  //描画元の矩形領域
  LGPRectF := MakeRect(40.0, 20.0, 240.0, 150.0);

  //文字の書式等を設定
  LGPFontFamily   := TGPFontFamily.Create('Arial Black');
  LGPStringFormat := TGPStringFormat.Create;
  LGPStringFormat.SetAlignment(StringAlignmentCenter);
  LGPStringFormat.SetLineAlignment(StringAlignmentCenter);

  //このCanvasを描画先にしてTGPGraphicsを生成
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //ブラシを設定
  LGPBrush := TGPHatchBrush.Create(HatchStyle50Percent,
                                   aclWhite,
                                   ColorRefToARGB($008C5F00));

  //パスを生成して文字列を追加
  LGPPath := TGPGraphicsPath.Create;
  LGPPath.AddRectangle(LGPRectF);
  LGPPath.AddString('Delphi',
                    -1,
                    LGPFontFamily,
                    FontStyleRegular,
                    56,
                    LGPRectF,
                    LGPStringFormat);

  //Warp関数で描画の領域を指定してパス情報を更新
  LGPPath.Warp(PGPPointF(@LPointsF), Length(LPointsF), LGPRectF);
  LGPGraphic.FillPath(LGPBrush, LGPPath);

  //以下，描画の座標値に丸を描くためのコード
  LGPPen := TGPPen.Create(aclBlack, 3);

  LGPGraphic.DrawEllipse(LGPPen, LPointsF[0].X - 3, LPointsF[0].Y - 3, 6, 6);
  LGPGraphic.DrawEllipse(LGPPen, LPointsF[1].X - 3, LPointsF[1].Y - 3, 6, 6);
  LGPGraphic.DrawEllipse(LGPPen, LPointsF[2].X - 3, LPointsF[2].Y - 3, 6, 6);
  LGPGraphic.DrawEllipse(LGPPen, LPointsF[3].X - 3, LPointsF[3].Y - 3, 6, 6);

  //Createしたオブジェクトは解放
  LGPGraphic.Free;
  LGPBrush.Free;
  LGPPath.Free;
  LGPFontFamily.Free;
  LGPStringFormat.Free;
  LGPPen.Free;
end;

end.



02_台形の描画領域


描画領域を台形にしたサンプルです．


図3
設計時画面
図4
実行画面

リスト2
台形の描画領域 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GDIPAPI, GDIPOBJ;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+ Warp  台形の描画領域';
  DoubleBuffered := True;
end;

//=============================================================================
//  OnPaintイベント
//  実際の描画コード
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  LPointArray   : array[0..3] of TGPPointF;
  LStrText      : String;
  LFontSize     : Single;
  LGPPath       : TGPGraphicsPath;
  LGPFontFamily : TGPFontFamily;
  LGPStrFormat  : TGPStringFormat;
  LGPRectF      : TGPRectF;
  LDstRight     : Single;
  LDstWidht     : Single;
  LGPGraphic    : TGPGraphics;
  LGPBrush      : TGPSolidBrush;
begin
  LStrText := 'DELPHI';
  LFontSize := 70;

  //文字の書式等を設定
  LGPFontFamily := TGPFontFamily.Create('Arial Black');
  LGPStrFormat := TGPStringFormat.Create;
  LGPStrFormat.SetAlignment(StringAlignmentCenter);
  LGPStrFormat.SetLineAlignment(StringAlignmentCenter);

  //描画元の矩形領域
  LGPRectF := MakeRect(0, 50, ClientWidth, 50 + LFontSize);
  //パスを生成して文字列を追加
  LGPPath := TGPGraphicsPath.Create;
  LGPPath.AddString(LStrText,
                    -1,
                    LGPFontFamily,
                    FontStyleBold,
                    LFontSize,
                    LGPRectF,
                    LGPStrFormat);

  //台形とするために，上辺の長さを少し少なくする
  LDstWidht  := LGPRectF.Width * 0.6;
  LDstRight  := LGPRectF.X + LGPRectF.Width;

  //台形の座標値を配列に格納
  LPointArray[0] := MakePoint(LGPRectF.X  + (LGPRectF.Width - LDstWidht) / 2, LGPRectF.Y);
  LPointArray[1] := MakePoint(LDstRight - (LGPRectF.Width - LDstWidht) / 2, LGPRectF.Y);
  LPointArray[2] := MakePoint(LGPRectF.X,  LGPRectF.Y + LGPRectF.Height);
  LPointArray[3] := MakePoint(LDstRight, LGPRectF.Y + LGPRectF.Height);

  //Warp関数で描画の領域を指定してパス情報を更新
  LGPPath.Warp(PGPPointF(@LPointArray), Length(LPointArray), LGPRectF);

  //このCanvasを描画先にしてTGPGraphicsを生成
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);

  //ブラシを設定
  LGPBrush := TGPSolidBrush.Create(aclBlack);
  //Canvasを塗りつぶして...
  LGPGraphic.FillRectangle(LGPBrush, MakeRect(ClientRect));
  //アンチエイリアスを指定してパス(文字列)を描画
  LGPGraphic.SetSmoothingMode(SmoothingModeAntiAlias);
  LGPBrush.SetColor(aclYellow);
  LGPGraphic.FillPath(LGPBrush, LGPPath);

  //Createしたオブジェクトは解放
  LGPPath.Free;
  LGPFontFamily.Free;
  LGPStrFormat.Free;
  LGPGraphic.Free;
  LGPBrush.Free;
end;

//=============================================================================
//  OnResizeイベント
//  リサイズした時に，再描画されないことがあるので追加
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.



03_描画領域をマウスで設定


座標値の設定をマウスで行うようにしたサンプルです．


図5
設計時画面
図6
実行開始画面
図7
操作例

マウスで操作すると，かなり自由な描画領域を設定できますが，下図のように，内角が 180 度を越えると描画が乱れてしまいます．
移動リサイズ用のコントロールに組み込むには，この問題を考慮する必要があります．


図8
点の内角が 180 度を越えた場合

リスト3
描画領域をマウスで設定 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, GDIPOBJ, GDIPAPI;

type
  TMyPanel = class(TPanel)

  private
    FPtsF     : array[0..3] of TGPPointF;
    FPointsNo : Integer;
    FSrcPath  : TGPGraphicsPath;
    FGrabSize : Integer;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetWarp;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Types;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := 'GDI+ Warp  マウス操作による領域設定';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent := Self;
    SetBounds(5, 35, Self.ClientWidth - 10, Self.ClientHeight - 40);
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;
end;

//=============================================================================
//  [リセット]ボタン
//  操作元のパスを再作成する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(MyPanel) then exit;
  MyPanel.ResetWarp;
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  コンストラクタ
//  FSrcPath  : 操作元のパス
//  FPointsNo : 現在選択中のグラブハンドル)のインデックス
//  FGrabSize : グラブハンドルのサイズ
//-----------------------------------------------------------------------------
constructor TMyPanel.Create(AOwner: TComponent);
begin
  inherited;

  FSrcPath   := nil;
  FGrabSize := 3;
  FPointsNo  := -1;
  FGrabSize := 3;
end;

//-----------------------------------------------------------------------------
//  デストラクタ
//-----------------------------------------------------------------------------
destructor TMyPanel.Destroy;
begin
  FreeAndNil(FSrcPath);
  inherited;
end;

//-----------------------------------------------------------------------------
//  操作元のパスを再作成するためのメソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.ResetWarp;
begin
  FSrcPath := nil;
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  MouseDown メソッド
//  マウスダウンした位置がグラブハンドル内であったらリサイズ開始
//  PointsNoにそのグラブハンドルに相当する配列の番号をセット
//  これを移動作業のフラグとしても利用
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  i: Integer;
begin
  inherited;
  if FSrcPath = nil then exit;

  for i := 0 to Length(FPtsF) - 1 do begin
    if PtInRect(Bounds(Trunc(FPtsF[i].X - FGrabSize  - 1),
                       Trunc(FPtsF[i].Y - FGrabSize) - 1,
                       FGrabSize * 2 + 2,
                       FGrabSize * 2 + 2), Point(X, Y)) then begin
      FPointsNo := i;
      exit;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  MouseMove メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if FSrcPath = nil then exit;

  if FPointsNo <> -1 then begin
    FPtsF[FPointsNo].X := X;
    FPtsF[FPointsNo].Y := Y;
    Repaint;
  end;
end;

//-----------------------------------------------------------------------------
//  MouseUp メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FPointsNo   := -1;
end;

//-----------------------------------------------------------------------------
//  TMyPanelのPaint メソッド
//  実際の描画コード関係
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LSrcRect      : TRect;
  LSrcWidth     : Integer;
  LSrcHeight    : Integer;
  LSrcLeft      : Integer;
  LSrcTop       : Integer;
  LFontSize     : Single;
  LGPGraphic    : TGPGraphics;
  LGPPen        : TGPPen;
  LGPBrush      : TGPBrush;
  LGPFontFamily : TGPFontFamily;
  LGPStrFormat  : TGPStringFormat;
  LGPRectF      : TGPRectF;
  LGPClonePath  : TGPGraphicsPath;
  i             : Integer;
begin
  inherited;

  //---------------------------------------------------------------------------
  //  パスの作成
  //  (1) 領域のTRect型に値を代入
  //  (2) マウスで操作するために，配列に点の座標値を格納
  //  (3) バスを生成して，楕円と文字列を追加．文字列は上下左右の中央とする
  //---------------------------------------------------------------------------
  if FSrcPath = nil then begin
    //描画位置は，このTMyPanelの中央とし，サイズは半分とする
    LSrcWidth  := Width  div 2;
    LSrcHeight := Height div 2;
    LSrcLeft   := LSrcWidth  div 2;
    LSrcTop    := LSrcHeight div 2;
    LSrcRect   := Rect(LSrcLeft, LSrcTop, LSrcLeft + LSrcWidth, LSrcTop + LSrcHeight);

    FPtsF[0] := MakePoint(LSrcRect.Left  * 1.0, LSrcRect.Top);
    FPtsF[1] := MakePoint(LSrcRect.Right * 1.0, LSrcRect.Top);
    FPtsF[2] := MakePoint(LSrcRect.Left  * 1.0, LSrcRect.Bottom);
    FPtsF[3] := MakePoint(LSrcRect.Right * 1.0, LSrcRect.Bottom);

    FSrcPath := TGPGraphicsPath.Create;
    FSrcPath.AddEllipse(MakeRect(LSrcRect));
    LGPFontFamily := TGPFontFamily.Create('Arial Black');

    LGPStrFormat := TGPStringFormat.Create;
    LGPStrFormat.SetAlignment(StringAlignmentCenter);
    LGPStrFormat.SetLineAlignment(StringAlignmentCenter);

    //文字列を描画する領域を取得
    FSrcPath.GetBounds(LGPRectF);
    LFontSize := LGPRectF.Height / 3.5;
    FSrcPath.AddString('Delphi',
                      -1,
                      LGPFontFamily,
                      FontStyleRegular,
                      LFontSize,
                      LGPRectF,
                      LGPStrFormat);
    LGPStrFormat.Free;
    LGPFontFamily.Free;
  end;
  //---------------------------------------------------------------------------
  //  パス作成終了
  //  実際の描画はこの下のコード
  //---------------------------------------------------------------------------


  //元のパスの複製を作成
  //元のパスに対して変形を繰返すと，変形のその変形になってしまう
  LGPClonePath := FSrcPath.Clone;
  LGPClonePath.GetBounds(LGPRectF);

  //Warp関数で描画の領域を指定してパス情報を更新
  LGPClonePath.Warp(PGPPointF(@FPtsF), Length(FPtsF), LGPRectF);
  //このCanvasを描画先とするTGPGraphicsを生成，ブラシを設定
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPBrush   := TGPHatchBrush.Create(HatchStyleShingle, aclSkyBlue);

  //Warp関数で設定したパスを描画
  LGPGraphic.FillPath(LGPBrush, LGPClonePath);


  //配列に格納されている座標値の間を結ぶ直線を描画
  LGPPen := TGPPen.Create(aclBlack, 1);
  LGPGraphic.DrawLine(LGPPen, FPtsF[0].X, FPtsF[0].Y, FPtsF[1].X, FPtsF[1].Y);
  LGPGraphic.DrawLine(LGPPen, FPtsF[1].X, FPtsF[1].Y, FPtsF[3].X, FPtsF[3].Y);
  LGPGraphic.DrawLine(LGPPen, FPtsF[3].X, FPtsF[3].Y, FPtsF[2].X, FPtsF[2].Y);
  LGPGraphic.DrawLine(LGPPen, FPtsF[2].X, FPtsF[2].Y, FPtsF[0].X, FPtsF[0].Y);

  //配列に格納されている座標の位置に四角形を描画
  LGPPen.SetWidth(2.0);
  for i := 0 to Length(FPtsF) - 1 do begin
    LGPGraphic.DrawRectangle(LGPPen,
                             MakeRect(FPtsF[i].X - FGrabSize,
                                      FPtsF[i].Y - FGrabSize,
                                      FGrabSize * 2,
                                      FGrabSize * 2));
  end;

  //Createしたオブジェクトは解放する
  LGPGraphic.Free;
  LGPPen.Free;
  LGPBrush.Free;
  LGPClonePath.Free;
end;

end.