Search code examples
delphiwinapifiremonkey

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:

image

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.
Solution

  • There is a bug in Delphi 10.2 which has been fixed in Delphi 10.4.2. All you have to do is to update to the latest Delphi version.