平滑的拖放过渡

Question

我正在为孩子们创建一个程序，其中一个迷你游戏是将鼠标拖入洞中。除非我在底层图片的 OnDragOver 事件上放置一个函数，否则拖动之间没有动画。但是，这不能正常工作，因为被拖动的图片会遮挡背景。 理想情况下，图片会将其中心捕捉到光标并用鼠标移动。

有什么建议吗？

这是现在的样子的GIF：

Answer 1

不幸的是，Delphi提供的拖放功能对您要实现的功能无用。

所以你必须为此制作自己的拖动系统。

以下是一个基本的代码示例，它将向您展示如何实现此目的：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  //Variable to tell whether dragging is in progress
  IsDragging: Boolean;
  //Variable for storing the cursor position above component when dragging has started
  //We use this to keep the component in same relative position to mouse cursors
  //during the dragging
  GrabPos: TPoint;

implementation

{$R *.dfm}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Store the information where mouse cursor was in relation to the component when
  //dragging has started
  GrabPos.X := X;
  GrabPos.Y := Y;
  //Set IsDragging to true to tell the program that dragging process is in progress
  IsDragging := True;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //Check to see if dragging process is in progress
  if IsDragging then
  begin
    //Set new component position relative to mouse cursor position
    //NOTE
    // - We don't use X and Y mouse position that is returned by the event. Instead
    //   we are using global mouse cursor position available through Mouse.CursorPos.
    //   This is necessary because X and Y parameters that are returned by the event
    //   are relative to the current component position which is constantly changing
    //   during the dragging process
    // - Since Mouse.CursorPos is using global (screen) coordinates wee need to change
    //   then into relative coordinates of our application.
    //   Because Let and Top properties of any component are relative to the parent
    //   component on which your component resides you need to make sure that you always
    //   use parent components ScreenToClient method.
    //   So if you would have your component on another panel for instance you would
    //   have to call
    //   TPanel(sender).Left := AnotherPanel.ScreenToClient(MouseCursorPos).X - GrabPos.X;
    // - Sender is reference to the component that fired the mentioned event.
    //   You can use this in order to write one event method that can work with multiple
    //   components.
    TPanel(sender).Left := ScreenToClient(Mouse.CursorPos).X - GrabPos.X;
    TPanel(sender).Top := ScreenToClient(Mouse.CursorPos).Y - GrabPos.Y;
  end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Set IsDragging to false to tell the program that dragging process is no longer in progress
  IsDragging := False;
end;

end.

在我的示例中，我使用的是全局变量，但我建议您将用于图像的组件子类化，并将其构建到它们中。

这样做的主要优点是能够同时拖动多个组件（在多点触摸系统上很有用），这是我的例子无法实现的。

我的示例在VCL应用程序上完美运行，但我认为它也适用于FireMonkey应用程序（FMX），但我还没有测试过它。