4

Delphi で画像コンポーネントをあるパネルから別のパネルにドラッグ アンド ドロップするプログラムがありますが、ここでは各画像コンポーネントに「TWincontrol」イベントと「OnStartDrag」イベントを使用しています。同じことを Firemonkey に実装すると、それらのイベントと手順が欠落していることがわかりました。上記のイベントと手順の方法または代替手段はありますか?

「dragmode」プロパティが「dmManual」に設定されている場合にコンポーネントをドラッグできることを知りたいのですが、コードを使用して実行時にプロパティを変更する方法はありますか?

サンプルコード:

TMyDragObject = class(TDragControlObject)    
protected    
function GetDragImages: TDragImageList; override;    
end;    

procedure TForm1.Shape1StartDrag(Sender: TObject; var DragObject: TDragObject);    
var    
b:TBitmap;    
index:integer;    
p:TPoint;    
begin    
if Sender is TImage then    
with Sender as TImage do    
begin    
p:=screentoclient(mouse.cursorpos);    
MouseX:=p.x;    
MouseY:=p.y;    
DragObject := TMyDragObject.Create(TImage(Sender));     
end;    
end;    

procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);    
var    
shape:TImage;    
begin    
if source is tMyDragObject then    
with source as TMyDragObject do    
begin    
shape:=TImage(control);    
shape.parent:=TWincontrol(sender);    
shape.left:=x-MouseX;    
shape.top:=y-MouseY;    
end;    
end;
4

1 に答える 1

2

ドラッグを許可するには 、プロパティDragModeを更新する必要があります... http://docwiki.embarcadero.com/Libraries/en/FMX.Types.TControl.DragModedmAutomatic

以下の例は、シェイプをパネル内/パネル間で移動する方法を示しています...したがって、FireMonkey で動作します...

右クリックすると、形状の色が変わります..赤、ドラッグ禁止...それ以外の場合は許可...

unit Unit6;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    RoundRect1: TRoundRect;
    procedure PanelDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
    procedure PanelDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
    procedure RoundRect1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.PanelDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
begin
  if ((data.Source <> nil) and (data.Source is TRoundRect) and (Sender is TPanel)) then
  begin
    with TRoundRect(data.Source) do
    begin
      Parent := TPanel(Sender);
      Position.X := Point.X - (Width  / 2);  // Mouse cursor is center on the dragged object
      Position.Y := Point.Y - (Height / 2);
      DragMode   := TDragMode.dmManual;      // Disable drag by default (authorized later if not red)
    end;
  end;
end;

procedure TForm1.PanelDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
begin
  Accept := Data.Source is TRoundRect;       // Can be moved on the same panel... update if you don't want
end;

procedure TForm1.RoundRect1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if Sender is TRoundRect then
  begin
    with TRoundRect(Sender) do
    begin
      if Button = TMouseButton.mbRight then
      begin
        if Fill.Color <> claRed then
        begin
          Fill.Color := claRed;
        end
        else
        begin
          Fill.Color := claBlue;
        end;
      end
      else
      begin
        if Fill.Color <> claRed then
        begin
          DragMode := TDragMode.dmAutomatic;   // can be dragged
        end
        else
        begin
          DragMode := TDragMode.dmManual;      // drag forbidden
        end;
      end;
    end;
  end;
end;

end.

FMX (2 TPanel ; 1 TRoundRect):

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Drag...'
  ClientHeight = 418
  ClientWidth = 820
  Visible = False
  StyleLookup = 'backgroundstyle'
  object Panel1: TPanel
    Position.Point = '(8,8)'
    Width = 433.000000000000000000
    Height = 401.000000000000000000
    OnDragOver = PanelDragOver
    OnDragDrop = PanelDragDrop
    TabOrder = 1
    object RoundRect1: TRoundRect
      Position.Point = '(48,40)'
      Width = 129.000000000000000000
      Height = 81.000000000000000000
      OnMouseDown = RoundRect1MouseDown
      Fill.Color = claBlue
    end
  end
  object Panel2: TPanel
    Position.Point = '(448,8)'
    Width = 361.000000000000000000
    Height = 401.000000000000000000
    OnDragOver = PanelDragOver
    OnDragDrop = PanelDragDrop
    TabOrder = 2
  end
end

もちろん、TImageでも動作します... ステップ1 ステップ2 ステップ 3 ステップ 4

于 2012-05-16T23:03:35.753 に答える