Reputation: 57
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:
fpntDragAndDrop.Files.Count
is 1 (contains the path+name from file)fpntDragAndDrop.Data.Count
is 1 (contains the file as a stream)If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count
is 0 (contains nothing)fpntDragAndDrop.Data.Count
is 1 (contains the file as a stream)Now my problem:
If I drop very large files from Windows Explorer, the component does the following:
fpntDragAndDrop.Files
TMemoryStream
and try to load the data from the file into the streamStep 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:
fpntDragAndDrop.Files.Count
is 1 (contaims the path+name from the file)fpntDragAndDrop.Data.Count
is 0 (No memory stream is loaded)If I drop a file from Outlook on the area:
fpntDragAndDrop.Files.Count
is 0 (comtains nothing)fpntDragAndDrop.Data.Count
is 1 (contains the file as a stream)Does somebody have an idea? Or maybe the component has a setting for that?
Upvotes: 2
Views: 499
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