Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年09月20日] [更新 2025年03月19日]　画像・図形の移動リサイズ関係サンプル
画像・図形の移動リサイズ関係サンプル　
R040_直線を描画するクラスの例
動作確認等 Windows 10 ビルド 19045 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
掲載画像は Windows 7 U64(SP1) + Delphi XE(UP1) Pro

R040_ResizeLine.zip　[3.0 MB]　2025年03月11日版 (EXE 同梱)
描画用クラスのソースコードは [概要] ページからダウンロードする






線を描画するクラスと描画領域の問題 - 拡張描画領域で対応


矢印付きの直線を描画するクラスの例です．

この直線描画用のクラスは特別な工夫をしています．
下図は基本クラスのページで説明した直線描画のコードで，線の幅を大きくした時の状態を示しています．直線の端点が描画コントロールでクリップされて描画が欠落しています．また，水平または垂直に近くなるど線の幅が小さくなってしまいます．


図1
直線描画の問題
  • 端点が欠落してしまう
図2
垂直に近い状態にした場合
  • 線の幅が小さくなってしまう

この現象を回避するため，本直線描画用クラスでは拡張描画領域を使用しています．拡張描画領域は，ラバーバンドよりも大きな TGraphicControl を用意して，そこに図形を描画します．この TGraphicControl が拡張描画領域です．拡張描画領域を使用するには，描画用クラスのコンストラクタ (Create メソッド) で UseExtend プロパティを True にして，AddExtend プロパティで拡張して追加する分を設定します．

今回作成した直線描画用のクラスには，以下のプロパティを実装してます．


プロパティ 型 説明
LineType TplLineType 水平な直線，垂直な直線，斜めの直線の指定
初期値は ltNormal で斜めの直線
LineStartPos TPoint 描画開始の座標値．描画コントロールの生成時のみ有効な設定
指定しない場合は描画コントロールの左上の座標値
LineEndPos TPoint 描画終点の座標値．描画コントロールの生成時のみ有効な設定
指定しない場合は描画コントロールの右下の座標値
PenWidth Single 線幅．初期値は 3.0
PenColor TGPColor 線の色．GDI+ での色での指定なので注意．初期値は aclBlack (黒)
MiddleInset Single 矢印の底辺の切り込み深さ．線幅の倍数で指定．初期値は 0.0
ArrowWidth Single 矢印の幅．線幅の倍数で指定．初期値は 3.3
ArrowHeight Single 矢印の高さ．線幅の倍数で指定．初期値は 4.5
StartArrow Boolean 描画開始点の矢印描画の有無．初期値は False
EndArrow Boolean 描画終点の矢印描画の有無．初期値は False




01_直線描画用コントロールの動作確認


作成した直線描画クラスのテストです．
直線の端点が欠落しないで描画できるこど確認できます．垂直に近い状態になっても線幅が保たれていることも確認できます．



図3
実行して直線を描画
図4
垂直に近い状態にした場合
図5
矢印付の直線にした場合

リスト1
直線描画用コントロールのテスト 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    ColorDialog1: TColorDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl   : TplContainerPanel;
    FResizeLine : TplGPResizeLine;
  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;

  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := 200;
  SpinEdit1.Value    := SpinEdit1.MinValue;
end;

//=============================================================================
//  [生成]ボタン
//  GDI+ の色は ARGB のバイト順
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FBackCtrl.DeleteAllCtrls;

  FResizeLine := TplGPResizeLine.Create(Self);
  FResizeLine.Parent      := FBackCtrl;
  FResizeLine.InverseDisp := True;
  FResizeLine.PenWidth    := 10.0;
  FResizeLine.PenColor    := $FF00A0FF;

  SpinEdit1.Value    := Trunc(FResizeLine.PenWidth);
  ColorDialog1.Color := ARGBToColorRef(FResizeLine.PenColor);
end;

//=============================================================================
//  線の色を変更
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  if ColorDialog1.Execute then begin
    FResizeLine.PenColor := ColorRefToARGB(ColorDialog1.Color);
  end;
end;

//=============================================================================
//  線の太さを変更
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  FResizeLine.PenWidth := SpinEdit1.Value;
end;

//=============================================================================
//  矢印の描画有無の設定
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  FResizeLine.StartArrow := CheckBox1.Checked;
  FResizeLine.EndArrow   := CheckBox2.Checked;
end;

end.



02_水平な直線と垂直な直線の描画


描画コントロールの高さを 0 にすれば水平な直線，幅を 0 にすれば垂直な直線になりますが，提供している描画コントロールでは幅または高さを 0 にできないようにしています．
幅または高さを 0 にしてしまうと，描画コントロールのサイズが 0 になってしまい，選択できなくなってしまいます．サイズが 0 の存在しないコントロールは選択できません．

そこで，水平な直線と垂直な直線はプロパティで指定するようにしました．以下の列挙型のいすれかの値で指定します．
下図はそれらの値を使用して実際に水平な，あるいは垂直な直線を描画するテストの結果です．



図6
実行開始時は垂直な直線を描画
図7
斜めの直線に変更
  • 直線は対角線上に描画される
図8
水平な直線に変更
  • リサイズは水平方向だけ可能
図9
垂直な直線にして矢印を追加
  • リサイズは垂直方向だけ可能

リスト2
水平または垂直な直線を描画するテスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    ColorDialog1: TColorDialog;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl   : TplContainerPanel;
    FResizeLine : TplGPResizeLine;
  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;

  SpinEdit1.MinValue := 1;
  SpinEdit1.MaxValue := 200;
  SpinEdit1.Value    := SpinEdit1.MinValue;
end;

//=============================================================================
//  [生成]ボタン
//  GDI+ の色は ARGB のバイト順
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FBackCtrl.DeleteAllCtrls;

  FResizeLine := TplGPResizeLine.Create(Self);
  FResizeLine.Parent      := FBackCtrl;
  FResizeLine.InverseDisp := True;
  FResizeLine.PenWidth := 10.0;
  FResizeLine.PenColor := $FF00A0FF;

//  FResizeLine.LineStartPos := Point(250, 50);
//  FResizeLine.LineEndPos   := Point(100, 150);

  FResizeLine.LineType := ltVert;

  SpinEdit1.Value := Trunc(FResizeLine.PenWidth);
  ColorDialog1.Color := ARGBToColorRef(FResizeLine.PenColor);
end;

//=============================================================================
//  線の色を変更
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  if ColorDialog1.Execute then begin
    FResizeLine.PenColor := ColorRefToARGB(ColorDialog1.Color);
  end;
end;

//=============================================================================
//  線の太さを変更
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  FResizeLine.PenWidth := SpinEdit1.Value;
end;

//=============================================================================
//  矢印の描画有無の設定
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if not Assigned(FResizeLine) then exit;

  FResizeLine.StartArrow := CheckBox1.Checked;
  FResizeLine.EndArrow   := CheckBox2.Checked;
  TCheckBox(Sender).Update;
end;

//=============================================================================
//  LineType プロパティの設定
//  水平な直線，垂直な直線，斜めの直線の切り換え，変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LWidth  : Integer;
  LHeight : Integer;
begin
  if not Assigned(FResizeLine) then exit;

  LWidth  := FResizeLine.Width;
  LHeight := FResizeLine.Height;

  if FResizeLine.LineType = ltNormal then begin
    FResizeLine.LineType := ltHorz;
  end else
  if FResizeLine.LineType = ltHorz then begin
    FResizeLine.LineType := ltVert;
    FResizeLine.Width    := LHeight;
    FResizeLine.Height   := LWidth;
  end else
  if FResizeLine.LineType = ltVert then begin
    FResizeLine.LineType := ltNormal;
    FResizeLine.Width    := LHeight;
    FResizeLine.Height   := LWidth;
  end;
end;

end.



03_描画を TBitmap で取得 - コントロールと実描画サイズ


描画中の図形を TBitmap のビットマップ画像として取得するサンプルです．
手順は，画像描画用クラスで説明したのと同じです．GetDPBitmap メソッドで TGPBitamp の画像を取得します．
この直線描画用クラスで描画している図形をビットマップ画像にした場合，そのビットマップのサイズは，ラバーバンドのサイズよりも大きくなることがあります．ラバーバンドの外側に描画されている部分も取得したビットマップに含まれます．


図10
描画内容をビットマップに変換
  • 右の TImage に表示しているのが取得したビットマップ画像

リスト3
描画内容を TBitmap で取得		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Image1: TImage;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FBackCtrl   : TplContainerPanel;
    FResizeLine : TplGPResizeLine;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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

  //背景用のコントロール生成
  FBackCtrl := TplContainerPanel.Create(Self);
  FBackCtrl.Parent := Self;
  FBackCtrl.Align  := alClient;
end;

//=============================================================================
//  [生成]ボタン
//  GDI+ の色は ARGB のバイト順
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Assign(nil);
  FBackCtrl.DeleteAllCtrls;

  FResizeLine := TplGPResizeLine.Create(Self);
  FResizeLine.Parent      := FBackCtrl;
  FResizeLine.InverseDisp := True;
  FResizeLine.PenWidth    := 10.0;
  FResizeLine.PenColor    := aclGreen;
  FResizeLine.StartArrow  := True;
end;

//=============================================================================
//  [TBitmap] ボタン
//  TGPBitmap から TBitmap を作成
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LCtrl     : TplGPResizeLine;
  LGPBitmap : TGPBitmap;
  LBitmap   : TBitmap;
begin
  if FBackCtrl.CtrlList.Count = 0 then exit;

  LCtrl := TplGPResizeLine(FBackCtrl.CtrlList[0]);
  if not (LCtrl is TplGPResizeLine) then Exit;

  // GetGPBitmap メソッドで TGPBitmap を取得
  LGPBitmap := LCtrl.GetGPBitmap;

  LBitmap := TBitmap.Create;
  try
    // TGPBitmap を TBitmap に変換
    LCtrl.GPBitmapToBitmap(LGPBitmap, LBitmap);
    // TImage に表示
    Image1.Picture.Assign(nil);
    Image1.Picture.Bitmap.Assign(LBitmap);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LGPBitmap);
  end;
end;

end.



04_直線描画用クラスのソースコード


矢印付きの直線描画用コントロールクラスのソースコードです．



リスト4
矢印付きの直線描画用コントロールクラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する		 
unit plGPResizeLine;

interface

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

type
  TplLineType = (ltNormal, ltHorz, ltVert);

  TplGPResizeLine = class(TplBaseDragResize)
  private
    FPenWidth     : Single;
    FPenColor     : TGPColor;
    FGPPath       : TGPGraphicsPath;
  　FGPPen        : TGPPen;
    FLineStartPos : TPoint;
    FLineEndPos   : TPoint;
    FArrowWidth   : Single;
    FLineType     : TplLineType;
    FMiddleInset  : Single;
    FArrowHeight  : Single;
    FStartArrow   : Boolean;
    FEndArrow     : Boolean;
    procedure SetFPenColor(const Value: TGPColor);
    procedure SetFPenWidth(const Value: Single);
    procedure SetDrawArrow(const Index: Integer; const Value: Boolean);
    procedure SetFArrowHeight(const Value: Single);
    procedure SetFArrowWidth(const Value: Single);
    procedure SetFLineStartPos(const Value: TPoint);
    procedure SetFLineEndPos(const Value: TPoint);
    procedure SetFLineType(const Value: TplLineType);
    procedure SetFMiddleInset(const Value: Single);
  protected
    FGetFlag : Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  published
    property LineType     : TplLineType read FLineType     write SetFLineType;
    property PenWidth     : Single      read FPenWidth     write SetFPenWidth;
    property PenColor     : TGPColor    read FPenColor     write SetFPenColor;
    property LineStartPos : TPoint      read FLineStartPos write SetFLineStartPos;
    property LineEndPos   : TPoint      read FLineEndPos   write SetFLineEndPos;
    property MiddleInset  : Single      read FMiddleInset  write SetFMiddleInset;
    property ArrowWidth   : Single      read FArrowWidth   write SetFArrowWidth;
    property ArrowHeight  : Single      read FArrowHeight  write SetFArrowHeight;
    property StartArrow   : Boolean  index 0 read FStartArrow write SetDrawArrow;
    property EndArrow     : Boolean  index 1 read FEndArrow   write SetDrawArrow;
  end;

implementation

uses
  Types,
  Math;

{ TplGPResizeLine }

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

  FPenWidth := 3.0;
  FPenColor := aclBlack;

  FLineStartPos := Point(Left, Top);
  FLineEndPos   := Point(Left + Width, Top + Height);
  FLineType     := ltNormal;

  FMiddleInset := 0;
  FArrowWidth  := 3.3;
  FArrowHeight := 4.5;
  FStartArrow  := False;
  FEndArrow    := False;

  // 拡張描画領域を使用する
  UseExtend := True;
end;

//=============================================================================
//  デコンストラクタ処理
//=============================================================================
destructor TplGPResizeLine.Destroy;
begin
  if Assigned(FGPPath) then FreeAndNil(FGPPath);
  if Assigned(FGPPen)  then FreeAndNil(FGPPen);

  inherited;
end;

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

//-----------------------------------------------------------------------------
//  PenWidth プロパティ設定用のメソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFPenWidth(const Value: Single);
begin
  if Value < 1.0 then exit;

  if FPenWidth <> Value then begin
    FPenWidth := Value;

    if FLineType = ltHorz then begin
      if FStartArrow or FEndArrow then begin
        Height := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
      end else begin
        Height := Trunc(FPenWidth) + 3;
      end;
    end else
    if FLineType = ltVert then begin
      if FStartArrow or FEndArrow then begin
        Width := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
      end else begin
        Width := Trunc(FPenWidth) + 3;
      end;
    end;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  LineStartPos プロパティの設定用メソッド
//  描画開始位置を設定
//  この描画コントロールの親であるコンテナコントロール上の位置の設定と同じ
//
//  このプロパティが有効なのは描画コントロールの生成時のみ
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFLineStartPos(const Value: TPoint);
var
  LLeft    : Integer;
  LLTop    : Integer;
  LLWidth  : Integer;
  LLHeight : Integer;
begin
  if Value.X <= 0 then exit;
  if Value.Y <= 0 then exit;

  if (FLineStartPos.X <> Value.X) or (FLineStartPos.Y <> Value.Y) then begin
    FLineStartPos := Value;

    LLeft := FLineStartPos.X;
    LLTop := FLineStartPos.Y;

    FLineType:= ltNormal;

    if FLineEndPos.X = 0 then FLineEndPos.X := FLineStartPos.X + Width;
    if FLineEndPos.Y = 0 then FLineEndPos.Y := FLineStartPos.Y + Height;

    LLWidth  := FLineEndPos.X - FLineStartPos.X;
    LLHeight := FLineEndPos.Y - FLineStartPos.Y;

    SetBounds(LLeft, LLTop, Abs(LLWidth), Abs(LLHeight));
  end;
end;

//-----------------------------------------------------------------------------
//  LineEndPos プロパティの設定用メソッド
//  描画終了位置を設定
//  この描画コントロールの親であるコンテナコントロール上の位置の設定と同じ
//
//  このプロパティが有効なのは描画コントロールの生成時のみ
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFLineEndPos(const Value: TPoint);
var
  LLeft    : Integer;
  LLTop    : Integer;
  LLWidth  : Integer;
  LLHeight : Integer;
begin
  if Value.X <= 0 then exit;
  if Value.Y <= 0 then exit;

  FLineType:= ltNormal;

  if (FLineEndPos.X <> Value.X) or (FLineEndPos.Y <> Value.Y) then begin
    FLineEndPos := Value;

    if FLineStartPos.X = 0 then FLineStartPos.X := FLineEndPos.X - Width;
    if FLineStartPos.Y = 0 then FLineStartPos.Y := FLineEndPos.Y - Height;

    LLeft := FLineStartPos.X;
    LLTop := FLineStartPos.Y;
    LLWidth  := FLineEndPos.X - FLineStartPos.X;
    LLHeight := FLineEndPos.Y - FLineStartPos.Y;

    SetBounds(LLeft, LLTop, Abs(LLWidth), Abs(LLHeight));
  end;
end;

//-----------------------------------------------------------------------------
//  FLineType プロパティの設定用メソッド
//  ltNormal 水平でも垂直でもない直線．斜めの直線
//  ltHorz   水平な直線
//  ltVert   垂直な直線
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFLineType(const Value: TplLineType);
begin
  if FLineType <> Value then begin
    FLineType := Value;
    if FLineType = ltHorz then begin
      if FStartArrow or FEndArrow then begin
        Height := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
      end else begin
        Height := Trunc(FPenWidth) + 3;
      end;
      GrabHorzOnly := True;
    end else
    if FLineType = ltVert then begin
      if FStartArrow or FEndArrow then begin
        Width := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
      end else begin
        Width := Trunc(FPenWidth) + 3;
      end;
      GrabVertOnly := True;
    end else begin
      GrabHorzOnly := False;
      GrabVertOnly := False;
    end;

    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  MiddleInset プロパティ(矢印のインセット)設定用メソッド
//  矢印の三角形の底辺の切り込み深さで線幅の倍数で指定
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFMiddleInset(const Value: Single);
begin
  if FMiddleInset <> Value then begin
    FMiddleInset := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  ArrowHeight プロパティ(矢印の高さ)設定用メソッド
//  矢印の三角形の高さで線幅の倍数で指定
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFArrowHeight(const Value: Single);
begin
  if FArrowHeight <> Value then begin
    FArrowHeight := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  ArrowWidth プロパティ(矢印幅)設定用メソッド
//  矢印の三角形底辺の長さで線幅の倍数で指定
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetFArrowWidth(const Value: Single);
begin
  if FArrowWidth <> Value then begin
    FArrowWidth := Value;

    if FLineType = ltHorz then begin
      Height := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
    end else
    if FLineType = ltVert then begin
      Width := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
    end;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  矢印の表示有無関係プロパティ設定用のメソッド
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.SetDrawArrow(const Index: Integer;
  const Value: Boolean);
begin
  case Index of
  0:
    begin
      if FStartArrow <> Value then begin
        FStartArrow := Value;
      end;
    end;
  1:
    begin
      if FEndArrow <> Value then begin
        FEndArrow := Value;
      end;
    end;
  end;

  if FLineType = ltHorz then begin
    if FStartArrow or FEndArrow then begin
      Height := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
    end else begin
      Height := Trunc(FPenWidth) + 3;
    end;
  end else
  if FLineType = ltVert then begin
    if FStartArrow or FEndArrow then begin
      Width := Max(Trunc(FPenWidth) + 3, Trunc(FPenWidth * FArrowWidth) + 3);
    end else begin
      Width := Trunc(FPenWidth) + 3;
    end;
  end;
    Invalidate;
end;

//-----------------------------------------------------------------------------
//-----------------------------------------------------------------------------
//  実際の描画処理を実行するDrawRoutineメソッド
//  引数のACanvasにこのメソッドの描画コードを実行する
//
//  描画開始位置は(DrawLeft, DrawTop)
//  幅と高さは DrawWidth, DrawHeight
//-----------------------------------------------------------------------------
procedure TplGPResizeLine.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic    : TGPGraphics;
  LTempGPBmp    : TGPBitmap;
  LGPStartArrow : TGPAdjustableArrowCap;
  LGPEndArrow   : TGPAdjustableArrowCap;
  LPenWidth     : Single;
  LStartX       : Integer;
  LStartY       : Integer;
  LEndX         : Integer;
  LEndY         : Integer;
begin
  inherited;

  if (ACanvas = nil) and (AGPBitmap = nil) then Exit;
  if not Assigned(ExtendCtrl) 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;
  //---------------------


  if Assigned(FGPPath) then FreeAndNil(FGPPath);
  if Assigned(FGPPen)  then FreeAndNil(FGPPen);

  FGPPen := TGPPen.Create(FPenColor);
  // 拡大表示の設定
  LPenWidth := FPenWidth * ZoomValue / 100;
  if LPenWidth < 1.0 then LPenWidth := 1.0;
  FGPPen.SetWidth(LPenWidth);

  LGPStartArrow := TGPAdjustableArrowCap.Create(FArrowHeight, FArrowWidth, True);
  LGPEndArrow   := TGPAdjustableArrowCap.Create(FArrowHeight, FArrowWidth, True);
  if FStartArrow then begin
    LGPStartArrow.SetMiddleInset(FMiddleInset);
    FGPPen.SetCustomStartCap(LGPStartArrow);
  end;
  if FEndArrow then begin
    LGPEndArrow.SetMiddleInset(FMiddleInset);
    FGPPen.SetCustomEndCap(LGPEndArrow);
  end;


  if ACanvas = nil then begin
    LGPGraphic := TGPGraphics.Create(LTempGPBmp);
  end else begin
    LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
  end;


  FGPPath := TGPGraphicsPath.Create;
  try
    //--------------------
    //  ここで描画の始点と終点を設定する
    //  AddLineメソッドの最初の引数が描画の始点，次が描画の終点
    //  X 座標値と Y 座標値には AddExtend を必ず加算しておく
    //--------------------

    LStartX := DrawLeft;
    LStartY := DrawTop;
    LEndX   := DrawRight;
    LEndY   := DrawBottom;
    if FLineStartPos.X > FLineEndPos.X then begin
      LStartX := DrawRight;
      LEndX   := DrawLeft;
    end;
    if FLineStartPos.Y > FLineEndPos.Y then begin
      LStartY := DrawBottom;
      LEndY   := DrawTop;
    end;

    if FLineType = ltHorz then begin
      LStartY := (LStartY + LEndY) div 2;
      LEndY   := LStartY;
    end else
    if FLineType = ltVert then begin
      LStartX := (LStartX + LEndX) div 2;
      LEndX   := LStartX;
    end;

    FGPPath.AddLine(MakePoint(LStartX + AddExtend, LStartY + AddExtend),
                    MakePoint(LEndX + AddExtend,   LEndY + AddExtend));

    //--------------------


    if AntiAliasing and (ZoomValue = 100) then begin
      LGPGraphic.SetSmoothingMode(SmoothingModeAntiAlias);
    end;
    LGPGraphic.DrawPath(FGPPen, FGPPath);


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

end.