掲示板システム
ホーム
アクセス解析
カテゴリ
ログアウト
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プロジェクトで確認
←解決時は質問者本人がここをチェックしてください。
戻る
掲示板システム
Copyright 2020 Takeshi Okamoto All Rights Reserved.