Delphi Firemonkey中缺少哪些事件操作和过程，能否一一列举并详细说明？
- 内容介绍
- 文章标签
- 相关推荐
本文共计770个文字，预计阅读时间需要4分钟。
在Delphi中，我有一个程序，它将图像组件从一个面板拖放到另一个面板。我使用TWinControl和OnStartDrag事件，并且它工作正常。示例代码如下：
delphiprocedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);begin Accept :=(Source is TWinControl) and (TWinControl(Source).Parent=Self);end;
procedure TForm1.Image1StartDrag(Sender: TObject);begin DragDropSource :=TDragDropSource.Create; DragDropSource.Data :=TDragData.Create; DragDropSource.Data.SetAsHandle(TWinControl(Sender).Handle); DragDropSource HotSpot :=Point(0, 0); DragDropSource Effect :=deCopy;end;
我在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;
您需要将属性DragMode更新为dmAutomatic以允许拖动…
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 …
本文共计770个文字，预计阅读时间需要4分钟。
在Delphi中，我有一个程序，它将图像组件从一个面板拖放到另一个面板。我使用TWinControl和OnStartDrag事件，并且它工作正常。示例代码如下：
delphiprocedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);begin Accept :=(Source is TWinControl) and (TWinControl(Source).Parent=Self);end;
procedure TForm1.Image1StartDrag(Sender: TObject);begin DragDropSource :=TDragDropSource.Create; DragDropSource.Data :=TDragData.Create; DragDropSource.Data.SetAsHandle(TWinControl(Sender).Handle); DragDropSource HotSpot :=Point(0, 0); DragDropSource Effect :=deCopy;end;
我在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;
您需要将属性DragMode更新为dmAutomatic以允许拖动…
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 …