使用 FMX BeginDragDrop 到另一个应用程序时出现内核错误

Question

更新：

确实，自 10.2 以来，问题 已得到修复 。我比较了 10.4 中的 FMX.Platform.Win，修复在 function TWinDropTarget.GetDataObject: TDragObject;

我已经实现了 Drag and drop with TTreeView in Firemonkey 在 Delphi 10.2 FMX Windows 应用程序中拖放 TTreeViewItem 秒。

在同一个应用程序中一切都运行良好，但是当用户突然将一个项目放到同一个应用程序的另一个副本时，它会挂起甚至关闭 c0000374 external error。

当尝试在 IDE 中调试时，源应用程序停止并显示此系统调用堆栈：

我实际上不需要在应用程序之间拖动的功能（尽管它会很完美）。我只是想问一下，如何避免这样的错误？

根据下面的评论，我添加了一个最小示例。创建一个 Win32 FMX 应用程序并向其添加 TLabel:

object Form3: TForm3
  Left = 0
  Top = 0
  Caption = 'Form3'
  ClientHeight = 135
  ClientWidth = 331
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Label1: TLabel
    AutoSize = True
    StyledSettings = [Family, FontColor]
    HitTest = True
    Position.X = 72.000000000000000000
    Position.Y = 32.000000000000000000
    Size.Width = 120.000000000000000000
    Size.Height = 32.000000000000000000
    Size.PlatformDefault = False
    TextSettings.Font.Size = 24.000000000000000000
    TextSettings.Font.StyleExt = {00070000000000000004000000}
    Text = 'DrugMe!'
    TabOrder = 0
    OnMouseDown = Label1MouseDown
  end
end

使用这个简单的代码激活拖动：

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Platform,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm3 = class(TForm)
    Label1: TLabel;
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
  public
    procedure StartDrag;
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.fmx}

procedure TForm3.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  StartDrag;
end;

procedure TForm3.StartDrag;
var
  Svc:         IFMXDragDropService;
  DragData:    TDragObject;
  DragBmp:     TBitmap;
begin
  DragBmp := Label1.MakeScreenshot;

  if TPlatformServices.Current.SupportsPlatformService(IFMXDragDropService, Svc) then begin
    DragData.Source := nil;
    DragData.Files := nil;
    DragData.Data := DragBmp;

    Svc.BeginDragDrop(self, DragData, DragBmp);
  end;
end;

end.

和 DPR 文件：

program DragBug;

uses
  System.StartUpCopy,
  FMX.Forms,
  Unit1 in 'Unit1.pas' {Form3};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm3, Form3);
  Application.Run;
end.

Answer 1

Delphi 10.2 中存在错误，已在 Delphi 10.4.2 中修复。您所要做的就是更新到最新的 Delphi 版本。

使用 FMX BeginDragDrop 到另一个应用程序时出现内核错误

Kernel errors when using FMX BeginDragDrop to another application

delphi

winapi

firemonkey