Missed Actions and Event Procedures in Firemonkey

Question

I have a program in Delphi to drag an image component from one panel to another, but here I use the "TWincontrol" and "OnStartDrag" events for each image component, and it works well. An example code is given below. When I implement the same in Firemonkey, I find that these events and procedures are missing. So, is there a way or replacement for the above events and procedures?

I would like to know if we can drag a component if the dragmode property is set to dmManual, and is there a way to change the property at runtime with some code?

Code example:

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:=px; MouseY:=py; 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

You need to update the DragMode to dmAutomatic to allow drag and drop ... http://docwiki.embarcadero.com/Libraries/en/FMX.Types.TControl.DragMode

The following example shows how to move a shape inside / out of panels ... so it works with FireMonkey ...

If you right-click, you will change the color of the shape .. red, drag the forbidden ... otherwise, logged in ...

 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 

Of course, it also works with TImage ...