unit DragDropFile;
// -----------------------------------------------------------------------------
// Project: Drag and Drop Component Suite.
// Module: DragDropFile
// Description: Implements Dragging and Dropping of files and folders.
// Version: 4.0
// Date: 18-MAY-2001
// Target: Win32, Delphi 5-6
// Authors: Anders Melander, anders@melander.dk, http://www.melander.dk
// Copyright © 1997-2001 Angus Johnson & Anders Melander
// -----------------------------------------------------------------------------
interface
uses
DragDrop,
DropTarget,
DropSource,
DragDropFormats,
ActiveX,
Windows,
Classes;
type
////////////////////////////////////////////////////////////////////////////////
//
// TFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
TFileClipboardFormat = class(TCustomSimpleClipboardFormat)
private
FFiles: TStrings;
protected
function ReadData(Value: pointer; Size: integer): boolean; override;
function WriteData(Value: pointer; Size: integer): boolean; override;
function GetSize: integer; override;
public
constructor Create; override;
destructor Destroy; override;
function GetClipboardFormat: TClipFormat; override;
function Assign(Source: TCustomDataFormat): boolean; override;
function AssignTo(Dest: TCustomDataFormat): boolean; override;
procedure Clear; override;
function HasData: boolean; override;
property Files: TStrings read FFiles;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
TFilenameClipboardFormat = class(TCustomTextClipboardFormat)
public
function GetClipboardFormat: TClipFormat; override;
function Assign(Source: TCustomDataFormat): boolean; override;
function AssignTo(Dest: TCustomDataFormat): boolean; override;
property Filename: string read GetString write SetString;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameWClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
TFilenameWClipboardFormat = class(TCustomWideTextClipboardFormat)
public
function GetClipboardFormat: TClipFormat; override;
function Assign(Source: TCustomDataFormat): boolean; override;
function AssignTo(Dest: TCustomDataFormat): boolean; override;
property Filename: WideString read GetText write SetText;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameMapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
// DONE -oanme -cStopShip : Rename TFilenameMapClipboardFormat to TFilenameMapClipboardFormat. Also wide version.
TFilenameMapClipboardFormat = class(TCustomSimpleClipboardFormat)
private
FFileMaps : TStrings;
protected
function ReadData(Value: pointer; Size: integer): boolean; override;
function WriteData(Value: pointer; Size: integer): boolean; override;
function GetSize: integer; override;
public
constructor Create; override;
destructor Destroy; override;
function GetClipboardFormat: TClipFormat; override;
procedure Clear; override;
function HasData: boolean; override;
property FileMaps: TStrings read FFileMaps;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameMapWClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
TFilenameMapWClipboardFormat = class(TCustomSimpleClipboardFormat)
private
FFileMaps : TStrings;
protected
function ReadData(Value: pointer; Size: integer): boolean; override;
function WriteData(Value: pointer; Size: integer): boolean; override;
function GetSize: integer; override;
public
constructor Create; override;
destructor Destroy; override;
function GetClipboardFormat: TClipFormat; override;
procedure Clear; override;
function HasData: boolean; override;
property FileMaps: TStrings read FFileMaps;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFileMapDataFormat
//
////////////////////////////////////////////////////////////////////////////////
TFileMapDataFormat = class(TCustomDataFormat)
private
FFileMaps : TStrings;
public
constructor Create(AOwner: TDragDropComponent); override;
destructor Destroy; override;
function Assign(Source: TClipboardFormat): boolean; override;
function AssignTo(Dest: TClipboardFormat): boolean; override;
procedure Clear; override;
function HasData: boolean; override;
function NeedsData: boolean; override;
property FileMaps: TStrings read FFileMaps;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFileDataFormat
//
////////////////////////////////////////////////////////////////////////////////
TFileDataFormat = class(TCustomDataFormat)
private
FFiles : TStrings;
protected
public
constructor Create(AOwner: TDragDropComponent); override;
destructor Destroy; override;
function Assign(Source: TClipboardFormat): boolean; override;
function AssignTo(Dest: TClipboardFormat): boolean; override;
procedure Clear; override;
function HasData: boolean; override;
function NeedsData: boolean; override;
property Files: TStrings read FFiles;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TDropFileTarget
//
////////////////////////////////////////////////////////////////////////////////
TDropFileTarget = class(TCustomDropMultiTarget)
private
FFileFormat : TFileDataFormat;
FFileMapFormat : TFileMapDataFormat;
protected
function GetFiles: TStrings;
function GetMappedNames: TStrings;
function GetPreferredDropEffect: LongInt; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Files: TStrings read GetFiles;
property MappedNames: TStrings read GetMappedNames;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TDropFileSource
//
////////////////////////////////////////////////////////////////////////////////
TDropFileSource = class(TCustomDropMultiSource)
private
FFileFormat : TFileDataFormat;
FFileMapFormat : TFileMapDataFormat;
function GetFiles: TStrings;
function GetMappedNames: TStrings;
protected
procedure SetFiles(AFiles: TStrings);
procedure SetMappedNames(ANames: TStrings);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
property Files: TStrings read GetFiles write SetFiles;
// MappedNames is only needed if files need to be renamed during a drag op.
// E.g. dragging from 'Recycle Bin'.
property MappedNames: TStrings read GetMappedNames write SetMappedNames;
end;
////////////////////////////////////////////////////////////////////////////////
//
// Component registration
//
////////////////////////////////////////////////////////////////////////////////
procedure Register;
////////////////////////////////////////////////////////////////////////////////
//
// Misc.
//
////////////////////////////////////////////////////////////////////////////////
function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean; // V4: renamed
function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
function ReadFilesFromZeroList(Data: pointer; Size: integer;
Wide: boolean; Files: TStrings): boolean;
function WriteFilesToZeroList(Data: pointer; Size: integer;
Wide: boolean; Files: TStrings): boolean;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//
// IMPLEMENTATION
//
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
implementation
uses
DragDropPIDL,
SysUtils,
ShlObj;
////////////////////////////////////////////////////////////////////////////////
//
// Component registration
//
////////////////////////////////////////////////////////////////////////////////
procedure Register;
begin
RegisterComponents(DragDropComponentPalettePage, [TDropFileTarget,
TDropFileSource]);
end;
////////////////////////////////////////////////////////////////////////////////
//
// Utilities
//
////////////////////////////////////////////////////////////////////////////////
function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean;
var
DropFiles : PDropFiles;
begin
DropFiles := PDropFiles(GlobalLock(HGlob));
try
Result := ReadFilesFromData(DropFiles, GlobalSize(HGlob), Files)
finally
GlobalUnlock(HGlob);
end;
end;
function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
var
Wide : boolean;
begin
Files.Clear;
if (Data <> nil) then
begin
Wide := PDropFiles(Data)^.fWide;
dec(Size, PDropFiles(Data)^.pFiles);
inc(PChar(Data), PDropFiles(Data)^.pFiles);
ReadFilesFromZeroList(Data, Size, Wide, Files);
end;
Result := (Files.Count > 0);
end;
function ReadFilesFromZeroList(Data: pointer; Size: integer;
Wide: boolean; Files: TStrings): boolean;
var
StringSize : integer;
begin
Result := False;
if (Data <> nil) then
while (Size > 0) and (PChar(Data)^ <> #0) do
begin
if (Wide) then
begin
Files.Add(PWideChar(Data));
StringSize := (Length(PWideChar(Data)) + 1) * 2;
end else
begin
Files.Add(PChar(Data));
StringSize := Length(PChar(Data)) + 1;
end;
inc(PChar(Data), StringSize);
dec(Size, StringSize);
Result := True;
end;
end;
function WriteFilesToZeroList(Data: pointer; Size: integer;
Wide: boolean; Files: TStrings): boolean;
var
i : integer;
begin
Result := False;
if (Data <> nil) then
begin
i := 0;
dec(Size);
while (Size > 0) and (i < Files.Count) do
begin
if (Wide) then
begin
StringToWideChar(Files[i], Data, Size);
dec(Size, (Length(Files[i])+1)*2);
end else
begin
StrPLCopy(Data, Files[i], Size);
dec(Size, Length(Files[i])+1);
end;
inc(PChar(Data), Length(Files[i])+1);
inc(i);
Result := True;
end;
// Final teminating zero.
if (Size >= 0) then
PChar(Data)^ := #0;
end;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFileClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TFileClipboardFormat.Create;
begin
inherited Create;
FFiles := TStringList.Create;
// Note: Setting dwAspect to DVASPECT_SHORT will request that the data source
// returns the file names in short (8.3) format.
// FFormatEtc.dwAspect := DVASPECT_SHORT;
end;
destructor TFileClipboardFormat.Destroy;
begin
FFiles.Free;
inherited Destroy;
end;
function TFileClipboardFormat.GetClipboardFormat: TClipFormat;
begin
Result := CF_HDROP;
end;
procedure TFileClipboardFormat.Clear;
begin
FFiles.Clear;
end;
function TFileClipboardFormat.HasData: boolean;
begin
Result := (FFiles.Count > 0);
end;
function TFileClipboardFormat.GetSize: integer;
var
i : integer;
begin
Result := SizeOf(TDropFiles) + FFiles.Count + 1;
for i := 0 to FFiles.Count-1 do
inc(Result, Length(FFiles[i]));
end;
function TFileClipboardFormat.ReadData(Value: pointer;
Size: integer): boolean;
begin
Result := (Size > SizeOf(TDropFiles));
if (not Result) then
exit;
Result := ReadFilesFromData(Value, Size, FFiles);
end;
function TFileClipboardFormat.WriteData(Value: pointer;
Size: integer): boolean;
begin
Result := (Size > SizeOf(TDropFiles));
if (not Result) then
exit;
PDropFiles(Value)^.pfiles := SizeOf(TDropFiles);
PDropFiles(Value)^.fwide := False;
inc(PChar(Value), SizeOf(TDropFiles));
dec(Size, SizeOf(TDropFiles));
WriteFilesToZeroList(Value, Size, False, FFiles);
end;
function TFileClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
begin
if (Source is TFileDataFormat) then
begin
FFiles.Assign(TFileDataFormat(Source).Files);
Result := True;
end else
Result := inherited Assign(Source);
end;
function TFileClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
begin
if (Dest is TFileDataFormat) then
begin
TFileDataFormat(Dest).Files.Assign(FFiles);
Result := True;
end else
Result := inherited AssignTo(Dest);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
var
CF_FILENAMEA: TClipFormat = 0;
function TFilenameClipboardFormat.GetClipboardFormat: TClipFormat;
begin
if (CF_FILENAMEA = 0) then
CF_FILENAMEA := RegisterClipboardFormat(CFSTR_FILENAMEA);
Result := CF_FILENAMEA;
end;
function TFilenameClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
begin
if (Source is TFileDataFormat) then
begin
Result := (TFileDataFormat(Source).Files.Count > 0);
if (Result) then
Filename := TFileDataFormat(Source).Files[0];
end else
Result := inherited Assign(Source);
end;
function TFilenameClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
begin
if (Dest is TFileDataFormat) then
begin
TFileDataFormat(Dest).Files.Add(Filename);
Result := True;
end else
Result := inherited AssignTo(Dest);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameWClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
var
CF_FILENAMEW: TClipFormat = 0;
function TFilenameWClipboardFormat.GetClipboardFormat: TClipFormat;
begin
if (CF_FILENAMEW = 0) then
CF_FILENAMEW := RegisterClipboardFormat(CFSTR_FILENAMEW);
Result := CF_FILENAMEW;
end;
function TFilenameWClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
begin
if (Source is TFileDataFormat) then
begin
Result := (TFileDataFormat(Source).Files.Count > 0);
if (Result) then
Filename := TFileDataFormat(Source).Files[0];
end else
Result := inherited Assign(Source);
end;
function TFilenameWClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
begin
if (Dest is TFileDataFormat) then
begin
TFileDataFormat(Dest).Files.Add(Filename);
Result := True;
end else
Result := inherited AssignTo(Dest);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameMapClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
var
CF_FILENAMEMAP: TClipFormat = 0;
constructor TFilenameMapClipboardFormat.Create;
begin
inherited Create;
FFileMaps := TStringList.Create;
end;
destructor TFilenameMapClipboardFormat.Destroy;
begin
FFileMaps.Free;
inherited Destroy;
end;
function TFilenameMapClipboardFormat.GetClipboardFormat: TClipFormat;
begin
if (CF_FILENAMEMAP = 0) then
CF_FILENAMEMAP := RegisterClipboardFormat(CFSTR_FILENAMEMAPA);
Result := CF_FILENAMEMAP;
end;
procedure TFilenameMapClipboardFormat.Clear;
begin
FFileMaps.Clear;
end;
function TFilenameMapClipboardFormat.HasData: boolean;
begin
Result := (FFileMaps.Count > 0);
end;
function TFilenameMapClipboardFormat.GetSize: integer;
var
i : integer;
begin
Result := FFileMaps.Count + 1;
for i := 0 to FFileMaps.Count-1 do
inc(Result, Length(FFileMaps[i]));
end;
function TFilenameMapClipboardFormat.ReadData(Value: pointer;
Size: integer): boolean;
begin
Result := ReadFilesFromZeroList(Value, Size, False, FFileMaps);
end;
function TFilenameMapClipboardFormat.WriteData(Value: pointer;
Size: integer): boolean;
begin
Result := WriteFilesToZeroList(Value, Size, False, FFileMaps);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFilenameMapWClipboardFormat
//
////////////////////////////////////////////////////////////////////////////////
var
CF_FILENAMEMAPW: TClipFormat = 0;
constructor TFilenameMapWClipboardFormat.Create;
begin
inherited Create;
FFileMaps := TStringList.Create;
end;
destructor TFilenameMapWClipboardFormat.Destroy;
begin
FFileMaps.Free;
inherited Destroy;
end;
function TFilenameMapWClipboardFormat.GetClipboardFormat: TClipFormat;
begin
if (CF_FILENAMEMAPW = 0) then
CF_FILENAMEMAPW := RegisterClipboardFormat(CFSTR_FILENAMEMAPW);
Result := CF_FILENAMEMAPW;
end;
procedure TFilenameMapWClipboardFormat.Clear;
begin
FFileMaps.Clear;
end;
function TFilenameMapWClipboardFormat.HasData: boolean;
begin
Result := (FFileMaps.Count > 0);
end;
function TFilenameMapWClipboardFormat.GetSize: integer;
var
i : integer;
begin
Result := FFileMaps.Count + 1;
for i := 0 to FFileMaps.Count-1 do
inc(Result, Length(FFileMaps[i]));
inc(Result, Result);
end;
function TFilenameMapWClipboardFormat.ReadData(Value: pointer;
Size: integer): boolean;
begin
Result := ReadFilesFromZeroList(Value, Size, True, FFileMaps);
end;
function TFilenameMapWClipboardFormat.WriteData(Value: pointer;
Size: integer): boolean;
begin
Result := WriteFilesToZeroList(Value, Size, True, FFileMaps);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFileMapDataFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TFileMapDataFormat.Create(AOwner: TDragDropComponent);
begin
inherited Create(AOwner);
FFileMaps := TStringList.Create;
TStringList(FFileMaps).OnChanging := DoOnChanging;
end;
destructor TFileMapDataFormat.Destroy;
begin
FFileMaps.Free;
inherited Destroy;
end;
function TFileMapDataFormat.Assign(Source: TClipboardFormat): boolean;
begin
Result := True;
if (Source is TFilenameMapClipboardFormat) then
FFileMaps.Assign(TFilenameMapClipboardFormat(Source).FileMaps)
else if (Source is TFilenameMapWClipboardFormat) then
FFileMaps.Assign(TFilenameMapWClipboardFormat(Source).FileMaps)
else
Result := inherited Assign(Source);
end;
function TFileMapDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
begin
Result := True;
if (Dest is TFilenameMapClipboardFormat) then
TFilenameMapClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
else if (Dest is TFilenameMapWClipboardFormat) then
TFilenameMapWClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
else
Result := inherited AssignTo(Dest);
end;
procedure TFileMapDataFormat.Clear;
begin
FFileMaps.Clear;
end;
function TFileMapDataFormat.HasData: boolean;
begin
Result := (FFileMaps.Count > 0);
end;
function TFileMapDataFormat.NeedsData: boolean;
begin
Result := (FFileMaps.Count = 0);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TFileDataFormat
//
////////////////////////////////////////////////////////////////////////////////
constructor TFileDataFormat.Create(AOwner: TDragDropComponent);
begin
inherited Create(AOwner);
FFiles := TStringList.Create;
TStringList(FFiles).OnChanging := DoOnChanging;
end;
destructor TFileDataFormat.Destroy;
begin
FFiles.Free;
inherited Destroy;
end;
function TFileDataFormat.Assign(Source: TClipboardFormat): boolean;
begin
Result := True;
if (Source is TFileClipboardFormat) then
FFiles.Assign(TFileClipboardFormat(Source).Files)
else if (Source is TPIDLClipboardFormat) then
FFiles.Assign(TPIDLClipboardFormat(Source).Filenames)
else
Result := inherited Assign(Source);
end;
function TFileDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
begin
Result := True;
if (Dest is TFileClipboardFormat) then
TFileClipboardFormat(Dest).Files.Assign(FFiles)
else if (Dest is TPIDLClipboardFormat) then
TPIDLClipboardFormat(Dest).Filenames.Assign(FFiles)
else
Result := inherited AssignTo(Dest);
end;
procedure TFileDataFormat.Clear;
begin
FFiles.Clear;
end;
function TFileDataFormat.HasData: boolean;
begin
Result := (FFiles.Count > 0);
end;
function TFileDataFormat.NeedsData: boolean;
begin
Result := (FFiles.Count = 0);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TDropFileTarget
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropFileTarget.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OptimizedMove := True;
FFileFormat := TFileDataFormat.Create(Self);
FFileMapFormat := TFileMapDataFormat.Create(Self);
end;
destructor TDropFileTarget.Destroy;
begin
FFileFormat.Free;
FFileMapFormat.Free;
inherited Destroy;
end;
function TDropFileTarget.GetFiles: TStrings;
begin
Result := FFileFormat.Files;
end;
function TDropFileTarget.GetMappedNames: TStrings;
begin
Result := FFileMapFormat.FileMaps;
end;
function TDropFileTarget.GetPreferredDropEffect: LongInt;
begin
Result := inherited GetPreferredDropEffect;
if (Result = DROPEFFECT_NONE) then
Result := DROPEFFECT_COPY;
end;
////////////////////////////////////////////////////////////////////////////////
//
// TDropFileSource
//
////////////////////////////////////////////////////////////////////////////////
constructor TDropFileSource.Create(aOwner: TComponent);
begin
inherited Create(AOwner);
FFileFormat := TFileDataFormat.Create(Self);
FFileMapFormat := TFileMapDataFormat.Create(Self);
end;
destructor TDropFileSource.Destroy;
begin
FFileFormat.Free;
FFileMapFormat.Free;
inherited Destroy;
end;
function TDropFileSource.GetFiles: TStrings;
begin
Result := FFileFormat.Files;
end;
function TDropFileSource.GetMappedNames: TStrings;
begin
Result := FFileMapFormat.FileMaps;
end;
procedure TDropFileSource.SetFiles(AFiles: TStrings);
begin
FFileFormat.Files.Assign(AFiles);
end;
procedure TDropFileSource.SetMappedNames(ANames: TStrings);
begin
FFileMapFormat.FileMaps.Assign(ANames);
end;
////////////////////////////////////////////////////////////////////////////////
//
// Initialization/Finalization
//
////////////////////////////////////////////////////////////////////////////////
initialization
// Data format registration
TFileDataFormat.RegisterDataFormat;
TFileMapDataFormat.RegisterDataFormat;
// Clipboard format registration
TFileDataFormat.RegisterCompatibleFormat(TFileClipboardFormat, 0, csSourceTarget, [ddRead]);
TFileDataFormat.RegisterCompatibleFormat(TPIDLClipboardFormat, 1, csSourceTarget, [ddRead]);
TFileDataFormat.RegisterCompatibleFormat(TFilenameClipboardFormat, 2, csSourceTarget, [ddRead]);
TFileDataFormat.RegisterCompatibleFormat(TFilenameWClipboardFormat, 2, csSourceTarget, [ddRead]);
TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapClipboardFormat, 0, csSourceTarget, [ddRead]);
TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapWClipboardFormat, 0, csSourceTarget, [ddRead]);
finalization
// Data format unregistration
TFileDataFormat.UnregisterDataFormat;
TFileMapDataFormat.UnregisterDataFormat;
// Clipboard format unregistration
TFileClipboardFormat.UnregisterClipboardFormat;
TFilenameClipboardFormat.UnregisterClipboardFormat;
TFilenameWClipboardFormat.UnregisterClipboardFormat;
TFilenameMapClipboardFormat.UnregisterClipboardFormat;
TFilenameMapWClipboardFormat.UnregisterClipboardFormat;
end.