Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年09月20日] [更新 2017年09月24日] 画像・図形の移動リサイズ関係サンプル
   
画像・図形の移動リサイズ関係サンプル
R010_描画用移動リサイズコントロールの基本クラス
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
R010_BaseDragResize.zip [1,770 KB] 2017年09月24日版







基本クラスは TGraphicControl の継承クラス


描画用の基本クラスのテストです.クラス名は plBaseDragResize です.
このクラスには,移動とリサイズのためのラバーバンドとグラブハンドルの表示と,移動リサイズの制御のためのコードを実装しています.実際の描画コードはありません.描画コードは,このクラスを継承したクラスで実装します.

画像や図形の描画でよく利用するのは TGraphicControl の派生クラスである TImage コントロールですが,この基本クラスも TGraphicControl の派生クラスです.ただし,TImage のような機能は実装していません.また,コンポーネントとして登録するためのコードはありません.実行時に生成して利用する方式となっています.

もし,同じような描画しかしない場合であればこの基本クラスに描画コードを直接追加することも考えられます.

DispOnly プロパティの値を True にすると,ラバーバンドもグラブハンドルも表示しなくなり,マウスでの移動リサイズができなります.単なる描画用のコントロールとなります.ただし,TImage とは違い,描画は Paint メソッドで行うことになりますが,DrawRoutine メソッドも使用可能です.



下図は,基本クラスのコントロールだけを TPanel に配置して表示した結果です.画像の一部を選択するラバーバンドとしても使用可能です.





図1
描画コードなしで基本クラスのコントロールだけを表示
図2
GrabCornerOnly プロパティの値を True にすると 4 隅のグラブハンドルだけを表示
図3
GrabHorzOnly プロパティが True の場合
図4
GrabVertOnly プロパティが True の場合

リスト1
描画コードがない基本クラスのコントロールを TPanel に表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, plBaseDragResize;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TPanelのDoubleBufferedの値をTrueにしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
  Panel2.Caption := '';

  FDragResize := TplBaseDragResize.Create(Self);
  FDragResize.Parent   := Panel2;
  FDragResize.Selected := True;
  FDragResize.Width    := 130;
  FDragResize.Height   := 130;

  FDragResize.InverseDisp := True;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FDragResize) then FreeAndNil(FDragResize);
end;

//=============================================================================
//  GrabCornerOnlyプロパティの動作確認
//  グラブハンドルを4隅だけにする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Assigned(FDragResize) then begin
    FDragResize.GrabCornerOnly := not FDragResize.GrabCornerOnly;
  end;
end;

//=============================================================================
//  GrabHorzOnlyプロパティの動作確認
//  グラブハンドルを水平方向のリサイズ用だけにする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Assigned(FDragResize) then begin
    FDragResize.GrabHorzOnly := not FDragResize.GrabHorzOnly;
  end;
end;

//=============================================================================
//  GrabVertOnlyプロパティの動作確認
//  グラブハンドルを垂直方向のリサイズ用だけにする
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  if Assigned(FDragResize) then begin
    FDragResize.GrabVertOnly := not FDragResize.GrabVertOnly;
  end;
end;

end.




01_描画用コントロールの基本クラスのプロパティ


基本クラスである plBaseDragResize で実装しているプロパティです.TGraphciControl のプロパティも使用できます.

専用のコンテナ用のコントロールでは,複数の描画コントロールを選択すると,Mousethrough を自動的に Trueにするようにしています.選択する描画コントロールが 1 つになると,全ての描画コントロールの Mousethrough プロパティの値は False になります.
AntiAliasing プロパティは,継承クラスで操作を処理しないと機能しません.



プロパティ 説明
Selected Boolean 描画コントロールの選択用プロパティ
True にするとラバーバンドとグラブハンドルを表示して選択状態となりマウスでの移動リサイズが可能になる
デフォルトは False
InverseDisp Boolean True にすると,リサイズの際,左右,上下を反転した描画を行う
デフォルトは False
MoveOnly Boolean True にするとグラブハンドルを非表示にして移動だけを可能にする
デフォルトは False
DispOnly Boolean True にするとラバーバンドとグラブハンドルが非表示となり,マウスによる移動リサイズは不可となる
マウスイベントは発生する.独自のマウスイベント処理の実装用
デフォルトは False
Mousethrough Boolean True にするとマウスイベントを透過する
デフォルトは False
AntiAliasing Boolean アンチエイリアス処理の有無
実際の処理は継承クラスで実装する
デフォルトの値は True


下表はラバーバンドとリサイズ用のグラブハンドル関係の設定プロパティです.
グラブハンドルは矩形です.一般的にリサイズだけ機能の時はグラブハンドルの形状は矩形で,回転の機能がある時は円が使われています.
GrabCornerOnly, GrabHorz, GrabVertOnly プロパティは,後からの設定が有効となります.


プロパティ 説明
RubberBand TShape ラバーバンドオブジェクト
デフォルトの設定はソースコード参照
GrabBrushColor TColor リサイズ用グラブハンドルの矩形の塗り潰しの色
デフォルトは clWhite
GrabCornerOnly Boolean True にすると 4 隅のグラブハンドルだけを表示する
デフォルトは False
GrabHorzOnly Boolean True に横方向のリサイズ用グラブハンドルだけを表示する
デフォルトは False
GrabVertOnly Boolean True にすると縦方向のリサイズ用グラブハンドルだけを表示する
デフォルトは False




02_描画用コントロールの基本クラスのメソッド


基本クラスである plBaseDragResize で実装しているメソッド類です.TGraphciControl のメソッド類も使用できます.


プロシージャー名 戻り値 説明
DrawRoutine - 描画用のメソッド
引数付きの Paint と機能は同じ
BringToFron - 描画コントロールを Z オーダの最前面に移動する
ラバーバンドとグラブハンドルも操作する必要があるので実装
複数の描画コントロールを使用する際に必要
SendToBack - 描画コントロールを Z オーダの最背面に移動する
実装の意味は上記と同じ
SetBounds - 描画コントロールの SetBountds メソッド
実装の意味は上記と同じ
ResetInverseDisp - このメソッドを実行すると反転描画の状態を解除する




03_継承クラスに実装する描画用メソッド DrawRoutine


描画用の基本クラスには DrawRoutine という描画メソッドを実装しています.このメソッドの機能は引数付きの Paint メソッドと同じです.この継承メソッドを実装した場合,最初の引数 TCanvas は描画コントロール自身の TCanvas です.

TImage では再描画が必要になると自動的に再描画が行われますが,本描画コントロールは TPaintBox と同じ様に,Invalidate メソッドを実行して再描画する必要があります.Invalidate を実行することにより,Paint メソッドが呼び出されて,この DrawRoutine も実行されます.


DrawRoutine(ACanvas, AGPBitmap, AOffsetX, AOffsetY)

引数 説明
ACanvas TCanvas 描画先の TCanas.通常は自分自身の TCanvas
TGPBitmap に描画する時はこの引数の値を nil にする
AGPBitmap TGPBitmap TGPBitmap に描画する時に指定する
TGPBitmap に描画する時は ACanvas の値を nil にする
AOffsetX Integer 描画開始位置の横方向のオフセット
通常は 0
AOffsetY Integer 描画開始位置の盾方向のオフセット
通常は 0


描画用の座標値関係として以下のプロパティを用意しています.これらは描画の上下左右が反転する場合に利用できるようにするために実装しています.必要がなければ使用する必要はありません.
全て読み出し専用のプロパティです.
描画コントロール (ラバーバンド) の親コントロールにおける位置は,Left, Tpp プロパティで取得できます.


プロパティ 説明
DrawRect TRect 描画領域の TRect レコード型
DrawLeft Integer 描画領域の左端 X 座標値.通常は 0
リサイズで左右が反転すると DrawRight の値と入れ替わる
DrawTop Integer 描画領域の上端 Y 座標値.通常は 0
リサイズで上下が反転すると DrawBottom の値と入れ替わる
DrawRight Integer 描画領域の右端 X 座標値.通常は Width と同じ値
リサイズで左右が反転すると DrawLeft の値と入れ替わる
DrawBottom Integer 描画領域の下端 Y 座標値.通常は Height と同じ値
リサイズで上下が反転すると DrawTop の値と入れ替わる
DrawWidth Integer 描画領域の幅で,絶対値は描画コントロールの幅
左右が反転している場合は負の値
DrawHeight Integer 描画領域の高さで,絶対値は描画コントロールの高さ
上下が反転している場合は負の値




04_実際の継承クラスの例と反転描画が可能な条件


図形描画用の継承クラスの作成例です.単に左上から右下に直線を描画するだけです.
TMyDragResize というクラスを作成して,実行時にそのクラスのインスタンスを生成します.描画用の DrawRoutine メソッドを継承したメソッドだけを実装しています.必要であれば色や線の太さの設定用のプロパティなりメソッドを実装することになります.



図5
設計時の画面
図6
EXE 実行開始時
  • 描画コードは継承クラスでの実装
図7
右方向にリサイズして左右反転
図8
描画コントロールは透明
  • 透明部分もマウスで掴んで移動可能

リスト2
図形描画用の継承クラスの簡単な例
unit Unit1;

interface

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

type
  TMyDragResize = class(TplBaseDragResize)
  public
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
    AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ColorDialog1: TColorDialog;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    FDragResize1 : TMyDragResize;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TPanelのDoubleBufferedの値をTrueにしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
  Panel2.Caption := '';
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FDragResize1) then FreeAndNil(FDragResize1);
end;

//=============================================================================
//  移動リサイズの基本クラスのコントロールを生成
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FormDestroy(nil);

  CheckBox1.Checked := True;

  FDragResize1 := TMyDragResize.Create(Self);
  FDragResize1.Parent   := Panel2;
  FDragResize1.Selected := True;
  FDragResize1.Width    := 130;
  FDragResize1.Height   := 130;

  FDragResize1.InverseDisp := True;
end;

//=============================================================================
//  背景色変更
//  コントロールの矩形領域内が透明であることの確認
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if ColorDialog1.Execute then begin
    Panel2.Color := ColorDialog1.Color;
  end;
end;

//=============================================================================
//  マウスではなくコードでコントロールの選択,選択解除を操作
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if Assigned(FDragResize1) then begin
    FDragResize1.Selected := CheckBox1.Checked;
  end;
end;

{ TMyDragResize }

//=============================================================================
//  描画メソッド
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
begin
  inherited;

  with ACanvas do begin
    Pen.Width := 5;
    Pen.Color := clBlue;
    MoveTo(DrawLeft, DrawTop);
    LineTo(DrawRight, DrawBottom);
  end;
end;

end.


上のサンプルプログラムを実行して描画コントロールをリサイズすると,上下左右の反転描画ができることが確認できます.
次のように描画関係の座標値を具体的な数値で指定した場合は,正常に反転描画できません.


図9
反転描画が正常にできない例
図10
元の図形とは違う図形となってしまう

リスト3
反転描画が正常にできないコーディングの例
//=============================================================================
//  描画メソッド
//  反転描画が正常にできないコード
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
begin
  inherited;

  with ACanvas do begin
    Pen.Width := 5;
    Pen.Color := clBlue;
    MoveTo(DrawLeft + 20, DrawTop + 20);
    LineTo(DrawRight - 20, DrawBottom - 20);
  end;
end;


移動リサイズ用の描画コントロールですから,具体的な数値で描画の座標を指定することはあまり考えられません.次のように,この基本クラスで用意した Draw... というプロパティを使用してコーディングすれば,リサイズの時の反転描画を正常に実行することが可能になります.


図11
反転描画が正常に実行できる例
図12
リサイズして上下を反転した状態

リスト4
図形描画で反転描画を正常に実行するためのコーディングの例
//=============================================================================
//  描画メソッド
//  正常に反転表示が可能なコード
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LDx1 : Integer;
  LDy1 : Integer;
  LDx2 : Integer;
  LDy2 : Integer;
begin
  inherited;

  LDx1 := DrawWidth  div 5;
  LDy1 := DrawHeight div 5;
  LDx2 := DrawWidth  div 9;
  LDy2 := DrawHeight div 9;

  with ACanvas do begin
    Pen.Width := 5;
    Pen.Color := clBlue;
    MoveTo(DrawLeft + LDx1, DrawTop + LDy1);
    LineTo(DrawRight - LDx2, DrawBottom - LDy2);
  end;
end;




05_画像を描画する継承クラスの例


画像描画用の継承クラスの作成例です.TMyDragResize というクラスを作成して,実行時にそのクラスのインスタンスを生成します.GDI+ の TGPBitmap の画像描画用のクラスです.

描画用の DrawRoutine メソッドを継承したメソッドだけを実装しています.必要であれば TImage のように,画像ファイルの読み込み用のメソッド等を追加することになります.



図13
TGPBitmap の描画例
  • 描画コードは継承クラスでの実装

リスト5
画像を描画するための継承クラスの簡単な例
unit Unit1;

interface

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

type
  //画像を描画するクラスの例
  TMyDragResize = class(TplBaseDragResize)
  public
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
    AOffsetX: Integer = 0; AOffsetY: Integer = 0); override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ColorDialog1: TColorDialog;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    FDragResize1 : TMyDragResize;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TPanelのDoubleBufferedの値をTrueにしている
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Caption := '';
  Panel2.Caption := '';
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FDragResize1) then FreeAndNil(FDragResize1);
end;

//=============================================================================
//  移動リサイズの基本クラスのコントロールを生成
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  FormDestroy(nil);

  CheckBox1.Checked := True;

  FDragResize1 := TMyDragResize.Create(Self);
  FDragResize1.Parent   := Panel2;
  FDragResize1.Selected := True;

  FDragResize1.InverseDisp := True;
end;

//=============================================================================
//  背景色変更
//  コントロールの矩形領域内が透明であることの確認
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if ColorDialog1.Execute then begin
    Panel2.Color := ColorDialog1.Color;
  end;
end;

//=============================================================================
//  マウスではなくコードでコントロールの選択,選択解除を操作
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if Assigned(FDragResize1) then begin
    FDragResize1.Selected := CheckBox1.Checked;
  end;
end;

{ TMyDragResize }

//=============================================================================
//  描画メソッド
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic : TGPGraphics;
  LGPBitmap  : TGPBitmap;
begin
  inherited;

  LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
  LGPBitmap  := TGPBitmap.Create(ExpandFileName('..\..\Images\502.gif'));

  LGPGraphic.DrawImage(LGPBitmap,
                       MakeRect(DrawLeft, DrawTop, DrawWidth, DrawHeight),
                       0,
                       0,
                       LGPBitmap.GetWidth,
                       LGPBitmap.GetHeight,
                       UnitPixel);

  FreeAndNil(LGPGraphic);
  FreeAndNil(LGPBitmap);
end;

end.


ビットマップ画像を描画する場合は,例えば以下のようなコーディングとなります.
TBitmap の場合,アルファチャンネルの処理を有効にすると反転描画はできません.


リスト6
画像を描画するための継承クラスの実装例.ビットマップ画像を描画
//=============================================================================
//  描画メソッド
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LBimap : TBitmap;
begin
  inherited;

  LBimap := TBitmap.Create;
  try
    //アルファチャンネルの処理を有効にすると反転描画は正常に実行されない
    //LBimap.AlphaFormat := afDefined;
    LBimap.LoadFromFile(ExpandFileName('..\..\Images\503.bmp'));
    ACanvas.StretchDraw(DrawRect, LBimap);
  finally
    FreeAndNil(LBimap);
  end;
end;




06_GDI+ の機能を使用した画像の左右または上下反転


この描画コントロールの基本クラスでは,反転描画を座標値の反転という状態で実現しています.ある意味では反則技ともい言えます.画像処理本来の動作仕様しては,以下のようにするのが本来の方法であると思われます.

この方法で画像の反転処理をした場合は Draw... 等のプロパティは使用しないようにします.



リスト7
GDI+ の RotateFlip メソッドを使用した画像の反転表示の例
//=============================================================================
//  描画メソッド
//  GDI+のRotateFlipメソッドによる画像の回転
//=============================================================================
procedure TMyDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
var
  LGPGraphic : TGPGraphics;
  LGPBitmap  : TGPBitmap;
begin
  inherited;

  LGPGraphic := TGPGraphics.Create(ACanvas.Handle);
  LGPBitmap  := TGPBitmap.Create(ExpandFileName('..\..\Images\502.gif'));

  //左右反転
  if DrawWidth < 0 then begin
    LGPBitmap.RotateFlip(Rotate180FlipY);
  end;
  //上下反転
  if DrawHeight < 0 then begin
    LGPBitmap.RotateFlip(Rotate180FlipX);
  end;
  LGPGraphic.DrawImage(LGPBitmap,
                       MakeRect(0, 0, Width, Height),
                       0,
                       0,
                       LGPBitmap.GetWidth,
                       LGPBitmap.GetHeight,
                       UnitPixel);

  FreeAndNil(LGPGraphic);
  FreeAndNil(LGPBitmap);
end;




07_Paint メソッドによる実装


描画用に DrawRoutine というメソッドを実装していますが,TPaintBox のように,Paint メソッドで描画することもできます.DrawRoutine メソッドの引数を利用する必要がなければどちらのメソッドを使用しても結果は同じです.

リスト8
Paint メソッドを使用する描画
//=============================================================================
//  Paintメソッド
//=============================================================================
procedure TMyDragResize.Paint;
var
  LGPGraphic : TGPGraphics;
  LGPBitmap  : TGPBitmap;
begin
  inherited;

  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPBitmap  := TGPBitmap.Create(ExpandFileName('..\..\Images\502.gif'));

  LGPGraphic.DrawImage(LGPBitmap,
                       MakeRect(DrawLeft, DrawTop, DrawWidth, DrawHeight),
                       0,
                       0,
                       LGPBitmap.GetWidth,
                       LGPBitmap.GetHeight,
                       UnitPixel);

  FreeAndNil(LGPGraphic);
  FreeAndNil(LGPBitmap);
end;




08_描画コントロールの幅と高さの制限値


この描画用コントロールは,幅または高さを 0 または負の値にできないようにしています.0 または負の値に設定しようとする強制的に 1 にします.幅または高さを 0 にすると描画コントロールが選択できなくなります.その対策処理です.

また,添付のコンテナ用コントロールではキー操作でリサイズできるようになっていますが,同じ理由で,1 未満の幅,高さには設定できないようにしています.





09_描画用コントロールの基本クラスのソースコード


描画用コントロールの基本クラスのソースコードです.


リスト9
移動リサイズ可能な描画コントロールの基本クラスのソースコード
このユニットファイルをライブラリのパスが通った場所に置いて使用する
unit plBaseDragResize;

interface

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

const
  WM_CREATED_RESIZECONTROL = WM_APP+10;
type
  TplBaseDragResize = class;

  TplBaseRubberBand = class(TShape)
  protected
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TplBaseGrabHandle = class(TShape)
  protected
    FResizeBase : TplBaseDragResize;
    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;
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TplBaseDragResize = class(TGraphicControl)
  private
    FGrabPoints     : array [0..7] of TPoint;
    FGrabHandle     : array [0..7] of TShape;
    FRubberBand     : TplBaseRubberBand;
    FGrabHandleSize : Integer;
    FGrabBrushColor : TColor;
    FGrabCornerOnly : Boolean;
    FGrabHorzOnly   : Boolean;
    FGrabVertOnly   : Boolean;
    FGrabIndex      : Integer;
    FOperateMouse   : Boolean;
    FIsInSelfRect   : Boolean;
    FCurrentX       : Integer;
    FCurrentY       : Integer;
    FDrawRect       : TRect;
    FDrawLeft       : Integer;
    FDrawTop        : Integer;
    FDrawRight      : Integer;
    FDrawBottom     : Integer;
    FDrawWidth      : Integer;
    FDrawHeight     : Integer;
    FInverseHolz    : Boolean;
    FInverseVert    : Boolean;
    FSelected       : Boolean;
    FMousethrough   : Boolean;
    FMoveOnly       : Boolean;
    FDispOnly       : Boolean;
    FInverseDisp    : Boolean;
    FZoomValue      : Integer;
    FExitMouseEvent : Boolean;
    FAntiAliasing   : Boolean;
    FEnabledUseMsg  : Boolean;
    FParentIsScrBox : Boolean;
    FParentAutoScr  : Boolean;
    procedure SetFSelected(const Value: Boolean);
    procedure SetFMoveOnly(const Value: Boolean);
    procedure SetFAntiAliasing(const Value: Boolean);
    procedure SetFZoomValue(const Value: Integer);
    procedure SetFDispOnly(const Value: Boolean);
    procedure SetFGrabBrushColor(const Value: TColor);
    procedure SetFGrabHandleSize(const Value: Integer);
    procedure SetFGrabCornerOnly(const Value: Boolean);
    procedure SetFGrabHorzOnly(const Value: Boolean);
    procedure SetFGrabVertOnly(const Value: Boolean);
    procedure SetFExitMouseEvent(const Value: Boolean);
  protected
    procedure Paint; override;
    procedure RectToGrabHandlePoints(ARect: TRect);
    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;
    procedure SetParent(AParent: TWinControl); override;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
    procedure SetRubberBandGrabHandlePosSize;
    procedure CMVisiblechanged(var Message: TMessage);
      message CM_VISIBLECHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
    property ZoomValue : Integer read FZoomValue write SetFZoomValue;
    property ExitMouseEvent : Boolean read FExitMouseEvent write SetFExitMouseEvent;
  public
    constructor Create(AOwner: TComponent); override;
    procedure BringToFront(AControl: TGraphicControl = nil);
    procedure SendToBack(AControl: TGraphicControl = nil);
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    procedure ResetInverseDisp;
    procedure DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap = nil;
      AOffsetX: Integer = 0; AOffsetY: Integer = 0); virtual;
    property OnDblClick;
    property PopupMenu;
    property RubberBand     : TplBaseRubberBand read FRubberBand;
    property GrabBrushColor : TColor  read FGrabBrushColor write SetFGrabBrushColor;
    property GrabHandleSize : Integer read FGrabHandleSize write SetFGrabHandleSize;
    property GrabCornerOnly : Boolean read FGrabCornerOnly write SetFGrabCornerOnly;
    property GrabHorzOnly   : Boolean read FGrabHorzOnly   write SetFGrabHorzOnly;
    property GrabVertOnly   : Boolean read FGrabVertOnly   write SetFGrabVertOnly;
    property DrawRect     : TRect   read FDrawRect;
    property DrawLeft     : Integer read FDrawLeft;
    property DrawTop      : Integer read FDrawTop;
    property DrawRight    : Integer read FDrawRight;
    property DrawBottom   : Integer read FDrawBottom;
    property DrawWidth    : Integer read FDrawWidth;
    property DrawHeight   : Integer read FDrawHeight;
    property Selected     : Boolean read FSelected     write SetFSelected;
    property MoveOnly     : Boolean read FMoveOnly     write SetFMoveOnly;
    property DispOnly     : Boolean read FDispOnly     write SetFDispOnly;
    property InverseDisp  : Boolean read FInverseDisp  write FInverseDisp;
    property Mousethrough : Boolean read FMousethrough write FMousethrough;
    property AntiAliasing : Boolean read FAntiAliasing write SetFAntiAliasing;
  end;

implementation

uses
  Types,
  Math;

{ TplBaseDragResize }

type
  TScrollCtrl = class(TScrollBox);

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

  ParentColor := False;
  Canvas.Brush.Style := bsClear;

  Width  := 100;
  Height := 100;

  FOperateMouse := False;

  FEnabledUseMsg  := False;
  FSelected       := False;
  FMousethrough   := False;
  FMoveOnly       := False;
  FDispOnly       := False;
  FInverseDisp    := False;
  FAntiAliasing   := True;
  FParentIsScrBox := False;
  FExitMouseEvent := False;
  FZoomValue      := 100;

  FGrabHandleSize := 8;
  FGrabBrushColor := clWhite;
  FGrabCornerOnly := False;
  FGrabHorzOnly   := False;
  FGrabVertOnly   := False;
  FGrabIndex      := -1;
  FIsInSelfRect   := False;

  FInverseHolz := False;
  FInverseVert := False;

  Self.Cursor := crSizeAll;
end;

//=============================================================================
//  SetParentメソッド処理
//=============================================================================
procedure TplBaseDragResize.SetParent(AParent: TWinControl);
var
  LGrabNo : Integer;
  LShape  : TplBaseGrabHandle;
begin
  inherited;

  if not Assigned(AParent) then exit;
  if Assigned(FRubberBand) then exit;

  //ラバーバンド生成
  FRubberBand := TplBaseRubberBand.Create(Self);
  FRubberBand.Parent      := Parent;
  FRubberBand.Brush.Style := bsClear;
  FRubberBand.Pen.Width   := 1;
  FRubberBand.Pen.Style   := psDot;
  FRubberBand.Visible     := False;

  //グラブハンドルの生成
  //各グラブハンドルのマウスカーソルの設定
  for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
    LShape         := TplBaseGrabHandle.Create(Self);
    LShape.Parent  := Parent;
    LShape.Width   := FGrabHandleSize;
    LShape.Height  := FGrabHandleSize;
    LShape.Visible := False;

    if (LGrabNo = 0) or (LGrabNo = 4) then begin
      LShape.Cursor := crSizeNWSE;
    end else
    if (LGrabNo = 2) or (LGrabNo = 6) then begin
      LShape.Cursor := crSizeNESW;
    end else
    if (LGrabNo = 1) or (LGrabNo = 5) then begin
      LShape.Cursor := crSizeNS;
    end else
    if (LGrabNo = 3)or (LGrabNo = 7)then begin
      LShape.Cursor := crSizeWE;
    end;
    FGrabHandle[LGrabNo] := LShape;
  end;

  FParentIsScrBox := Parent is TScrollBox;
  if FParentIsScrBox then begin
    FParentAutoScr := TScrollCtrl(Parent).AutoScroll;
  end;

  //描画コントロールが使用可能になったことを親に通知する
  if not FEnabledUseMsg then begin
    FEnabledUseMsg := True;
    PostMessage(Parent.Handle, WM_CREATED_RESIZECONTROL, WPARAM(Self), 0);
  end;
end;

//-----------------------------------------------------------------------------
//  CMVisiblechangedメッセージ処理
//  Vislbleプロパティが変更された時に発生するメソッドー
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  //ラバーバンドとグラブハンドルの表示・非表示も変更する
  SetRubberBandGrabHandlePosSize;
end;

//-----------------------------------------------------------------------------
//  GrabBrushColorプロパティの設定用メソッド
//  グラブハンドルの矩形の塗り潰しの色変更
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabBrushColor(const Value: TColor);
var
  LGrabNo : Integer;
begin
  if not Assigned(FRubberBand) then exit;

  if FGrabBrushColor <> Value then begin
    FGrabBrushColor := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Brush.Color := FGrabBrushColor;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabHandleSizeプロパティの設定用メソッド
//  グラブハンドルのサイズの設定
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabHandleSize(const Value: Integer);
var
  LGrabNo : Integer;
begin
  if not Assigned(FRubberBand) then exit;

  if FGrabHandleSize <> Value then begin
    FGrabHandleSize := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Width  := FGrabHandleSize;
      FGrabHandle[LGrabNo].Height := FGrabHandleSize;
    end;
  end;
end;

//=============================================================================
//  DoContextPopupメソッド
//  選択状態でない時はポップアップメニューを表示しない
//=============================================================================
procedure TplBaseDragResize.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  LPos : TPoint;
begin
  inherited;
  if not Assigned(PopupMenu) then exit;

  PopupMenu.AutoPopup := False;
  if FSelected then begin
    LPos := ClientToScreen(MousePos);
    PopupMenu.Popup(LPos.X, LPos.Y);
  end else begin
    Handled := True;
  end;
end;

//-----------------------------------------------------------------------------
//  Selectedプロパティの設定メソッド
//  選択・選択解除のプロパティ
//  Trueにするとラバーバンドとグラブハンドルを表示する
//  Falseにするとそれらを非表示にする
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFSelected(const Value: Boolean);
begin
  if FSelected <> Value then begin
    FSelected := Value;
    if (FSelected = False) or FDispOnly then begin
      FGrabIndex    := -1;
      FIsInSelfRect := False;
    end;
    SetRubberBandGrabHandlePosSize;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  MoveOnlyプロパティの設定用メソッド
//  Trueにするとグラブハンドルを表示しない
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFMoveOnly(const Value: Boolean);
var
  LGrabNo : Integer;
begin
  if FMoveOnly <> Value then begin
    FMoveOnly := Value;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Visible := not FMoveOnly;
    end;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  DispOnlyプロパティの設定用メソッド
//  Trueにすると選択できなくなり表示専用となる
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFDispOnly(const Value: Boolean);
begin
  if FDispOnly <> Value then begin
    FDispOnly := Value;
    if FDispOnly then begin
      SetFSelected(False);
      Self.Cursor := crDefault;
    end else begin
      Self.Cursor := crSizeAll;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabCornerOnlyプロパティの設定用メソッド
//  4隅のグラブハンドルだけを表示する
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabCornerOnly(const Value: Boolean);
begin
  if FGrabCornerOnly <> Value then begin
    FGrabCornerOnly := Value;

    FGrabHorzOnly := False;
    FGrabVertOnly := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabHorzOnlyプロパティの設定用メソッド
//  水平方向リサイズ用の左右2つだけを表示
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabHorzOnly(const Value: Boolean);
begin
  if FGrabHorzOnly <> Value then begin
    FGrabHorzOnly := Value;

    FGrabCornerOnly := False;
    FGrabVertOnly   := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  GrabVertOnlyプロパティの設定用メソッド
//  垂直方向リサイズ用の上下2つだけを表示
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFGrabVertOnly(const Value: Boolean);
begin
  if FGrabVertOnly <> Value then begin
    FGrabVertOnly := Value;

    FGrabCornerOnly := False;
    FGrabHorzOnly   := False;
    SetRubberBandGrabHandlePosSize;
  end;
end;

//-----------------------------------------------------------------------------
//  AntiAliasingプロパティの設定用メソッド
//  アンチエイリアシング処理の設定
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFAntiAliasing(const Value: Boolean);
begin
  if FAntiAliasing <> Value then begin
    FAntiAliasing := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  ExitMouseEventプロパティの設定用メソッド
//  継承クラスでのマウスイベントの実装用
//  コンテナコントロールからの設定用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFExitMouseEvent(const Value: Boolean);
begin
  if FExitMouseEvent <> Value then begin
    FExitMouseEvent := Value;
  end;
end;

//-----------------------------------------------------------------------------
//  ZoomValueプロパティの設定用メソッド
//  拡大・縮小表示の値の設定
//  本描画コントロールには実際の拡大・縮小表示の機能はない
//  コンテナ用コントロールからの操作用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetFZoomValue(const Value: Integer);
begin
  if FZoomValue <> Value then begin
    FZoomValue := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  最前面に移動
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.BringToFront(AControl: TGraphicControl);
var
  LGrabNo : Integer;
begin
  TControl(Self).BringToFront;
  if AControl <> nil then begin
    AControl.BringToFront;
  end;
  FRubberBand.BringToFront;
  for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
    FGrabHandle[LGrabNo].BringToFront;
    Application.ProcessMessages;
  end;
end;

//-----------------------------------------------------------------------------
//  最背面に移動
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SendToBack(AControl: TGraphicControl = nil);
var
  LGrabNo : Integer;
begin
  for LGrabNo := Length(FGrabHandle) - 1 downto 0 do begin
    FGrabHandle[LGrabNo].SendToBack;
    Application.ProcessMessages;
  end;
  if AControl <> nil then begin
    AControl.SendToBack;
  end;
  FRubberBand.SendToBack;
  TControl(Self).SendToBack;
end;

//=============================================================================
//  MouseDownメソッド
//  非選択状態の時は,マウス左ボタン押下で選択状態にして移動リサイズ可能にする
//  選択状態にするということは,ラバーバンドとグラブハンドルを表示すること
//
//  [Ctrl]キーが押下されていなければ,既に選択中のこのクラスのコントロールを
//  非選択状態にする(ラバーバンドとグラブハンドルを非表示にする)
//=============================================================================
procedure TplBaseDragResize.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPosInParent : TPoint;
  LSelfRect    : TRect;
  LClipRect    : TRect;
  LControl     : TControl;
  LControlNo   : Integer;
  LParentForm  : TCustomForm;
begin
  inherited;
  if FDispOnly then exit;
  if FExitMouseEvent then exit;
  if Button <> mbLeft then exit;


  FOperateMouse := True;

  //キーによる操作を可能にする
  //親フォーム検出のこの方法は簡便法
  LParentForm := GetParentForm(Self);
  if LParentForm <> nil then begin
    LParentForm.ActiveControl := Parent;
  end;

  FOperateMouse := True;

  //-1の時はグラブハンドルが選択されていない状態
  FGrabIndex := -1;
  //マウスカーソルがグラブハンドル内にあるか調査
  if not FMoveOnly then begin
    for LControlNo := 0 to Length(FGrabPoints) - 1 do begin
      if FGrabHandle[LControlNo].Visible then begin
        if PtInRect(Bounds(FGrabPoints[LControlNo].X - 1,
                           FGrabPoints[LControlNo].Y - 1,
                           (FGrabHandleSize + 1) * 2,
                           (FGrabHandleSize + 1) * 2),
                           Point(X, Y)) then begin
          FCurrentX  := X;
          FCurrentY  := Y;
          FGrabIndex := LControlNo;
          Break;
        end;
      end;
    end;
  end;

  //マウスカーソルがグラブハンドル内でなければ本コントロール内かを調査
  LPosInParent := Self.ClientToParent(Point(X, Y));
  if FGrabIndex = -1 then begin
    LSelfRect := Bounds(Left, Top, Width, Height);
    FIsInSelfRect := PtInRect(LSelfRect, LPosInParent);
    if FIsInSelfRect then begin
      FCurrentX := LPosInParent.X;
      FCurrentY := LPosInParent.Y;
    end;
  end;

  FSelected := ((FGrabIndex >= 0) or FIsInSelfRect) and not FDispOnly;
  if FSelected then begin
    //[Ctrl]押下時は複数選択可能とするので選択は解除しない
    //複数選択時はマウス透過とし移動は親コントロールのマウスイベントで行う
    if (ssCtrl in Shift) then begin
      for LControlNo := 0 to Parent.ControlCount - 1 do begin
        LControl := Parent.Controls[LControlNo];
        if LControl Is TplBaseDragResize then begin
          if (LControl <> Self) then begin
            //1つでも既に選択状態のコントロールがある場合
            if TplBaseDragResize(LControl).Selected then begin
              TplBaseDragResize(LControl).Mousethrough := True;
              FMousethrough := True;
              break;
            end;
          end;
        end;
      end;
    end else begin
      //自分自身以外の選択を解除
      //選択状態になったらマウスの移動範囲をこの親コントロール内とする
      for LControlNo := 0 to Parent.ControlCount - 1 do begin
        LControl := Parent.Controls[LControlNo];
        if LControl Is TplBaseDragResize then begin
          TplBaseDragResize(LControl).Mousethrough := False;
          if (LControl <> Self) then begin
            TplBaseDragResize(LControl).SetFSelected(False);
          end;
        end;
      end;
      Invalidate;

      LClipRect := Parent.ClientRect;
      LClipRect.TopLeft     := Parent.ClientToScreen(LClipRect.TopLeft);
      LClipRect.BottomRight := Parent.ClientToScreen(LClipRect.BottomRight);
      ClipCursor(@LClipRect);
    end;
  end;
end;

//=============================================================================
//  MouseMoveメソッド
//=============================================================================
procedure TplBaseDragResize.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LSelfRect     : TRect;
  LPosInParent  : TPoint;
  LWidth        : Integer;
  LHeight       : Integer;
  LIncX         : Integer;
  LIncY         : Integer;
  LHorzScrPos   : Integer;
  LVertScrPos   : Integer;
  LHorzScrRange : Integer;
  LVertScrRange : Integer;
begin
  inherited;

  LSelfRect := Bounds(Left, Top, Width, Height);

  if FExitMouseEvent then exit;
  if FDispOnly then exit;

  //マウスカーソルはグラブハンドル内にない
  if FGrabIndex = -1 then begin

    //オブジェクトの矩形内にある場合
    if FIsInSelfRect then begin
      LPosInParent := ClientToParent(Point(X, Y));

      LIncX := LPosInParent.X - FCurrentX;
      LIncY := LPosInParent.Y - FCurrentY;

      //親がTScrollBoxの時の処理
      //最下端から上方向への移動と最右端から左方向に移動する場合
      //この処理をしないと移動できない
      if FParentIsScrBox and FSelected then begin
        LHorzScrPos   := TScrollCtrl(Parent).HorzScrollBar.Position;
        LVertScrPos   := TScrollCtrl(Parent).VertScrollBar.Position;
        LHorzScrRange := TScrollCtrl(Parent).HorzScrollBar.Range;
        LVertScrRange := TScrollCtrl(Parent).VertScrollBar.Range;


        if (LIncY < 0) and (LVertScrPos > 0) then begin
          if ((Top + Height+ FGrabHandleSize) >= Parent.ClientHeight) then begin
            TScrollCtrl(Parent).VertScrollBar.Range := LVertScrRange - LIncY;
          end;
          if (Top <= 0) then begin
            TScrollCtrl(Parent).VertScrollBar.Position := LVertScrPos + LIncY;
          end;
        end;
        if (LIncX <= 0) and (LHorzScrPos > 0) then begin
          if ((Left + Width + FGrabHandleSize) >= Parent.ClientWidth) then begin
            TScrollCtrl(Parent).HorzScrollBar.Range := LHorzScrRange - LIncX;
          end;
          if (Left <= 0) then begin
            TScrollCtrl(Parent).HorzScrollBar.Position := LHorzScrPos + LIncX;
          end;
        end;
      end;

      SetBounds(Left + LIncX, Top + LIncY, Width, Height);

      FCurrentX := LPosInParent.X;
      FCurrentY := LPosInParent.Y;
    end else begin
      exit;
    end;
  end else begin
    //マウスカーソルがグラブハンドル内にある場合
    case FGrabIndex of
      0:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
        Inc(LSelfRect.Top,  Y - FCurrentY);
       end;
      1:
      begin
        Inc(LSelfRect.Top, Y - FCurrentY);
      end;
      2:
      begin
        Inc(LSelfRect.Right,  X - FCurrentX);
        Inc(LSelfRect.Top, Y - FCurrentY);
      end;
      3:
      begin
        Inc(LSelfRect.Right, X - FCurrentX);
      end;
      4:
      begin
        Inc(LSelfRect.Right, X - FCurrentX);
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      5:
      begin
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      6:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
        Inc(LSelfRect.Bottom, Y - FCurrentY);
      end;
      7:
      begin
        Inc(LSelfRect.Left, X - FCurrentX);
      end;
    end;

    LWidth  := LSelfRect.Right  - LSelfRect.Left;
    LHeight := LSelfRect.Bottom - LSelfRect.Top;
    SetBounds(LSelfRect.Left, LSelfRect.Top, LWidth, LHeight);

    FCurrentX := X;
    FCurrentY := Y;
  end;
end;

//=============================================================================
//  MouseUpメソッド
//
//  以下の処理
//  マウスカーソル移動範囲の制限を解除
//  グラブハンドルはどれも掴んでいないことにする
//  オブジェクトの矩形内も掴んでいないことにする
//=============================================================================
procedure TplBaseDragResize.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LLeft       : Integer;
  LTop        : Integer;
  LWidth      : Integer;
  LHeight     : Integer;
  LZoomValue  : Integer;
  LHorzRange  : Integer;
  LVertRange  : Integer;
  LControlNo  : Integer;
  LControl    : TControl;
  LCtrl       : TplBaseDragResize;
  LHorzScrPos : Integer;
  LVertScrPos : Integer;
begin
  inherited;
  if FExitMouseEvent then exit;
  if FDispOnly then exit;


  LZoomValue := FZoomValue div 100;
  if LZoomValue = 0 then LZoomValue := 1;


  //マウスカーソルはグラブハンドル内にない
  if FGrabIndex = -1 then begin
    //オブジェクトの矩形内にある場合
    if FIsInSelfRect then begin
      LLeft := Left div LZoomValue * LZoomValue;
      LTop  := Top  div LZoomValue * LZoomValue;
      SetBounds(LLeft, LTop, Width, Height);
    end;

    //親のTScrollBoxのサイズを調整
    //最下端から上方向への移動と最右端から左方向に移動した場合に必要
    if FParentIsScrBox then begin
      LHorzScrPos := TScrollCtrl(Parent).HorzScrollBar.Position;
      LVertScrPos := TScrollCtrl(Parent).VertScrollBar.Position;

      if (LHorzScrPos > 0) or (LVertScrPos > 0) then begin
        LHorzRange := 0;
        LVertRange := 0;
        for LControlNo := 0 to Parent.ControlCount - 1 do begin
          LControl := Parent.Controls[LControlNo];
          if LControl Is TplBaseDragResize then begin
            LCtrl := TplBaseDragResize(LControl);
            LHorzRange := Max(LHorzRange, LHorzScrPos + LCtrl.Left + LCtrl.Width);
            LVertRange := Max(LVertRange, LVertScrPos + LCtrl.Top + LCtrl.Height);
          end;
        end;
        TScrollCtrl(Parent).HorzScrollBar.Range := LHorzRange;
        TScrollCtrl(Parent).VertScrollBar.Range := LVertRange;
      end;
      if FParentIsScrBox then begin
        TScrollCtrl(Parent).AutoScroll := FParentAutoScr;
      end;
    end;
  end else begin
    //マウスカーソルがグラブハンドル内にある場合
    LLeft   := Left   div LZoomValue * LZoomValue;
    LTop    := Top    div LZoomValue * LZoomValue;

    //幅や高さを0にしてしまうとマウスで選択できなくなるのでその対策
    LWidth  := Width;
    LHeight := Height;
    LWidth  := Max(LZoomValue, LWidth  div LZoomValue * LZoomValue);
    LHeight := Max(LZoomValue, LHeight div LZoomValue * LZoomValue);
    SetBounds(LLeft, LTop, LWidth, LHeight);
  end;

  //ズームとTScrollBox関係の処理がなければ以下のコードだけでよい
  ClipCursor(nil);
  FGrabIndex    := -1;
  FIsInSelfRect := False;

  FOperateMouse := False;
end;

//=============================================================================
//  WM_LBUTTONDBLCLKメッセージ処理
//  外部からOnDblclickイベントを定義して使用する場合の対応策
//  マウスボタンUPと同じ処理をして描画コントロールを掴んでいない状態にする
//=============================================================================
procedure TplBaseDragResize.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  if FExitMouseEvent then exit;

  if Assigned(OnDblClick) then begin
    ClipCursor(nil);
    FGrabIndex    := -1;
    FIsInSelfRect := False;

    FOperateMouse := False;
  end;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  FMousethroughはマウス透過のプロパティ
//=============================================================================
procedure TplBaseDragResize.CMHitTest(var Message: TCMHitTest);
begin
  if (FMousethrough) or (FExitMouseEvent) then begin
    Message.Result := HTNOWHERE;
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  描画コントロール(自分自身)の位置,サイズが変更になった場合
//  ラバーバンドとグラブハンドルも再描画
//=============================================================================
procedure TplBaseDragResize.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  if not Assigned(Parent) then exit;

  if (Top < Parent.ClientHeight) or ((Top + Height) > 0)
    or ((Left + Width) < 0) or (Left > Parent.ClientWidth) then begin
    SetRubberBandGrabHandlePosSize;
  end;

  if not FOperateMouse then begin
    if (AWidth <= 0) or (AHeight <= 0) then begin
      AWidth  := Max(AWidth, 1);
      AHeight := Max(AHeight, 1);
      SetBounds(ALeft, ATop, AWidth, AHeight);
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ラバーバンドとグラブハンドルを指定サイズと位置に描画
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.SetRubberBandGrabHandlePosSize;
var
  LGrabNo : Integer;
begin
  if not FSelected then begin
    FRubberBand.Visible := False;
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Visible := False;
    end;
    exit;
  end;

  //ラバーバンド
  FRubberBand.SetBounds(Left, Top, Width, Height);
  FRubberBand.Visible := Visible and not FDispOnly;

  //グラブハンドル
  if not FMoveOnly then begin
    RectToGrabHandlePoints(Bounds(Left, Top, Width, Height));
    for LGrabNo := 0 to Length(FGrabHandle) - 1 do begin
      FGrabHandle[LGrabNo].Left    := FGrabPoints[LGrabNo].X;
      FGrabHandle[LGrabNo].Top     := FGrabPoints[LGrabNo].Y;
      FGrabHandle[LGrabNo].Visible := Visible and not FDispOnly;
    end;

    if Visible and not FDispOnly then begin
      if FGrabCornerOnly then begin
        FGrabHandle[1].Visible := False;
        FGrabHandle[3].Visible := False;
        FGrabHandle[5].Visible := False;
        FGrabHandle[7].Visible := False;
      end else
      if FGrabHorzOnly then begin
        FGrabHandle[0].Visible := False;
        FGrabHandle[1].Visible := False;
        FGrabHandle[2].Visible := False;
        FGrabHandle[4].Visible := False;
        FGrabHandle[5].Visible := False;
        FGrabHandle[6].Visible := False;

        FGrabHandle[3].Invalidate;
        FGrabHandle[7].Invalidate;
      end else
      if FGrabVertOnly then begin
        FGrabHandle[0].Visible := False;
        FGrabHandle[2].Visible := False;
        FGrabHandle[3].Visible := False;
        FGrabHandle[4].Visible := False;
        FGrabHandle[6].Visible := False;
        FGrabHandle[7].Visible := False;

        FGrabHandle[1].Invalidate;
        FGrabHandle[5].Invalidate;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  グラブハンドルの表示座標を計算
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.RectToGrabHandlePoints(ARect: TRect);
var
  LHalfW : Integer;
  LLeft  : Integer;
  LTop   : Integer;
begin
  LHalfW := FGrabHandleSize div 2;
  LLeft  := ARect.Left + (ARect.Right - ARect.Left) div 2;
  LTop   := ARect.Top + (ARect.Bottom - ARect.Top) div 2;

  FGrabPoints[0] := Point(ARect.Left - LHalfW,  ARect.Top - LHalfW);
  FGrabPoints[1] := Point(LLeft - LHalfW,       ARect.Top - LHalfW);
  FGrabPoints[2] := Point(ARect.Right - LHalfW, ARect.Top - LHalfW);
  FGrabPoints[3] := Point(ARect.Right - LHalfW, LTop - LHalfW);
  FGrabPoints[4] := Point(ARect.Right - LHalfW, ARect.Bottom - LHalfW);
  FGrabPoints[5] := Point(LLeft - LHalfW,       ARect.Bottom - LHalfW);
  FGrabPoints[6] := Point(ARect.Left - LHalfW,  ARect.Bottom - LHalfW);
  FGrabPoints[7] := Point(ARect.Left - LHalfW,  LTop - LHalfW);
end;

//=============================================================================
//  Paintメソッド処理
//  実際の描画処理は継承クラスのDrawRoutineメソッドで行う
//=============================================================================
procedure TplBaseDragResize.Paint;
begin
  inherited;
  if not Assigned(Parent) then exit;

  //幅や高さが負になった場合の処理
  if Width < 0 then begin
    FInverseHolz := not FInverseHolz;
    Width := Abs(Width);
    Left  := Left - Width;
    if FSelected then begin
      case FGrabIndex of
        0: FGrabIndex := 2;
        7: FGrabIndex := 3;
        6: FGrabIndex := 4;
        2: FGrabIndex := 0;
        3: FGrabIndex := 7;
        4: FGrabIndex := 6;
      end;
    end;
  end;
  if Height < 0 then begin
    FInverseVert := not FInverseVert;
    Height := Abs(Height);
    Top    := Top - Abs(Height);
    if FSelected then begin
      case FGrabIndex of
        0: FGrabIndex := 6;
        1: FGrabIndex := 5;
        2: FGrabIndex := 4;
        4: FGrabIndex := 2;
        5: FGrabIndex := 1;
        6: FGrabIndex := 0;
      end;
    end;
  end;


  //ラバーバンドとグラブハンドルの描画
  SetRubberBandGrabHandlePosSize;

  //描画ルーチンの実行
  DrawRoutine(Canvas);
end;

//-----------------------------------------------------------------------------
//  実際の描画用の処理
//  引数のACanvasにこのメソッド内の描画コードを実行する
//  実際の描画コードは派生クラスに継承メソッドを実装して行う
//
//  描画開始位置は常に(FDrawLeft, FDrawTop)
//  反転した描画が不要なら Rect(0, 0, Widht, Heidht) 内の描画でよい
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.DrawRoutine(ACanvas: TCanvas; AGPBitmap: TGPBitmap;
  AOffsetX: Integer; AOffsetY: Integer);
begin
  if (ACanvas = nil) and (AGPBitmap = nil) then exit;

  //上下左右が反転の時
  if FInverseDisp and FInverseHolz and FInverseVert then begin
    //左右のX座標値(Left,Right)を交換する
    //上下のY座標値(Top,Bottom)を交換する
    FDrawLeft   := ClientRect.Right + AOffsetX;
    FDrawTop    := ClientRect.Bottom + AOffsetY;
    FDrawRight  := ClientRect.Left + AOffsetX;
    FDrawBottom := ClientRect.Top + AOffsetY;
    FDrawWidth  := -Width;
    FDrawHeight := -Height;
  end else
  //左右が反転の時
  if FInverseDisp and FInverseHolz then begin
    //左右のX座標値(Left,Right)を交換する
    FDrawLeft   := ClientRect.Right + AOffsetX;
    FDrawTop    := ClientRect.Top + AOffsetY;
    FDrawRight  := ClientRect.Left + AOffsetX;
    FDrawBottom := ClientRect.Bottom + AOffsetY;
    FDrawWidth  := -Width;
    FDrawHeight := Height;
  end else
  //上下が反転の時
  if FInverseDisp and FInverseVert then begin
    //上下のY座標値(Top,Bottom)を交換する
    FDrawLeft   := ClientRect.Left + AOffsetX;
    FDrawTop    := ClientRect.Bottom + AOffsetY;
    FDrawRight  := ClientRect.Right + AOffsetX;
    FDrawBottom := ClientRect.Top + AOffsetY;
    FDrawWidth  := Width;
    FDrawHeight := -Height;
  end else begin
    FDrawLeft   := ClientRect.Left + AOffsetX;
    FDrawTop    := ClientRect.Top + AOffsetY;
    FDrawRight  := ClientRect.Right + AOffsetX;
    FDrawBottom := ClientRect.Bottom + AOffsetY;
    FDrawWidth  := Width;
    FDrawHeight := Height;
  end;
  FDrawRect := Bounds(FDrawLeft, FDrawTop, FDrawWidth, FDrawHeight);
end;

//-----------------------------------------------------------------------------
//  FDraw関係の値を元に戻す
//  以下の値をFalseにすれば描画の際に反転状態を元に戻すことができる
//  外部からTGPBitmapを取得した場合反転した状態の画像となる
//  それを編集してこの描画コントロールで表示すると反転してしまう
//  その対策用
//-----------------------------------------------------------------------------
procedure TplBaseDragResize.ResetInverseDisp;
begin
  FInverseHolz := False;
  FInverseVert := False;
end;

{ TplBaseGrabHandle }

//=============================================================================
//  グラブハンドルクラスのコンストラクタ
//  基本的な設定のみ
//=============================================================================
constructor TplBaseGrabHandle.Create(AOwner: TComponent);
begin
  inherited;
  FResizeBase := TplBaseDragResize(AOwner);

  Brush.Style := bsSolid;
  Brush.Color := clWhite;
  Pen.Color   := clBlack;
  Pen.Width   := 2;
  Pen.Style   := psSolid;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  TplBaseDragResizeがマウス透過時はグラブハンドルもマウスイベント透過とする
//=============================================================================
procedure TplBaseGrabHandle.CMHitTest(var Message: TCMHitTest);
begin
  if(FResizeBase.Mousethrough) or (FResizeBase.FExitMouseEvent) then begin
    Message.Result := HTNOWHERE;
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  MouseDownメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseDown(Button, Shift, LPos.X, LPos.Y);
  end;
end;

//=============================================================================
//  MouseMoveメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseMove(Shift, LPos.X, LPos.Y);
  end;
end;

//=============================================================================
//  MouseUpメソッド処理
// TplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseGrabHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LPos : TPoint;
begin
  inherited;
  if FResizeBase.Selected then begin
    LPos := ClientToParent(Point(X, Y));
    FResizeBase.MouseUp(Button, Shift, LPos.X, LPos.Y);
  end;
end;

{ TplBaseRubberBand }

//=============================================================================
//  ラバーバンドクラスのコンストラクタ
//  基本的な設定のみ
//=============================================================================
constructor TplBaseRubberBand.Create(AOwner: TComponent);
begin
  inherited;

  Brush.Style := bsClear;
  Pen.Color   := clBlack;
  Pen.Width   := 1;
  Pen.Style   := psDot;
end;

//=============================================================================
//  CM_HITTESTメッセージ処理
//  マウスイベントは全て透過
//  マウスイベントは全てTplBaseDragResizeで処理する
//=============================================================================
procedure TplBaseRubberBand.CMHitTest(var Message: TCMHitTest);
begin
  Message.Result := HTNOWHERE;
end;

end.