SC_MOVE？について (ID:151167)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

TImage をドラッグして、かつ移動方向を制限するプログラムを作成してみました。
また、TImageをドラッグしている時に下のコンポーネントも参照できる様にしました。

サンプルでは、6つの TImage があり、試す時はそれぞれ異なるイメージを格納して下さい。

[CTRL]キーを押しながらイメージをドラッグすると、上下のみの移動で、
[ALT]キーを押しながらイメージをドラッグすると、左右のみの移動となります。
別なイメージの上でドロップすると、ドラッグしていたTImageの画像がコピーされます。

Form1 の DoubleBufferedプロパティが重要で、ドラッグ中のチラツキを抑制してくれます。
Captionに格納される文字は確認用です。

「VCLコード」

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls,
  System.Types;

type
  TForm1 = class(TForm)
    Image1, Image2, Image3, Image4, Image5, Image6: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ImageDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure ImageDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ImageEndDrag(Sender, Target: TObject; X, Y: Integer);
  private
    { Private 宣言 }
    DragControl: TObject;
    DragOriginalPos: TPoint;
    DragStartPos: TPoint;
    BackControl: TObject;
    BackControlName: String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // ドラッグコンポーネントクリア
  DragControl := nil;
  // ドラッグ開始座標
  DragStartPos := Point(-1, -1);

// ここはオブジェクトインスペクタで設定しても良い
  Form1.DoubleBuffered := TRUE;

Image1.Cursor      := crHandPoint;
  Image1.Stretch     := TRUE;
  Image1.OnMouseDown := ImageMouseDown;
  Image1.OnDragOver  := ImageDragOver;
  Image1.OnDragDrop  := ImageDragDrop;
  Image1.OnEndDrag   := ImageEndDrag;
  ～
  Image6.Cursor      := crHandPoint;
  Image6.Stretch     := TRUE;
  Image6.OnMouseDown := ImageMouseDown;
  Image6.OnDragOver  := ImageDragOver;
  Image6.OnDragDrop  := ImageDragDrop;
  Image6.OnEndDrag   := ImageEndDrag;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  // 現在ドラッグコンポーネント無し？
  if DragControl = nil then
  begin
    // ドラッグコンポーネントを格納
    DragControl := Sender;
    // 最前面に移動
    TControl(Sender).BringToFront;
    // 元の位置を保存
    DragOriginalPos := Point(TControl(Sender).Left, TControl(Sender).Top);
    // ドラッグ開始
    TControl(Sender).BeginDrag(TRUE);
    DragStartPos := Point(X, Y);
  end;
end;

procedure TForm1.ImageDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  MousePoint: TPoint;
  CtrlKey: Boolean;
  AltKey: Boolean;
  CX, CY: Integer;
begin
  // 対象ドラッグコンポーネント？
  if DragControl = Sender then
  begin
    ///// 質問1:上下 or 左右移動制限 /////

// マウスカーソル位置を取得
    GetCursorPos(MousePoint);
    // クライアント座標を取得
    MousePoint := ScreentoClient(MousePoint);
    // [CTRL]＆[ALT]キー状態を取得
    CtrlKey := GetKeyState(VK_CONTROL) < 0;
    AltKey := (GetKeyState(VK_MENU) and (1 shl 15)) <> 0;
    // コントロール座標設定
    if Not CtrlKey then TControl(Sender).Left := MousePoint.X - DragStartPos.X;
    if Not AltKey  then TControl(Sender).Top  := MousePoint.Y - DragStartPos.Y;

///// 質問2:ドラッグ中TImege下のコントロールを取得 /////

// 親コンポーネント上のカーソル位置を取得
    CX := TControl(Sender).Left + DragStartPos.X;
    CY := TControl(Sender).Top  + DragStartPos.Y;
    // 真下のコントロールを取得
    // ※ ドラッグ中の自コンポーネントを誤って取得してしまう為、一旦消している
    TControl(Sender).Visible := FALSE;
    BackControl := ControlAtPos(Point(CX, CY), FALSE);
    TControl(Sender).Visible := TRUE;

///// 真下のコントロール名称を取得 /////

// 真下のコントロールがTImage？
    if BackControl is TImage then
    begin
      BackControlName := TControl(BackControl).Name;
    end else
    begin
      BackControlName := TControl(Sender).Parent.Name;
    end;

///// 確認 /////

// キャプション情報表示
    Caption := TImage(Sender).Name + ' : ' + 'Pos ' + CX.ToString + ',' + CX.ToString + ' => ' + BackControlName;
  end;
end;

procedure TForm1.ImageDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  // 対象ドラッグコンポーネント？
  if DragControl = Sender then
  begin
    ///// 画像コピー /////

// 真下のコントロールがTImage？
    if BackControl is TImage then
    begin
      // ドロップしたImageにコピー
      TImage(BackControl).Picture := TImage(Sender).Picture;
      // キャプション情報表示
      Caption := 'Copy ' + TImage(Sender).Name + ' => ' + BackControlName;
    end else
    begin
      // キャプションクリア
      Caption := 'Form1';
    end;
  end;
end;

procedure TForm1.ImageEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  // ドラッグ終了
  TControl(Sender).EndDrag(TRUE);
  DragStartPos := Point(-1, -1);
  // ドラッグコンポーネントクリア
  DragControl := nil;

// ドラッグしていた物を元の位置に戻す
  TImage(Sender).Left := DragOriginalPos.X;
  TImage(Sender).Top  := DragOriginalPos.Y;
end;

end.

もし外していたらすみません。
※ Delphi 11.2 VCLプロジェクトで確認

←解決時は質問者本人がここをチェックしてください。

戻る