Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年10月18日] [更新 2014年07月09日] 画像・図形の移動リサイズ関係サンプル
   
画像・図形の移動リサイズ関係サンプル
概要
動作確認等 サンプルによって異なる
R000_ResizeControls.zip は,全てのサンプルに必要
R000_ResizeControls.zip [49 KB] 2012年10月18日版







画像・図形の移動リサイズ関係サンプル


画像や図形を移動リサイズするサンプルです.拙作の [コントロール移動リサイズコンポーネント] を使用します.コンポーネントは同梱しています.改めてダウンロードする必要はありません.またインストールする必要はありません.実行時に生成して使用しています.

[コントロール移動リサイズコンポーネント (以下,TplDragResize) は,TImage 等を移動リサイズの対象としています.ここでは,対象のコントロールを,TGraphicControl の派生クラスとし,それを実行時に生成して使用します.それを TplDragResize で移動リサイズします.
つまり,正確には,画像や図形の移動リサイズではなく,コントロールの移動リサイズです.

まず,基本的なプロパティやメソッドを実装したクラスを作成しました.
クラス名を TplResizeBaseControl としています.この基本クラスには,実際の描画用コードはありません.この基本クラスを継承して,画像表示,あるいは直線や円等の図形専用のクラスを作成しています.そして,それらを実行時に生成します.
最も単純な継承クラスの例は,[四角形の描画用クラスのコード] ではないかと思います.このクラスは,コントラクタの Create メソッドと,描画ルーチンの DrawRoutine しか実装していません.継承クラスで必ず必要なのが,DrawRoutine メソッドです.このメソッド内に描画コードを書きます.

ネット上で入手可能な,この種のコンポーネントやアプリケーションには,あらかじめいろいろな図形が用意されているものがありますが,本サンプルにはそのようなものはありません.全て自作することになります.そのための参考コードとなっています.





GDI+ ライブラリ ( gdiplus.zip )


GDI+ を使用するサンプルがあります.GDI+ を使用するには GDI+ の API を使用するためのライブラリが必要です,
以下の記事で確認してください.以下の記事の内容は,この画像・図形の移動リサイズ関係サンプルにも共通する内容となっています.






描画用グラフィックスコントロールの基本クラスの仕様


基本クラスである TplResizeBaseControl で実装したプロパティです.
Font と Text プロパティは TGraphciControl の protected 部では定義されています.

表1 
実装しているプロパティ

DragResize TplDragResize コントロール移動リサイズコンポーネント本体
Selected Boolean この値を True にすると選択状態となり,ラバーバンドとグラブハンドルを表示する
初期状態では False
描画用コントロールをマウス左ボタン押下すると True
PopupMenu TPopupMenu ポップアップメニュー
InverseDisp Boolean 反転表示のフラグ.デフォルトは False
描画図形,画像によっては正常に機能しない場合がある
画像の反転などは,本来反転表示を別コードですべき
PaddingHorz Integer 横方向のコントロールサイズ調整用の値.初期値は 0
PaddingVert Integer 縦方向のコントロールサイズ調整用の値.初期値は 0
Pen TPen 描画用のペンの設定用
Brush TBrush 背景の塗り潰し等に使用する Brush の設定用
DrawRect TRect 読み出し専用
描画領域の TRect レコード型
ラバーバンドの矩形領域
PaddingHorz,PaddingVert が共に 0 の時はコントロールの矩形領域と同じ
DrawLeft Integer 読み出し専用
描画領域の左端 X 座標値.ラバーバンドの左端の値
コントロールの左端値は,PaddingHorz 分だけ左側
PanddingHorz の値が 0 の時はラバーバンドの左端の値と同じ
DrawTop Integer 読み出し専用
描画領域の上端 Y 座標値.ラバーバンドの上端の値
コントロールの上端値は,PaddingVert 分だけ上側
PaddingVert の値が 0 の時はラバーバンドの上端の値と同じ
DrawWidth Integer 読み出し専用
描画領域の幅で,ラバーバンドの幅
コントロールの幅は,PaddingHorz * 2 分だけ大きい
PaddingHorz の値が 0 の時はラバーバンドの幅と同じ
DrawHeight Integer 読み出し専用
描画領域の高さで,ラバーバンドの高さ
コントロールの高さは,PaddingVert * 2 分だけ大きい
PaddingVert の値が 0 の時はラバーバンドの高さと同じ


主なメソッドには以下のものがあります.この他のメソッド類は plResizeControls.pas 内のコードを参考にしてくだい.
イベントの実装はしていません.描画用コントロール類は実行に生成して使用することを前提にして作成しています.イベントの呼出しコードを省略しています.イベントを定義しても実行しません.


DrawRoutine(ACanvas, OffsetX, OffsetY)

継承クラスを作成する時は,継承元のこのメソッドを override して必ず実装します.このメソッド内に描画コードを書きます.
このメソッドが,TGraphicControl の Paint メソッドに相当します.

引数 説明
ACanvas TCanvas 描画対象の Canvas
OffsetX Integer Canvas に描画すると時の左端からのオフセット値
特に指定しなければ 0 となる
OffsetY Integer Canvas に描画すると時の上端からのオフセット値
特に指定しなければ 0 となる


SetRubberBandBounds(ALeft, ATop, AWidth, AHeight)

継承の大元の TControl には SetBounds メソッドがありますが,TplResizeBaseControlで追加したメソッドです.

引数 説明
ALeft Integer ラバーバンド左端の値
ATop Integer ラバーバンド上端の値
AWidth Integer ラバーバンドの幅
AHeight Integer ラバーバンドの高さ




作成したグラフィックスコントロールの基本クラスのコード


作成した移動リサイズコントロールの基本クラスのコードです.

リスト1
plResizeBaseControl.pas のコード
利用には拙作の [コントロール移動リサイズコンポーネント] が必要
unit plResizeBaseControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  plDragResize, Menus, Math, ExtCtrls;

type
  TplResizeBaseControl = class(TGraphicControl)
  private
    FDummy       : Integer;
    FDragResize  : TplDragResize;
    FSelected    : Boolean;
    FInverseDisp : Boolean;
    FPen         : TPen;
    FBrush       : TBrush;
    FPaddingHorz : Integer;
    FPaddingVert : Integer;
    FPopupMenu   : TPopupMenu;
    FDrawRect    : TRect;
    FDrawLeft    : Integer;
    FDrawTop     : Integer;
    FDrawWidth   : Integer;
    FDrawHeight  : Integer;
    procedure SetFPen(const Value: TPen);
    procedure SetFSelected(const Value: Boolean);
    procedure SetFPadding(const Index, Value: Integer);
    procedure SetPopupMenu(const Value: TPopupMenu);
    procedure SetFBrush(const Value: TBrush);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
      OffSetY: Integer=0); virtual;
    procedure PenStyleChanged(Sender: TObject); virtual;
    procedure BrushStyleChanged(Sender: TObject); virtual;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    procedure SetRubberBandBounds(ALeft, ATop, AWidth, AHeight: Integer);
    property DragResize  : TplDragResize   read FDragResize;
    property InverseDisp : Boolean         read FInverseDisp write FInverseDisp;
    property Selected    : Boolean         read FSelected    write SetFSelected;
    property PaddingHorz : Integer index 0 read FPaddingHorz write SetFPadding;
    property PaddingVert : Integer index 1 read FPaddingVert write SetFPadding;
    property DrawRect    : TRect           read FDrawRect;
    property DrawLeft    : Integer         read FDrawLeft;
    property DrawTop     : Integer         read FDrawTop;
    property DrawWidth   : Integer         read FDrawWidth;
    property DrawHeight  : Integer         read FDrawHeight;
  published
    property PopupMenu   : TPopupMenu read FPopupMenu   write SetPopupMenu;
    property Pen         : TPen       read FPen         write SetFPen;
    property Brush       : TBrush     read FBrush       write SetFBrush;
  end;

implementation

uses Types;

type
  TMyRubber = class(TplDragRubberBandShape);

{ TplResizeBaseControl }

//=============================================================================
//  Create処理
//  実際の描画用のビットマップを生成
//  PenプロパティとBrushプロパティの初期値設定
//  PenプロパティとBrushプロパティのOnChangedイベント処理用のメソッドを定義
//=============================================================================
constructor TplResizeBaseControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPaddingHorz    := 0;
  FPaddingVert    := 0;
  Width           := 100;
  Height          := 100;
  ParentColor     := False;

  FDragResize     := TplDragResize.Create(Self);
  FSelected       := False;
  FInverseDisp    := False;

  FPen            := TPen.Create;
  FPen.Width      := 1;
  FPen.Color      := clBlack;
  FPen.Mode       := pmCopy;
  FPen.Style      := psSolid;
  FPen.OnChange   := PenStyleChanged;

  FBrush          := TBrush.Create;
  FBrush.OnChange := BrushStyleChanged;
end;

//=============================================================================
//  Destroy処理
//=============================================================================
destructor TplResizeBaseControl.Destroy;
begin
  if Assigned(FDragResize) then FreeAndNil(FDragResize);
  if Assigned(FBrush)      then FreeAndNil(FBrush);
  if Assigned(FPen)        then FreeAndNil(FPen);

  inherited;
end;

//=============================================================================
//  SetParentメソッド
//  TplDragResizeコンポのターゲットをこのクラスのコンポにし,本コンポを移動リ
//  スサイズ可能なコンポーネントしてしまう
//  本クラスのSelectedプロパティをTrueにするまではラバーバンドとグラブハンドル
//  を表示しない
//=============================================================================
procedure TplResizeBaseControl.SetParent(AParent: TWinControl);
begin
  inherited;
  if not Assigned(AParent) then exit;

  if FDragResize.Target = nil then begin
    FDragResize.Target       := Self;
    FDragResize.Visible      := False;
    FDragResize.Mousethrough := True;
  end;
end;

//=============================================================================
//  ポップアップメニューの設定用メソッド
//  TplDragResizeコンポーネントのPopupMenuに割り当てる
//=============================================================================
procedure TplResizeBaseControl.SetPopupMenu(const Value: TPopupMenu);
begin
  FPopupMenu := Value;
  if Value <> nil then begin
    FDragResize.PopupMenu := Value;
    Value.PopupComponent  := Self;
    Value.ParentBiDiModeChanged(Self);
    Value.FreeNotification(Self);
  end;
end;

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

//=============================================================================
//  SetBoundsメソッド
//  FPaddingHorzとFPaddingVertは,直線描画クラスを使用する時のサイズ調整
//=============================================================================
procedure TplResizeBaseControl.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited;
  if not Assigned(Parent) then exit;

  if FDragResize.DragState = dsNone then begin
    FDragResize.SetBounds(ALeft   + FPaddingHorz,
                          ATop    + FPaddingVert,
                          AWidth  - FPaddingHorz * 2,
                          AHeight - FPaddingVert * 2);
   end;
end;

//=============================================================================
//  SetRubberBandBoundsメソッド
//  ラバーバンドの位置とサイズの値でSetBoundsするメソッド
//=============================================================================
procedure TplResizeBaseControl.SetRubberBandBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  SetBounds(ALeft - FPaddingHorz, ATop - FPaddingVert,
            AWidth + FPaddingHorz * 2, AHeight + FPaddingVert * 2);
end;

//=============================================================================
//  PaddingHorzとPaddingVertプロパティの設定用メソッド
//  TplDragResizeコンポにある同名のプロパティの値も更新しておく
//=============================================================================
procedure TplResizeBaseControl.SetFPadding(const Index, Value: Integer);
var
  RubberLeft   : Integer;
  RubberTop    : Integer;
  RubberWidth  : Integer;
  RubberHeight : Integer;
begin
  if not Assigned(Parent) then exit;

  //現在のラバーバンドの位置とサイズを取得
  RubberLeft   := FDragResize.RubberBandShape.Left;
  RubberTop    := FDragResize.RubberBandShape.Top;
  RubberWidth  := FDragResize.RubberBandShape.Width;
  RubberHeight := FDragResize.RubberBandShape.Height;

  case index of
    0:
    begin
      FPaddingHorz := Value;
      FDragResize.PaddingHorz := FPaddingHorz;
    end;
    1:
    begin
      FPaddingVert := Value;
      FDragResize.PaddingVert := FPaddingVert;
    end;
  end;

  //現在のラバーバンドの位置とサイズに合わせて,このコントロールの位置とサイズ
  //を設定する
  SetRubberBandBounds(RubberLeft, RubberTop, RubberWidth, RubberHeight);
end;

//=============================================================================
//  Selectedプロパティの設定用メソッド
//  ラバーバンドとグラブハンドルを表示する
//  選択状態にすると,ラバーバンドとグラブハンドルが最前面に表示されて,隠れた
//  部分の位置も確認できる
//=============================================================================
procedure TplResizeBaseControl.SetFSelected(const Value: Boolean);
begin
  if FSelected <> Value then begin
    FSelected           := Value;
    FDragResize.Visible := FSelected;
  end;
end;

//=============================================================================
//  Penプロパティの設定用メソッド
//  TPenの各メンバーが変更された時は,PenStyleChangedが実行される
//=============================================================================
procedure TplResizeBaseControl.SetFPen(const Value: TPen);
begin
  FPen.Assign(Value);
end;

//=============================================================================
//  TPenのOnChangeイベント処理
//  TPenの各メンバーのプロパティが変更になった場合に実行される
//=============================================================================
procedure TplResizeBaseControl.PenStyleChanged(Sender: TObject);
begin
  Invalidate;
end;

//=============================================================================
//  Brushプロパティの設定用メソッド
//  TBrushの各メンバーが変更された時は,BrushStyleChangedが実行される
//=============================================================================
procedure TplResizeBaseControl.SetFBrush(const Value: TBrush);
begin
  FBrush.Assign(Value);
end;

//=============================================================================
//  TBrushのOnChangeイベント処理
//  TBrushの各メンバーのプロパティが変更になった場合に実行される
//=============================================================================
procedure TplResizeBaseControl.BrushStyleChanged(Sender: TObject);
begin
  Invalidate;
end;

//=============================================================================
//  MouseDown処理
//  非選択状態の時は,マウス左ボタン押下で選択状態にして移動リサイズ可能にする
//  選択状態にするということは,ラバーバンドとグラブハンドルを表示すること
//
//  [Ctrl]キーが押下されていなければ,既に選択中のこのクラスのコントロールを
//  非選択状態にする(ラバーバンドとグラブハンドルを非表示にする)
//=============================================================================
procedure TplResizeBaseControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  i     : Integer;
  Compo : TControl;
begin
  if FSelected then begin
    TMyRubber(FDragResize.RubberBandShape).MouseDown(Button, Shift, X, Y);
  end else begin
    if Button = mbLeft then begin
      if not (ssCtrl in Shift) then begin
        for i := 0 to Self.Parent.ControlCount - 1 do begin
          Compo := Self.Parent.Controls[i];
          if Compo <> Self then begin
            TplResizeBaseControl(Compo).SetFSelected(False);
          end;
        end;
      end;

      SetFSelected(True);
      //ただちに移動可能なように,マウスのボタンを押したことにする
      SetCaptureControl(Self);
      TMyRubber(FDragResize.RubberBandShape).MouseDown(Button, Shift, X, Y);
    end;
  end;
end;

//=============================================================================
//  MouseMove処理
//=============================================================================
procedure TplResizeBaseControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FSelected then begin
    TMyRubber(FDragResize.RubberBandShape).MouseMove(Shift, X, Y);
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  MouseUp処理
//=============================================================================
procedure TplResizeBaseControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if FSelected then begin
    TMyRubber(FDragResize.RubberBandShape).MouseUp(Button, Shift, X, Y);
  end else begin
    inherited;
  end;
end;

//=============================================================================
//  CM_MOUSELEAVEメッセージ処理
//=============================================================================
procedure TplResizeBaseControl.CMMouseleave(var Message: TMessage);
begin
  if FSelected then begin
    TMyRubber(FDragResize.RubberBandShape).CMMouseleave(Message);
  end else begin
    inherited;
  end;
end;

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

  Canvas.Brush.Style := bsClear;
  DrawRoutine(Canvas);
end;

//=============================================================================
//  実際の描画用の処理
//  引数のACanvasにこのメソッド内の描画コードを実行する
//  実際の描画コードは,派生クラスで継承メソッドを実装して行う
//
//  別のルーチンにしているのは,X, Y 座標を指定する引数があること.この引数は,
//  外部のCanvasに描画する時に使用する
//=============================================================================
procedure TplResizeBaseControl.DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
   OffSetY: Integer=0);
begin
  if InverseDisp then begin
    FDrawLeft   := FDragResize.ResizeRect.Left + OffSetX;
    FDrawTop    := FDragResize.ResizeRect.Top  + OffSetY;
    FDrawWidth  := FDragResize.ResizeRect.Right  - FDragResize.ResizeRect.Left;
    FDrawHeight := FDragResize.ResizeRect.Bottom - FDragResize.ResizeRect.Top;
    FDrawRect   := FDragResize.ResizeRect;
  end else begin
    FDrawLeft   := PaddingHorz  + OffSetX;
    FDrawTop    := PaddingVert  + OffSetY;
    FDrawWidth  := Width  - PaddingHorz * 2;
    FDrawHeight := Height - PaddingVert * 2;
    FDrawRect   := ClientRect;
  end;

  OffsetRect(FDrawRect, OffSetX, OffSetY);
end;

end.




画像や図形類の移動リサイズ手法


描画用コントロールの移動リサイズを構成する方法は,いろいろ考えられます.
同じような図形を扱うのであれば,プロパティの指定で対応したり,描画の手順を記した内容をコードに書いておくとか,ファイルに保存し,描画の際にその手順にしたがって表示する方法も実際のアプリケーションで使用されています.CAD 関係のデータもそうです.

描画手順の内容は,例えば,MoveTo,LineTo とか,Circle等のメソッド名とか,座標値,色や線の太さ等の情報となるでしょう.例えば Visio の描画データは以下のようになっています.
他のアプリケーションで作成した図や画像の利用も考えられます.


リスト2
Visio の描画データの例
"UIT-SymbolFile"
"VersionInfo",1.00
"Name",K282
"Layer",-1
"Scaling",1.0000000000
"StartingPoint",0.0000000000,0.0000000000
"Line",1170.0002441406,-386.0598754882,1170.0002441406,0.0000000000,0,0
"Line",397.8804321289,-386.0598754882,397.8804321289,0.0000000000,0,0
"Line",0.0000000000,-386.0598754882,0.0000000000,0.00000000000,0,0
"Arc",1170.0002441406,0.0000000000,386.0599060058,3.1415925025,4.7123889923,0,0
"Arc",397.8804321289,0.0000000000,386.0599060058,4.7123885154,6.2831850058,0,0
"Arc",0.0000000000,0.0000000000,386.0599060058,4.7123885154,6.2831850051,0,0




サンプルプログラムのダウンロード方法とブロックの解除


各ページの上の方,最初の方に,下図のような画像があります.これをクリックしてください.サンプル単位ではなく,そのページのサンプルの一括ダウンロードとなっています.
各サンプルの個別ダウンロードの要望がありましたが,対応の予定はありません.
ダウンロードしたら [ブロックの解除] をしてください.