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

发布时间：2020-12-15 09:13:51 所属栏目：大数据来源：网络整理

导读：我在Delphi中有一个程序将图像组件从一个面板拖放到另一个面板但是在这里我为每个图像组件使用“TWincontrol”和“OnStartDrag”事件并且它工作正常,示例代码如下所示. 当我在Firemonkey中实现相同功能时,我发现缺少这些事件和过程.那么上述事件和程序有什么

我在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以允许拖动…
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 …

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!