Athris
Athris

Reputation: 57

Drag & Drop Component Suite: Drop files and if path isn't exists get data from file

I use the Drag and Drop Component Suite for Delphi.

I try to create a drag & drop area which accepts files (ie, from Windows Explorer) and data (ie, from Outlook attachments). So, I use the demo (CombatTargetDemo) to learn how it works, and after this I create a wrapper class which creates a TDropComboTarget object:

constructor TDragAndDrop.Create( vpntOwner: TWinControl);
begin  
  fpntDragAndDrop                 := TDropComboTarget.Create(vpntOwner);
  fpntDragAndDrop.Name            := 'DropComboTarget_'+vpntOwner.Name;
  fpntDragAndDrop.DragTypes       := [dtCopy, dtLink];
  fpntDragAndDrop.OnDrop          := DropFiles;
  fpntDragAndDrop.Target          := vpntOwner;
  fpntDragAndDrop.Formats         := [mfFile, mfData];
end;

procedure TDragAndDrop.DropFiles(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
var
  intCnt: Integer;
  pntStream: TStream;
  strFileName: String;
  strDragAndDropFile: String;
begin
  try
    fstlDroppedFilePaths.Clear;
    fstlDroppedFilePaths.Assign(fpntDragAndDrop.Files);

    for intCnt := 0 to fpntDragAndDrop.Data.Count-1 do begin
      strFileName := fpntDragAndDrop.Data.Names[intCnt];
      if (strFileName = '') then begin
        strFileName := IntToStr(intCnt)+'_'+FormatDateTime('yyyymmddhhnnss', Now())+'.dat';
      end;

      strDragAndDropFile := GetDragAndDropSavePath+strFileName;
      pntStream := TFileStream.Create(strDragAndDropFile, fmCreate);
      try
        pntStream.CopyFrom(fpntDragAndDrop.Data[intCnt], fpntDragAndDrop.Data[intCnt].Size);
      finally
        pntStream.Free;
      end;
      if FileExists(strDragAndDropFile, false) then begin
        fstlDroppedFilePaths.Add(strDragAndDropFile);
      end;
    end;
  except
  end;
end;

First of all, the code works.

If I drop a Windows Explorer file on the area:

If I drop a file from Outlook on the area:

Now my problem:

If I drop very large files from Windows Explorer, the component does the following:

  1. Read the file header and add an item to fpntDragAndDrop.Files
  2. Create a TMemoryStream and try to load the data from the file into the stream

Step 1 is perfect, but on step 2 I get an exception because of insufficient memory.

My solution:

I want that the component does Step 1. If Step 1 gives a result, then the component should skip Step 2. After this, the variables in the DropFiles procedure should have the following values:

If I drop a Windows Explorer file on the area:

If I drop a file from Outlook on the area:

Does somebody have an idea? Or maybe the component has a setting for that?

Upvotes: 2

Views: 499

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 598194

I'm not overly familiar with this suite, but just browsing through its source, I think you can use the OnAcceptFormat event to reject formats you don't want on a per-drop basis.

So, even though you have enabled drops of mfData doesn't mean you have to actually accept a dropped stream (TDataStreamDataFormat) if a file path (TFileDataFormat or TFileMapDataFormat) is available. So, query the fpntDragAndDrop.DataObject to see what formats it actually holds, such as by passing it to the HasValidFormats() method of the various formats in the fpntDragAndDrop.DataFormats property.

For example:

fpntDragAndDrop.OnAcceptFormat := AcceptStreams;

...

procedure TDragAndDrop.AcceptStreams(Sender: TObject;
  const DataFormat: TCustomDataFormat; var Accept: boolean);
var
  Fmt: TCustomDataFormat;
  i: Integer;
begin
  if DataFormat is TDataStreamDataFormat then
  begin
    // FYI, TFileDataFormat should be in DataFormats[0],
    // and TFileMapDataFormat should be in DataFormats[5],
    // if you want to avoid this loop...
    for i := 0 to fpntDragAndDrop.DataFormats.Count-1 do
    begin
      Fmt := fpntDragAndDrop.DataFormats[i];
      if (Fmt <> DataFormat) and ((Fmt is TFileDataFormat) or (Fmt is TFileMapDataFormat)) then
      begin
        if Fmt.HasValidFormats(fpntDragAndDrop.DataObject) then
        begin
          Accept := False;
          Exit;
        end;
      end;
    end;
  end;
  Accept := True; // should already be True by default...
end;

Upvotes: 0

Related Questions