Kernel errors when using FMX BeginDragDrop to another application

  

Update:
Indeed, the issue was fixed since 10.2.
I compared the FMX.Platform.Win from 10.4, the fix is in the function TWinDropTarget.GetDataObject: TDragObject;

I’ve implemented the answer for
Drag and drop with TTreeView in Firemonkey to drag&drop TTreeViewItems in a Delphi 10.2 FMX Windows application.
Everything is working perfectly within the same app, however when the user suddenly drops an item to another copy of the same app, it hangs or even shuts down with c0000374 external error.
When trying to debug in the IDE, the source app stops with this system call stack:

I don’t actually need the ability to drag between applications (although, it would be perfect). I’m just asking, how to avoid such errors?
According to the comment below, I’ve added a minimal example. Create a Win32 FMX app and add a TLabel to it:
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

Use this simple code to activate a drag:
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.

and the DPR file:
program DragBug;

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

{$R *.res}

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

Comments are closed.