delphi - Firemonkey 中缺少事件操作和过程

Question

我在 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;    

Answer 1

您需要将属性 DragMode 更新为 dmAutomatic 以允许拖动... http://docwiki.embarcadero.com/Libraries/en/FMX.Types.TControl.DragMode

下面的示例向您展示了如何在面板内部/之间移动形状...因此，它可以与 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...