Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2025年03月11日] [更新 2025年04月10日]　画像・図形の移動リサイズ関係サンプル
画像・図形の移動リサイズ関係サンプル　
R060_楕円を描画するクラスの例
動作確認等 Windows 10 ビルド 19045 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
R060_ResizeEllipse.zip　[8.9 MB]　2025年04月10日版 (EXE 同梱)
描画用クラスのソースコードは [概要] ページからダウンロードする






楕円を描画するクラスの例


楕円描画用のクラスとそのテストプログラムです．
楕円の描画を VCL で行う場合と GDI+ で行う場合，拡張描画領域を使用しない場合と拡張描画領域を行う吐合のクラスを作成してテストしています．

今回テスト用に作成した楕円描画用のクラスに実装しているプロパティは以下だけです． 本ページのテストプログラムは，全て，線の幅の変更と，描画している図形をビットマップ画像として保存するだけとなつています．楕円は，上下左右が反転しても図形は変化しません．そこで，確認用の直線を描画するようにしています．


プロパティ 型 (VCL) 型 (GDI+) 説明
PenWidth Integer Single 線の幅．
PenColor TColor TGPColor 線の色






01_楕円描画用クラス ( VCL 使用・拡張描画なし )


図形の描画に VCL を使用して，拡張描画領域を使用しない楕円描画用クラスのテストプログラムです．コンテナコントロールには TPanel を使用しています．


図1
拡張描画領域を使用しない場合
  • 描画はラバーバンド上と内側だけ

リスト1
図形の描画に VCL を使用して，拡張描画領域を使用しない楕円描画用クラスののテスト 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FResizeEllipse : TplResizeEllipse;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FResizeEllipse) then begin
    FreeAndNil(FResizeEllipse);
  end;

  FResizeEllipse := TplResizeEllipse.Create(Self);
  FResizeEllipse.Parent      := Panel2;
  FResizeEllipse.InverseDisp := True;
end;

//=============================================================================
//  [画像保存] ボタン
//  描画している図形をビットマップ画像として保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
  LImgGUID  : TGUID;
begin
  if not Assigned(FResizeEllipse) then Exit;

  // GetGPBitmap メソッドを使用
  LGPBitmap := FResizeEllipse.GetGPBitmap;
  if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LGPBitmap.Save('01_OriginBitmap.bmp', LImgGUID);

  // TGPBitmap を TBitmap に変換して保存
  LBitmap := TBitmap.Create;
  try
    FResizeEllipse.GPBitmapToBitmap(LGPBitmap, LBitmap);
    LBitmap.SaveToFile('02_TBitmap.bmp');
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Assigned(FResizeEllipse) then Exit;

  FResizeEllipse.PenColor := clRed;
end;

end.


テストに使用した楕円描画用クラスのソースコードです．


リスト2
図形の描画に VCL を使用して，拡張描画領域を使用しない楕円描画用クラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plResizeEllipse;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, plBaseDragResize,
  GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TplResizeEllipse = class(TplBaseDragResize)
  private
    FPenColor   : TColor;
    FPenWidth   : Integer;
    FBrushColor : TColor;
    procedure SetFPenColor(const Value: TColor);
    procedure SetFPenWidth(const Value: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  published
    property PenColor : TColor read FPenColor write SetFPenColor;
    property PenWidth : Integer read FPenWidth write SetFPenWidth;
  end;

implementation

uses
  Types,
  Math;

{ TplResizeEllipse }

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplResizeEllipse.Create(AOwner: TComponent);
begin
  inherited;

  FPenColor := clBlue;
  FPenWidth := 10;
end;

//-----------------------------------------------------------------------------
//  PenColor プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplResizeEllipse.SetFPenColor(const Value: TColor);
begin
  if FPenColor <> Value then begin
    FPenColor := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  PenWidth プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplResizeEllipse.SetFPenWidth(const Value: Integer);
begin
  if FPenWidth <> Value then begin
    FPenWidth := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//  TGPBitmap として取得する場合は
//  引数の AGPBitmap を描画先とした TGPGraphics を生成して描画する
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplResizeEllipse.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LBitmap     : TBitmap;
  LTransColor : Cardinal;
  LPosX       : Integer;
  LPosY       : Integer;
  LPosD       : Integer;
  LHalfW      : Integer;
  LHalfH      : Integer;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;

  // 描画の結果を画像として取得する際の処理
  // 以下のコードを実行する前にすでに図形は描画されているので
  // AddExtend の値は既知
  // LTransColor は TBitmap の透過色
  LBitmap := nil;
  LTransColor := rgb($57, $57, $57);

  //-------------------
  // 描画結果を AGPBitmap に返す場合
  if ACanvas = nil then begin
    // TBitmap を生成してその TCanvas に描画
    // 描画後に TGPBitmap に変換
    LBitmap := TBitmap.Create;
    SetBitmapCanvas_forDraw(LBitmap, ACanvas, LTransColor);
  end;
  //-------------------


  ACanvas.Pen.Width := FPenWidth;
  ACanvas.Pen.Color := FPenColor;
  ACanvas.Brush.Style := bsClear;

  LHalfW := SignX * FPenWidth div 2;
  LHalfH := SignY * FPenWidth div 2;
  Acanvas.Ellipse(DrawLeft + LHalfw, DrawTop + LHalfH,
                  DrawLeft + DrawWidth - LHalfW, DrawTop + DrawHeight - LHalfH);

  // 参考に直線を追加描画
  // 具体的な数値を指定した場合、拡大、縮小してもその値のまま

  LPosD := Width div 4;
  LPosX := DrawLeft + SignX  * LPosD;
  LPosY := DrawTop + SignY * 50;
  ACanvas.MoveTo(LPosX, LPosY);
  LPosY := DrawTop + DrawHeight - LHalfH;
  ACanvas.LineTo(LPosX, LPosY);


  //-------------------
  // 描画結果を AGPBitmap に返す場合
  // 描画を AGPBitmap に返す処理
  if Assigned(LBitmap) then begin
    BitmapToGPBitmap_forDraw(LBitmap, AGPBitmap, LTransColor, AOffsetX, AOffsetY);
    FreeAndNil(LBitmap);
  end;
end;

end.


上の DrawRoutine メソッドでは，線の幅を考慮して描画位置を設定しています．それ結果，下図のように線の幅に関係なくラバーバンド内に描画されています．



図2
線の幅を考慮した描画

DrawRoutine メソッド内の変数 LHalfW と LHalfH を 0 にすると線の幅を考慮しない描画となります．その結果，下図のようになります．


図3
線の幅を考慮しない描画




02_楕円描画用クラス ( VCL 使用・拡張描画使用 )


図形の描画に VCL を使用して，拡張描画領域を使用する楕円描画用クラスのテストプログラムです．コンテナコントロールには TPanel を使用しています．


図4
拡張描画領域を使用する場合
  • ラバーバンドの外側も描画

リスト3
図形の描画に VCL を使用して，拡張描画領域を使用する楕円描画用クラスののテスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FResizeEllipse : TplResizeEllipseEx;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FResizeEllipse) then begin
    FreeAndNil(FResizeEllipse);
  end;

  FResizeEllipse := TplResizeEllipseEx.Create(Self);
  FResizeEllipse.Parent      := Panel2;
  FResizeEllipse.InverseDisp := True;
end;

//=============================================================================
//  [画像保存] ボタン
//  描画している図形をビットマップ画像として保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
  LImgGUID  : TGUID;
begin
  if not Assigned(FResizeEllipse) then Exit;

  // GetGPBitmap メソッドを使用
  LGPBitmap := FResizeEllipse.GetGPBitmap;
  if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LGPBitmap.Save('01_OriginBitmap.bmp', LImgGUID);

  // TGPBitmap を TBitmap に変換して保存
  LBitmap := TBitmap.Create;
  try
    FResizeEllipse.GPBitmapToBitmap(LGPBitmap, LBitmap);
    LBitmap.SaveToFile('02_TBitmap.bmp');
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Assigned(FResizeEllipse) then Exit;

  FResizeEllipse.PenColor := clRed;
end;

end.


テストに使用した楕円描画用クラスのソースコードです．
拡張描画領域を使用するには，クラスのコンストラクタ (Create メソッドの実装部) で UseExtend プロパティを True にして，AddExtend プロパティで拡張描画領域のサイズを設定します．


リスト4
図形の描画に VCL を使用して，拡張描画領域を使用する楕円描画用クラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plResizeEllipseEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, plBaseDragResize,
  GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TplResizeEllipseEx = class(TplBaseDragResize)
  private
    FPenColor   : TColor;
    FPenWidth   : Integer;
    procedure SetFPenColor(const Value: TColor);
    procedure SetFPenWidth(const Value: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  published
    property PenColor : TColor read FPenColor write SetFPenColor;
    property PenWidth : Integer read FPenWidth write SetFPenWidth;
  end;

implementation

uses
  Types,
  Math;

{ TplResizeEllipseEx }

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplResizeEllipseEx.Create(AOwner: TComponent);
begin
  inherited;

  FPenColor := clBlue;
  FPenWidth := 10;

  // 拡張描画領域を使用する
  // 拡張描画領域が固定でよければここで AddExtend の値を設定してもよい 
  UseExtend := True;
  //AddExtend := 40;
end;

//-----------------------------------------------------------------------------
//  PenColor プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplResizeEllipseEx.SetFPenColor(const Value: TColor);
begin
  if FPenColor <> Value then begin
    FPenColor := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  PenWidth プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplResizeEllipseEx.SetFPenWidth(const Value: Integer);
begin
  if FPenWidth <> Value then begin
    FPenWidth := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//  TGPBitmap として取得する場合は
//  TBitmap に描画した内容を AGPBitmap に変換して返す
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplResizeEllipseEx.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LBitmap      : TBitmap;
  LTransColor  : Cardinal;
  LPosX        : Integer;
  LPosY        : Integer;
  LPosD        : Integer;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;
  if not Assigned(ExtendCtrl) then Exit;


  // 描画の結果を画像として取得する際の処理
  // 以下のコードを実行する前にすでに図形は描画されているので
  // AddExtend の値は既知
  // LTransColor は TBitmap の透過色
  LBitmap := nil;
  LTransColor := rgb($57, $57, $57);

  // コントロールの追加サイズ分
  // 上下左右に拡張する部分
  AddExtend := FPenWidth * 2;


  //-------------------
  // 描画結果を AGPBitmap に返す場合
  if ACanvas = nil then begin
    // TBitmap を生成してその TCanvas に描画
    // 描画後に TGPBitmap に変換
    LBitmap := TBitmap.Create;
    SetBitmapCanvas_forDraw(LBitmap, ACanvas, LTransColor);
  end;
  //-------------------


  ACanvas.Pen.Width := FPenWidth;
  ACanvas.Pen.Color := FPenColor;

  // 楕円を描画
  LPosX := DrawLeft + AddExtend;
  LPosY := DrawTop + AddExtend;
  Acanvas.Ellipse(LPosX, LPosY, LPosX + DrawWidth, LPosY + DrawHeight);

  // 参考に直線を追加描画 
  // 具体的な数値を指定した場合、拡大、縮小してもその値のまま

  LPosD := Width div 4;
  LPosX := DrawLeft + AddExtend + SignX  * LPosD;
  LPosY := DrawTop + AddExtend + SignY * 50;
  ACanvas.MoveTo(LPosX, LPosY);
  LPosY :=  + DrawTop + AddExtend + DrawHeight;
  ACanvas.LineTo(LPosX, LPosY);


  //-------------------
  // 描画を AGPBitmap に返す処理
  if Assigned(LBitmap) then begin
    BitmapToGPBitmap_forDraw(LBitmap, AGPBitmap, LTransColor, AOffsetX, AOffsetY);
    FreeAndNil(LBitmap);
  end;
end;

end.



03_楕円描画用クラス ( VCL 使用・拡張描画使用 ) - 専用コンテナ使用


前項と同じ楕円描画用クラスのテストですが，コンテナコントロールに専用の TplContainerPanel を使用しています．これをコンテナとして使用すると，複数の描画コントロールを選択状態にできます．複数の描画コトンロールが選択されていると，それらの図形を結合したビットマップの保存となります．


図5
複数の図形を選択
  • [Ctrl] + [クリック] で選択

リスト5
図形の描画に VCL を使用して，拡張描画領域を使用する楕円描画用クラスののテスト		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, GDIPOBJ, GDIPAPI,
  GDIPUTIL, plResizeEllipseEx,
  plContainerPanel,
  plBaseDragResize;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl : TplContainerPanel;
    FCtrl : TplBaseDragResize;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';

  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent    := Self;
  FBackCtrl.Align     := alClient;
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  // 生成亟みの描画用コントロールを削除
  // TplContainerPanel を使用する場合は専用のメソッドを使用する
  // これを実行しなければいつくでも生成できる
//  FBackCtrl.DeleteAllCtrls;

  FCtrl := TplResizeEllipseEx.Create(Self);
  FCtrl.Parent      := FBackCtrl;
  FCtrl.InverseDisp := True;
end;

//=============================================================================
//  [選択画像保存] ボタン
//  TplContainerPanel のメソッドを使用
//  ただし、選択状態でないし取得できない
//  複数の図形が選択されている場合は、それらを結合した画像の取得となる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LImgGUID  : TGUID;
begin
  LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
  try
    if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;
    LGPBitmap.Save('01_BackMethod.bmp', LImgGUID);
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更 ある
//  plContainerPanel を使用する場合の処理例
//  型キャストして描画用クラスのプロパティやメソッドを使用する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LCtrl : TplBaseDragResize;
begin
  if FBackCtrl.CtrlList.Count = 0 then Exit;

  // 最初に生成した楕円 ( Z オーダは最下位 ) の線の色を変更
  if FBackCtrl.CtrlList[0] is TplResizeEllipseEx then begin
    LCtrl := FBackCtrl.CtrlList[0];
    TplResizeEllipseEx(LCtrl).PenColor := clRed;
  end;
end;

end.



04_楕円描画用クラス ( GDI+ 使用・拡張描画なし )


図形の描画に GDI+ を使用して，拡張描画領域を使用しない楕円描画用クラスのテストプログラムです．コンテナコントロールには TPanel を使用しています．


図6
拡張描画領域を使用しない場合
  • 描画はラバーバンド上と内側だけ

リスト6
図形の描画に GDI+ を使用して，拡張描画領域を使用しない楕円描画用クラスののテスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FResizeEllipse : TplGPResizeEllipse;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FResizeEllipse) then begin
    FreeAndNil(FResizeEllipse);
  end;

  FResizeEllipse := TplGPResizeEllipse.Create(Self);
  FResizeEllipse.Parent      := Panel2;
  FResizeEllipse.InverseDisp := True;
end;

//=============================================================================
//  [画像保存] ボタン
//  描画している図形をビットマップ画像として保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
  LImgGUID  : TGUID;
begin
  if not Assigned(FResizeEllipse) then Exit;

  // GetGPBitmap メソッドを使用
  LGPBitmap := FResizeEllipse.GetGPBitmap;
  if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LGPBitmap.Save('01_OriginBitmap.bmp', LImgGUID);

  // TGPBitmap を TBitmap に変換して保存
  LBitmap := TBitmap.Create;
  try
    FResizeEllipse.GPBitmapToBitmap(LGPBitmap, LBitmap);
    LBitmap.SaveToFile('02_TBitmap.bmp');
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Assigned(FResizeEllipse) then Exit;

  FResizeEllipse.PenColor := aclRed;
  // VCL の色を GDI+ の色に変換する場合は以下
  //FResizeEllipse.PenColor := ColorRefToARGB(clRed);
end;

end.


テストに使用した楕円描画用クラスのソースコードです．


リスト7
図形の描画に GDI+ を使用して，拡張描画領域を使用しない楕円描画用クラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plGPResizeEllipse;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, plBaseDragResize,
  GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TplGPResizeEllipse = class(TplBaseDragResize)
  private
    FPenColor   : TGPColor;
    FBrushColor : TGPColor;
    FPenWidth   : Single;
    procedure SetFPenColor(const Value: TGPColor);
    procedure SetFPenWidth(const Value: Single);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  published
    property PenColor : TGPColor read FPenColor write SetFPenColor;
    property BrushColor : TGPColor read FBrushColor write FBrushColor;
    property PenWidth : Single read FPenWidth write SetFPenWidth;
  end;

implementation

uses
  Types,
  Math;

{ TplGPResizeEllipse }

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplGPResizeEllipse.Create(AOwner: TComponent);
begin
  inherited;

  FBrushColor := aclTransparent;
  FPenColor := $FF00A0FF;
  FPenWidth := 10;
end;

//-----------------------------------------------------------------------------
//  PenColor プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipse.SetFPenColor(const Value: TGPColor);
begin
  if FPenColor <> Value then begin
    FPenColor := Value;

    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  PenWidth プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipse.SetFPenWidth(const Value: Single);
begin
  if FPenWidth <> Value then begin
    FPenWidth := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//  TGPBitmap として取得する場合は
//  引数の AGPBitmap を描画先とした TGPGraphics を生成して描画する
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipse.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic : TGPGraphics;
　LGPPen     : TGPPen;
  LGPBrush   : TGPSolidBrush;
  LHalfW     : Single;
  LHalfH     : Single;
  LGPRect    : TGPRectF;
  LPosX      : Single;
  LPosY      : Single;
  LPosD      : Single;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;
  if (FPenColor = aclTransparent) and (FBrushColor = aclTransparent) then exit;


    // TGPGraphicsオブジェクトを生成
    if ACanvas = nil then begin
      LGPGraphic := TGPGraphics.Create(AGPBitmap);
    end else begin
      LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
    end;

  // ペンのオブジェクトを生成
  LGPPen := TGPPen.Create(FPenColor, FPenWidth);
  //TGPSolidBrushを生成
  LGPBrush := TGPSolidBrush.Create(FBrushColor);
  try
    LHalfW := SignX * FPenWidth / 2.0;
    LHalfH := SignY * FPenWidth / 2.0;
    LGPRect := MakeRect(DrawLeft + Lhalfw, DrawTop + LhalfH,
                        Drawwidth - LHalfW * 2.0, DrawHeight - LHalfH * 2.0);

    if FBrushColor <> aclTransparent then begin
      // 内部を塗り潰す
      LGPGraphic.FillEllipse(LGPBrush, LGPRect);
    end;

    if FPenColor <> aclTransparent then begin
      // 周囲の枠線を描画
      // 線の描画関係の関数名は DrawXXXX
      LGPGraphic.DrawEllipse(LGPPen, LGPRect);


  // 参考に直線を追加描画
  // 具体的な数値を指定した場合、拡大、縮小してもその値のまま

      LPosD := Width / 4.0;
      LPosX := DrawLeft + SignX  * LPosD;
      LPosY := DrawTop + SignY * 50.0;
      LGPGraphic.DrawLine(LGPPen, LPosX, LPosY, LPosX, DrawTop + DrawHeight);
    end;
  finally
    FreeAndNil(LGPBrush);
    FreeAndNil(LGPPen);
    FreeAndNil(LGPGraphic);
  end;
end;

end.



05_楕円描画用クラス ( GDI+ 使用・拡張描画使用 )


図形の描画に VCL を使用して，拡張描画領域を使用する楕円描画用クラスのテストプログラムです．コンテナコントロールには TPanel を使用しています．


図7
拡張描画領域を使用する場合
  • ラバーバンドの外側も描画

リスト8
図形の描画に GDI+ を使用して，拡張描画領域を使用する楕円描画用クラスののテスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FResizeEllipse : TplGPResizeEllipseEx;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FResizeEllipse) then begin
    FreeAndNil(FResizeEllipse);
  end;

  FResizeEllipse := TplGPResizeEllipseEx.Create(Self);
  FResizeEllipse.Parent      := Panel2;
  FResizeEllipse.InverseDisp := True;
end;

//=============================================================================
//  [画像保存] ボタン
//  描画している図形をビットマップ画像として保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
  LhBitmap  : HBITMAP;
  LImgGUID  : TGUID;
begin
  if not Assigned(FResizeEllipse) then Exit;

  // GetGPBitmap メソッドを使用
  LGPBitmap := FResizeEllipse.GetGPBitmap;
  if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;

  LGPBitmap.Save('01_OriginBitmap.bmp', LImgGUID);

  // TGPBitmap を TBitmap に変換して保存
  LBitmap := TBitmap.Create;
  try
    LBitmap.AlphaFormat := afDefined;
    LGPBitmap.GetHBITMAP(0, LhBitmap);
    LBitmap.Handle := LhBitmap;
    LBitmap.SaveToFile('02_TBitmap.bmp');
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if not Assigned(FResizeEllipse) then Exit;

  FResizeEllipse.PenColor := aclRed;
  // VCL の色を GDI+ の色に変換する場合は以下
  //FResizeEllipse.PenColor := ColorRefToARGB(clRed);
end;

end.


テストに使用した楕円描画用クラスのソースコードです．
拡張描画領域を使用するには，クラスのコンストラクタ (Create メソッドの実装部) で UseExtend プロパティを True にして，AddExtend プロパティで拡張描画領域のサイズを設定します．


リスト9
図形の描画に GDI+ を使用して，拡張描画領域を使用する楕円描画用クラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plGPResizeEllipseEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, plBaseDragResize,
  GDIPAPI, GDIPOBJ, GDIPUTIL;

type
  TplGPResizeEllipseEx = class(TplBaseDragResize)
  private
    FPenColor   : TGPColor;
    FBrushColor : TGPColor;
    FPenWidth   : Single;
    procedure SetFPenColor(const Value: TGPColor);
    procedure SetFPenWidth(const Value: Single);
  public
    constructor Create(AOwner: TComponent); override;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  published
    property PenColor : TGPColor read FPenColor write SetFPenColor;
    property BrushColor : TGPColor read FBrushColor write FBrushColor;
    property PenWidth : Single read FPenWidth write SetFPenWidth;
  end;

implementation

uses
  Types,
  Math;

{ TplGPResizeEllipseEx }

//=============================================================================
//  コンストラクタ
//=============================================================================
constructor TplGPResizeEllipseEx.Create(AOwner: TComponent);
begin
  inherited;

  FBrushColor := aclTransparent;
  FPenColor := $FF00A0FF;
  FPenWidth := 10;

  // 拡張描画領域を使用する
  // 拡張描画領域が固定でよければここで AddExtend の値を設定してもよい 
  UseExtend := True;
  //AddExtend := 40;
end;

//-----------------------------------------------------------------------------
//  PenColor プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipseEx.SetFPenColor(const Value: TGPColor);
begin
  if FPenColor <> Value then begin
    FPenColor := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  PenWidth プロパティ設定用メソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipseEx.SetFPenWidth(const Value: Single);
begin
  if FPenWidth <> Value then begin
    FPenWidth := Value;
    // 描画を更新
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//  TGPBitmap として取得する場合は
//  一時的な TGPBitmap を描画先とした TGPGraphics を生成して描画
//  最後に引数の AGPBitmap を描画先にして返す
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipseEx.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic : TGPGraphics;
  LTempGPBmp : TGPBitmap;
　LGPPen     : TGPPen;
  LGPBrush   : TGPSolidBrush;
  LGPRect    : TGPRectF;
  LPosX      : Single;
  LPosY      : Single;
  LPosD      : Single;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;
  if not Assigned(ExtendCtrl) then Exit;
  if (FPenColor = aclTransparent) and (FBrushColor = aclTransparent) then exit;


  // コントロールの追加サイズ分
  AddExtend := Trunc(FPenWidth * 2);

  //---------------------
  // 描画結果を AGPBitmap に返す場合
  // 描画領域を拡張した一時的な TGPBitmap に描画する
  LTempGPBmp := nil;
  if ACanvas = nil then begin
    LTempGPBmp := TGPBitmap.Create(Width + AddExtend * 2, Height + AddExtend * 2);
  end;
  //---------------------


    // TGPGraphicsオブジェクトを生成 (引数が描画先)
    if ACanvas = nil then begin
      LGPGraphic := TGPGraphics.Create(LTempGPBmp);
    end else begin
      LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
    end;

  // ペンのオブジェクトを生成
  LGPPen := TGPPen.Create(FPenColor, FPenWidth);
  //TGPSolidBrushを生成
  LGPBrush := TGPSolidBrush.Create(FBrushColor);
  try
    LPosX := DrawLeft + AddExtend;
    LPosY := DrawTop + AddExtend;
    LGPRect := MakeRect(LPosX, LPosY, Drawwidth, DrawHeight);

    if FBrushColor <> aclTransparent then begin
      // 内部を塗り潰す
      LGPGraphic.FillEllipse(LGPBrush, LGPRect);
    end;

    if FPenColor <> aclTransparent then begin
      // 周囲の枠線を描画
      // 線の描画関係の関数名は DrawXXXX
      LGPGraphic.DrawEllipse(LGPPen, LGPRect);


  // 参考に直線を追加描画
  // 具体的な数値を指定した場合、拡大、縮小してもその値のまま

      LPosD := Width / 4.0;
      LPosX := DrawLeft + AddExtend +  SignX  * LPosD;
      LPosY := DrawTop + AddExtend + SignY * 50.0;
      LGPGraphic.DrawLine(LGPPen, LPosX, LPosY, LPosX, DrawTop + AddExtend + DrawHeight);
    end;


    //---------------------
    // 描画結果を AGPBitmap に返す場合
    // 描画先を AGPBitmap にした TGPGraphics に LTempGPBmp を描画
    if ACanvas = nil then begin
      FreeAndNil(LGPGraphic);
      LGPGraphic := TGPGraphics.Create(AGPBitmap);
      LGPGraphic.DrawImage(LTempGPBmp, AOffsetX, AOffsetY);
    end;
    //---------------------
  finally
    FreeAndNil(LGPBrush);
    FreeAndNil(LGPPen);
    FreeAndNil(LGPGraphic);
    if Assigned(LTempGPBmp) then begin
      FreeAndNil(LTempGPBmp);
    end;
  end;
end;

end.



06_楕円描画用クラス ( GDI+ 使用・拡張描画使用 ) - 専用コンテナ使用


前項と同じ楕円描画用クラスのテストですが，コンテナコントロールに専用の TplContainerPanel を使用しています．これをコンテナとして使用すると，複数の描画コントロールを選択状態にできます．複数の描画コトンロールが選択されていると，それらの図形を結合したビットマップの保存となります．


図8
複数の図形を選択
  • [Ctrl] + [クリック] で選択

リスト10
図形の描画に GDI+ を使用して，拡張描画領域を使用する楕円描画用クラスのテスト		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, GDIPOBJ, GDIPAPI, GDIPUTIL,
plGPResizeEllipseEx,
  plContainerPanel,
  plBaseDragResize;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl : TplContainerPanel;
    FCtrl : TplBaseDragResize;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  専用のコンテナコントロールを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';

  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent    := Self;
  FBackCtrl.Align     := alClient;
end;

//=============================================================================
//  [生成]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  // 生成済みの描画用コントロールを削除
  // TplContainerPanel を使用する場合は専用のメソッドを使用する
  // これを実行しなければいつくでも生成できる
//  FBackCtrl.DeleteAllCtrls;

  FCtrl := TplGPResizeEllipseEx.Create(Self);
  FCtrl.Parent      := FBackCtrl;
  FCtrl.InverseDisp := True;
end;

//=============================================================================
//  [選択画像保存] ボタン
//  TplContainerPanel のメソッドを使用
//  ただし、選択状態でないと取得できない
//  複数の図形が選択されている場合は、それらを結合した画像の取得となる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LGPBitmap : TGPBitmap;
  LImgGUID  : TGUID;
begin
  LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
  try
    if GetEncoderClsid('image/bmp', LImgGUID) < 0 then Exit;
    LGPBitmap.Save('01_BackMethod.bmp', LImgGUID);
  finally
    FreeAndNil(LGPBitmap);
  end;
end;

//=============================================================================
//  [色変更] ボタン
//  描画に使用する線の色を変更 ある
//  plContainerPanel を使用する場合の処理例
//  型キャストして描画用クラスのプロパティやメソッドを使用する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LCtrl : TplBaseDragResize;
begin
  if FBackCtrl.CtrlList.Count = 0 then Exit;

  // 最初に生成した楕円 ( Z オーダは最下位 ) の線の色を変更
  if FBackCtrl.CtrlList[0] is TplGPResizeEllipseEx then begin
    LCtrl := FBackCtrl.CtrlList[0];
    TplGPResizeEllipseEx(LCtrl).PenColor := aclRed;
  // VCL の色を GDI+ の色に変換する場合は以下
  //TplGPResizeEllipseEx(LCtrl).PenColor := ColorRefToARGB(clRed);
  end;
end;

end.



07_リサイズに応じて座標値を変換


本ページのサンプルで使用している描画用クラスでは，縦の直線を描画しています．
この直線の描画支点の Y 座標は，ラバーバンド上端から 50 ドット下の固定値となっています．したがって，ラバーバンドをリサイズしても，この 50 という値は変わりません．


図9
図形を生成
  • 縦の直線の始点の Y 座標は，ラバーバンド 上端から 50
図10
リサイズ
  • リサイズしても，縦の直線の始点の Y 座標は，ラバーバンド 上端から 50
図11
ラバーバンドの高さを 50 以下にする
  • 縦の直線は描画されない

この楕円描画用コトンロールの初期サイズは 100 x 100 です．50 というのはこの半分，つまり 50% ま位置です．縦の直線の描画始点の Y 座標を常に 50% の位置になるようにしてみます．描画コントロールの高さが 200 になったら 100 になるようにします．
まず，描画用コントロールを生成した時の幅と高さを保持しておくグローバル変数を定義して，Create メソッドで値を設定します．		 


  // Creatae メソッドで以下の変数を設定
  // FOriginWidth, FOriginHeight は，Integer 型のグローバル変数

  FOriginWidth  := Width;
  FOriginHeight := Height;


次のような変換用の関数を実装します． 


//-----------------------------------------------------------------------------
//  X 座標値をリサイズに応じて変換
//-----------------------------------------------------------------------------
function TplGPResizeEllipseEx.ToRelativeX(X: Single): Single;
var
  LRatioX : Single;
begin
  LRatioX := Width / FOriginWidth;
  Result := DrawLeft + AddExtend + SignX * LRatioX * X;
end;

//-----------------------------------------------------------------------------
//  Y 座標値をリサイズに応じて変換
//-----------------------------------------------------------------------------
function TplGPResizeEllipseEx.ToRelativeY(Y: Single): Single;
var
  LRatioY : Single;
begin
  LRatioY := Height / FOriginHeight;
  Result := DrawTop + AddExtend + SignY * LRatioY * Y;
end;


DrawRoutine メソッド内の，直線を描画するコードを以下のようにします． 


      LPosX := ToRelativeX(25.0);
      LPosY := ToRelativeY(50.0); 
      LGPGraphic.DrawLine(LGPPen, LPosX, LPosY, LPosX, DrawTop + AddExtend + DrawHeight);


下図は実行結果です．
このように，座標値を相対値として処理できます．作成した関数内の LRatioX, LRatioY を 1.0 にすれば，引数の座標値を絶対値として処理できます．
当然ですが，Create メソッドで描画用コントロールまサイズを 150 x 150 (Width = 150, Height = 150) にした場合，50 ドットは 33.33% になります．


図12
生成してリサイズ
  • 縦の直線の描画始点 Y 座標は，描画用コトンロールの高さの半分
図13
ラバーバンドの高さを 50 以下にする
  • 縦の直線の描画始点 Y 座標は，描画用コトンロールの高さの半分
    これは上の図と同じ

TGPPointF を使用する場合は，例えば以下のような関数を実装します．LRatioX, LRatioY はグローバル変数にして，DrawRoutine メソッド内で計算した方がいいかも知れません． 


//-----------------------------------------------------------------------------
//  TPoint 座標値をリサイズに応じて変換
//-----------------------------------------------------------------------------
function TplGPResizeEllipseEx.ToRelativePos(APos: TGPPointF): TGPPointF;
var
  LRatioX : Single;
  LRatioY : Single;
begin
  LRatioX := Width / FOriginWidth;
  LRatioY := Height / FOriginHeight;
  Result.X := DrawLeft + AddExtend + SignX * LRatioX * APos.X;
  Result.Y := DrawTop + AddExtend + SignY * LRatioY * APOS.Y;
end;



08_リサイズに応じて座標値を変換 - 座標値のリスト


座標値のリスト TList<TGPointF> を使用する方法です．
直線は端点として始点と終点の 2 組の座標値を使用しますが，汎用的に処理するために次のようなメソッドを実装することにします．		 


//-----------------------------------------------------------------------------
//  座標値リストの座標値をリサイズに応じて変換
//
//  TList<TGPPointF> は，利用する側で生成して解放処理を行う
//  TList<TGPPointF> の使用には uses に Generics.Collections が必要
//-----------------------------------------------------------------------------
procedure TplGPResizeEllipseEx.ToRelativePosList(APosList: TList<TGPPointF>);
var
  LRatioX : Single;
  LRatioY : Single;
  LPointF : TGPPointF;
  LIndex  : Integer;
begin
  if not Assigned(APosList) then Exit;

  LRatioX := Width / FOriginWidth;
  LRatioY := Height / FOriginHeight;

  for LIndex := 0 to APosList.Count - 1 do begin
    LPointF.X := DrawLeft + AddExtend + SignX * LRatioX * APosList[LIndex].X;
    LPointF.Y := DrawTop + AddExtend + SignY * LRatioY * APosList[LIndex].Y;
    APosList[LIndex] := LPointF;
  end;
end;


DrawRoutine メソッド内の，直線を描画するコードを以下のようにします． 


  FPosList.Clear;
  LPosF.X := 25.0;
  LposF.Y := 50.0;
  FPosList.Add(LPosF);
  LPosF.X := 25.0;
  LposF.Y := FOriginHeight;
  FPosList.Add(LPosF);

  // 座標値を変換して描画
  ToRelativePosList(FPosList);
  LGPGraphic.DrawLine(LGPPen, FPosList[0].X, FPosList[0].Y, FPosList[1].X, FPosList[1].Y);


実行結果です．ZIP 書庫に添付のサンプルで確認できます．


図14
生成してリサイズ
  • 縦の直線の描画始点 Y 座標は，描画用コトンロールの高さの半分
図15
ラバーバンドの高さを 50 以下にする
  • 縦の直線の描画始点 Y 座標は，描画用コトンロールの高さの半分
    これは上の図と同じ

楕円の描画にも座標値のリストを使用する場合は，例えば以下のようになります．MakeRect 関数の第 3 引数と第 4 引数の値は座標値ではなく，幅と高さです． 


    FPosList.Clear;
    // 楕円の端点
    LPosF.X := 0.0;
    LPosF.Y := 0.0;
    FPosList.Add(LPosF);
    LPosF.X := FOriginWidth;
    LPosF.Y := FOriginHeight;
    FPosList.Add(LPosF);
    // 縦の直線の短点
    LPosF.X := 25.0;
    LposF.Y := 50.0;
    FPosList.Add(LPosF);
    LPosF.X := 25.0;
    LposF.Y := FOriginHeight;
    FPosList.Add(LPosF);

    // 座標値を変換
    ToRelativePosList(FPosList);

    // 楕円の描画用の TRectF を設定
    LGPRect := MakeRect(FPosList[0].X, FPosList[0].Y,
                        FPosList[1].X - FPosList[0].X, FPosList[1].Y - FPosList[0].Y);
      // 楕円を描画
      LGPGraphic.DrawEllipse(LGPPen, LGPRect);


      // 縦の直線の描画
      LGPGraphic.DrawLine(LGPPen, FPosList[2].X, FPosList[2].Y, FPosList[3].X, FPosList[3].Y);