Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年01月01日] [更新 2013年05月15日] Delphi サンプルプログラム集
   
110_OnMouseMove イベントを使用したコントロールのドラッグ
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
110_ControlDrag2.zip [565 KB] 2013年05月15日版(EXE同梱)



  • 2005年03月27日
  • マウスカーソルをリソースではなく,ファイルから読込む方式に変更
  • 2012年04月11日
  • Delphi XE で動作確認




コントロールの OnMouseMove イベントを使用したドラッグ


ビジュアルなコントロールをマウスでドラッグ・アンド・ドロップするサンプルです.
[100_OnDragOver イベントを使用したコントロールのドラッグ] と同じく,TControl の派生コンポーネントを実行中にマウスでドラッグして移動します.
ドラッグ中のマウスカーソルを,オリジナルなカーソル,リソースとして作成してみました.


図1
設計時画面
  • テスト用に Form に ScrollBox を配置
  • 各 ScrollBar のVisible は False
  • TPanel と TImage を配置
  • TImage には適当な Picture を読込む
図2
実行中の画面
  • マウスの左ボタン Down でドラッグ開始
  • マウスカーソルはファイルから読み込んでいるが,実用的にはリソースに埋め込んだ方がいいだろう

リスト1
OnMouseMove イベントを使用したコントロールのドラッグ移動
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Panel1: TPanel;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    //ドラッグ開始位置のマウス座標
    Xp : Integer;
    Yp : Integer;
    DragFlag : Boolean;
  end;

var
  Form1: TForm1;

implementation

const
  MyCursor = 2;

{$R *.dfm}

//=============================================================================
//  チラツキ防止のためDoubleBufferedを使用
//  最初は当然ドラッグはしていないのでDragFlag := False
//  マウスカーソルを変更してみた
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.DoubleBuffered := True;
  ScrollBox1.HorzScrollBar.Visible := True;
  ScrollBox1.VertScrollBar.Visible := True;

  //スクロールバーのドラッグと同時にスクロールさせる
  ScrollBox1.HorzScrollBar.Tracking := True;
  ScrollBox1.VertScrollBar.Tracking := True;

  DragFlag := False;
  Screen.Cursors[MyCursor] := LoadCursorFromFile('hnwse.cur');
end;

//=============================================================================
//  Image1のOnMouseDownイベント
//  他のコントールのOnMouseDownイベントと共有
//
//  マウス左ボタンクリックならドラッグ開始
//  ドラッグ中のフラグをTrueにする
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    Xp := X;
    Yp := Y;

    DragFlag      := True;
    Screen.Cursor := MyCursor;
  end;
end;

//=============================================================================
//  Image1のOnMouseMoveイベント
//  他のコントールのOnMouseMoveイベントと共有
//
//  マウスの移動に伴なる処理
//  現在のマウス座標に合わせてコントロールの位置を変更
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MouseX : Integer;
  MouseY : Integer;
  Flag   : Boolean;
begin
  if DragFlag then begin
    MouseX := TControl(Sender).Left+X;
    MouseY := TControl(Sender).Top+Y;

    //マウスの座標値が領域範囲内であればドラッグ
    //それ以外はドラッグを解除
    Flag := (MouseX > 0) and (MouseX < ScrollBox1.ClientWidth);
    Flag := Flag and (MouseY > 0) and (MouseY<ScrollBox1.ClientHeight);

    if Flag then begin
      TControl(Sender).Left := TControl(Sender).Left - (Xp - X);
      TControl(Sender).Top  := TControl(Sender).Top  - (Yp - Y);
      ScrollBox1.Update;
    end else begin
      DragFlag      := False;
      Screen.Cursor := crDefault;
    end;
  end;
end;

//=============================================================================
//  Image1のOnMouseUpイベント
//  他のコントールのOnMouseUpイベントと共有
//
//  マウスボタンをUPしたらドラッグ終了
//=============================================================================
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if DragFlag then begin
    DragFlag      := False;
    Screen.Cursor := crDefault;
  end;
end;

end.