Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年08月04日] [更新 2014年04月09日]　Delphi サンプルプログラム集
153_TGraphicControl を移動リサイズ
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
153_ControlMoveResize.zip　[1,297 KB]　2014年04月09日版 (EXE 同梱)



  • 2012年09月12日
  • [157_移動リサイズ可能な TImage ラバーバンドとグラブハンドル] の記事掲載に伴い，移動とリサイズのサンプルを削除
  • 2014年04月09日
  • 移動とリサイズのサンプルを再掲



TGraphicControl を移動リサイズ


TImage 等の TGraphicControl の派生コントロールは，[152_WM_NCHITTEST によるコントロールの移動とリサイズ] のように，WM_NCHITTEST メッセージを使用したドラッグによる移動はできませんが，マウスイベントを使用すれば可能です．
以下は，TGraphicControl と TWinControl のどちらもドラッグによる移動ができるようにしたサンプルです．このサンプルコードであれば，TControl の派生コントロールは全てドラッグによる移動が可能です．

グラフィックコントロールは，BringToFront で，TWinControl の前面(上)には表示できません．この動作を実現するには，[152] の [04_移動リサイズ可能な画像] のサンプルのように，TPanel の上に配置した TGraphicControl に画像を表示することも考えられます．





01_TControl のマウスドラッグによる移動


マウスのドラッグによる移動だけのテストです．OnMouseMove イベント内で，コントロールの位置を変更しているだけです．

同様のサンプルが [110_OnMouseMove イベントを使用したコントロールのドラッグ]にあります．[110] のサンプルは，TScrollBox 上にコントロールを配置しています．また，ドラッグ中にマウスカーソルが親コントロールの外側にも移動してしまいますが，下のコードでは，マウスカーソルの移動をクリップして，親コントロールであるフォームの外側には移動できないようにしています．


図1
設計時画面
  • TImage と TPanel を配置
  • TImage の画像は設計時に読み込んでいる
図2
実行開始画面
図3
TImage をドラッグで移動中

リスト1
TControl のマウスドラッグによる移動 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    DragMoveFlag : Boolean;
    MouseStartY  : Integer;
    MouseStartX  : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Image1のOnMouseDownイベント
//  他のコントールのOnMouseDownイベントと共有
//
//  マウスをDownしたらドラッグ開始
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ARect : TRect;
  DX    : Integer;
begin
  if Button = mbLeft then begin
    DragMoveFlag := True;

    MouseStartX := X;
    MouseStartY := Y;

    //マウスカーソルのクリップ
    //フォームのクライアント領域の外側には移動できない(移動不可)にする
    GetWindowRect(Self.Handle, ARect);
    DX := ((ARect.Right - ARect.Left) - Self.ClientWidth) div 2;
    InflateRect(ARect, -DX, -DX);
    ARect.Top := ARect.Top + ((ARect.Bottom - ARect.Top) - Self.ClientHeight);

    ClipCursor(@ARect);
  end;
end;

//=============================================================================
//  Image1のOnMouseMoveイベント
//  他のコントールのOnMouseMoveイベントと共有
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not DragMoveFlag then exit;

  //コントロールの位置を変更
  TControl(Sender).Left := TControl(Sender).Left + X - MouseStartX;
  TControl(Sender).Top  := TControl(Sender).Top  + Y - MouseStartY;
end;

//=============================================================================
//  Image1のOnMouseUpイベント
//  他のコントールのOnMouseUpイベントと共有
//
//  ドラッグ終了
//=============================================================================
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DragMoveFlag := False;

  //マウスの移動範囲をスクリーン画面サイズに戻す
  ClipCursor(nil);
end;

end.



02_TControl の移動とリサイズ


上のサンプルのように，マウスのイベントを使用すれば TImage 等の TGraphicControl も移動可能になります．
リサイズは，マウスをドラッグして移動する際に，対象のコントロールをリサイズすればいいことになります．そのために，リサイズの開始操作をどの位置で行うかの判定が必要となります．そこで，次のサンプルでは，コントロールの端から一定の範囲内でマウスのドラッグを開始した場合，リサイズ開始とみなすことにしています．

TGraphicControl のリサイズで，ラバーバンドやグラブハンドルを描画したい場合は，コンポーネントにしないと無理があります．サンプル [157] に，TImage を移動リサイズ可能にしたコンポーネントを掲載しています．


図4
設計時画面
  • TImage と TPanel を配置
  • TImage の画像は設計時に読み込み
図5
実行画面
  • TImage をリサイズしているところ

リスト2
TControl の移動とリサイズ．TImage 等の TGraphicControl も移動リサイズ可能		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseLeave(Sender: TObject);
  private
    { Private 宣言 }
    DragMoveFlag : Boolean;
    ResizeFlag   : Byte;
    MouseStartY  : Integer;
    MouseStartX  : Integer;
    OriginLeft   : Integer;
    OriginTop    : Integer;
    OriginWidth  : Integer;
    OriginHeight : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  resfNone   = $00;
  resfLeft   = $01;
  resfTop    = $02;
  resfRight  = $04;
  resfBottom = $08;

//=============================================================================
//  フォーム作成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.DoubleBuffered := True;
end;

//=============================================================================
//  Image1のOnMouseDownイベント
//  他のコントールのOnMouseDownイベントと共有
//
//  マウスをDownしたらドラッグ開始
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ARect : TRect;
  DX    : Integer;
begin
  if Button = mbLeft then begin
    DragMoveFlag := True;

    //現在のマウスカーソルの位置
    //これはParentコントロール内での座標
    MouseStartX := X;
    MouseStartY := Y;

    //コントロールの現在の位置とサイズを退避しておく
    OriginLeft   := TControl(Sender).Left;
    OriginTop    := TControl(Sender).Top;
    OriginWidth  := TControl(Sender).Width;
    OriginHeight := TControl(Sender).Height;

    //マウスカーソルのクリップ
    //フォームのクライアント領域の外側には移動できない(移動不可)にする
    GetWindowRect(Self.Handle, ARect);
    DX := ((ARect.Right - ARect.Left) - Self.ClientWidth) div 2;
    InflateRect(ARect, -DX, -DX);
    ARect.Top := ARect.Top + ((ARect.Bottom - ARect.Top) - Self.ClientHeight);

    ClipCursor(@ARect);
  end;
end;

//=============================================================================
//  Image1のOnMouseMoveイベント
//  他のコントールのOnMouseMoveイベントと共有
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  DetectVal : Integer;
  AControl  : TControl;
  NavValue  : Integer;
  LimitSize : Integer;
begin
  AControl  := TControl(Sender);
  DetectVal := 5;
  LimitSize := 50;

  //まだ移動ドラッグまたはリサイズしていない時
  if not DragMoveFlag then begin
    ResizeFlag := resfNone;

    //マウスカーソルの位置によって移動，リサイズの方向等を決定
    if (X < DetectVal)                   then ResizeFlag := ResizeFlag or resfLeft;
    if (Y < DetectVal)                   then ResizeFlag := ResizeFlag or resfTop;
    if (AControl.Width - X)  < DetectVal then ResizeFlag := ResizeFlag or resfRight;
    if (AControl.Height - Y) < DetectVal then ResizeFlag := ResizeFlag or resfBottom;

    //リサイズの方向によってマウスカーソルを変更する
    if ResizeFlag = resfLeft  or resfTop    then Screen.Cursor := crSizeNWSE;
    if ResizeFlag = resfLeft  or resfBottom then Screen.Cursor := crSizeNESW;
    if ResizeFlag = resfRight or resfTop    then Screen.Cursor := crSizeNESW;
    if ResizeFlag = resfRight or resfBottom then Screen.Cursor := crSizeNWSE;

    if ResizeFlag = resfLeft   then Screen.Cursor := crSizeWE;
    if ResizeFlag = resfRight  then Screen.Cursor := crSizeWE;
    if ResizeFlag = resfTop    then Screen.Cursor := crSizeNS;
    if ResizeFlag = resfBottom then Screen.Cursor := crSizeNS;
    if ResizeFlag = resfNone   then Screen.Cursor := crDefault;
  end;
  if not DragMoveFlag then exit;


  //移動リサイズの方向によって，コントロールの位置とサイズを変更
  //サイズ変更の制限コード付き
  //ResizeFlag = resfNoneは移動だけの場合
  if ResizeFlag = resfNone then begin
    AControl.Left := AControl.Left + X - MouseStartX;
    AControl.Top  := AControl.Top  + Y - MouseStartY;
  end else begin

    //以下，リサイズの処理
    if (ResizeFlag and resfLeft) = resfLeft then begin
      NavValue := OriginWidth - (AControl.Left - OriginLeft);
      if NavValue >= LimitSize then begin
        AControl.Width := NavValue;
        AControl.Left  := AControl.Left + X - MouseStartX;
      end;
    end;

    if (ResizeFlag and resfRight) = resfRight then begin
      if X > LimitSize then begin
        AControl.Width := OriginWidth + (X -MouseStartX);
      end;
    end;

    if (ResizeFlag and resfTop) = resfTop then begin
      NavValue := OriginHeight - (AControl.Top - OriginTop);
      if NavValue >= LimitSize then begin
        AControl.Height := NavValue;
        AControl.Top    := AControl.Top + Y - MouseStartY;
      end;
    end;

    if (ResizeFlag and resfBottom) = resfBottom then begin
      if Y > LimitSize then begin
        AControl.Height := OriginHeight + Y -MouseStartY;
      end;
    end;
  end;
end;

//=============================================================================
//  Image1のOnMouseUpイベント
//  他のコントールのOnMouseUpイベントと共有
//
//  ドラッグまたはリサイズ終了
//=============================================================================
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DragMoveFlag  := False;
  Screen.Cursor := crDefault;

  //マウスの移動範囲をスクリーン画面サイズに戻す
  ClipCursor(nil);
end;

//=============================================================================
//  Image1のOnMouseLeaveイベント
//  他のコントールのOnMouseLeaveイベントと共有
//
//  マウスカーソルがコントロールから離れたら，マウスカーソルをデフォルトの形に
//=============================================================================
procedure TForm1.Image1MouseLeave(Sender: TObject);
begin
  Screen.Cursor := crDefault;
end;

end.