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.