Представляю класс который обеспечит перенос файлов в программу или вынос файлов из нее.
Код:
unit DropFileClass;
// procedure FromDropFiles(Sender: TObject);
interface
uses
Windows, Messages, Classes, SysUtils, AppEvnts,
Controls, ShellAPI, FileCtrl, ActiveX, ComObj, ShlObj;
type
TDropEffect = (deNone, deCopy, deMove, deLink);
TDropFile = class(TApplicationEvents, IDropSource)
protected
procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); virtual;
{ IDropSource }
function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
function GiveFeedback(dwEffect: Longint): HResult; stdcall;
public
DropEffect: TDropEffect;
Files: TStringList;
OnDropFiles : TNotifyEvent;
function DropOut(Directory: String; AFileName: String): Integer; overload;
function DropOut(Directory: String; AFileList: TStrings): Integer; overload;
function DropOut(AFileList: TStrings): Integer; overload;
function DropOut(AFileName: String): Integer; overload;
// методы для анализа
function MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y: Integer; offset: integer = 0):boolean;
// конструктор
constructor Create(AOwner: TWinControl);
destructor Destroy; override;
end;
// procedure DropFileEvent(Sender: TObject);
implementation
{ TDropFile }
procedure TDropFile.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
var nCount, nFile : UINT;
sFileNm : string;
dwChars : DWORD;
const QUERY_FILES_COUNT = UINT($FFFFFFFF);
begin
if (Msg.message=WM_DROPFILES) and (Msg.hwnd = TWinControl(self.Owner).Handle) then begin
if @self.OnDropFiles=nil then begin
// защита от выполнения
Handled:=true;
exit;
end;
// Событие поймано.
// отключаем пост обработку
Handled:=true;
// обрабатываем событие
nCount := DragQueryFile( Msg.wParam, QUERY_FILES_COUNT, nil, 0);
if nCount = 0 then Exit;
// чистим лист
Files.Clear;
try
for nFile := 0 to nCount-1 do begin
// GrцЯe des Buffers bestimmen
dwChars := DragQueryFile( Msg.wParam, nFile, nil,0);
Inc( dwChars); // Platz fьr Arnold
SetLength( sFileNm, dwChars);
// Dateinamen abrufen
dwChars := DragQueryFile( Msg.wParam, nFile, PChar(sFileNm), dwChars);
if dwChars > 0 then begin
SetLength( sFileNm, dwChars); // Arnold entsorgen
Files.Add(sFileNm);
end;
end;
// an der Abwurfstelle im Fenster eine anklickbare Markierung setzen
finally
if @self.OnDropFiles<>nil then OnDropFiles(self);
end;
end; // end IF
end;
constructor TDropFile.Create(AOwner: TWinControl);
begin
TApplicationEvents(self).Create(AOwner);
self.OnMessage:=self.ApplicationEventsMessage;
Files:=TStringList.Create;
DropEffect:=deCopy;
DragAcceptFiles(TWinControl(Owner).Handle, TRUE);
end;
destructor TDropFile.Destroy;
begin
Files.free;
if Assigned(Owner) then DragAcceptFiles(TWinControl(Owner).Handle, FALSE);
inherited;
end;
function TDropFile.DropOut(AFileList: TStrings): Integer;
var s1:string; i:integer;
begin
if AFileList.Count=0 then exit;
Files.Clear;
s1:=ExtractFilePath(AFileList[0]);
i:=0;
repeat
if (s1<>ExtractFilePath(AFileList[i])) then break;
Files.Add(ExtractFileName(AFileList[i]));
inc(i);
until (i=AFileList.Count);
DropOut(s1,Files);
Files.Clear;
end;
// базовый обработчик
function TDropFile.DropOut(Directory: String; AFileList: TStrings): Integer;
var
dataObj: IDataObject;
Root: IShellFolder;
pchEaten: ULONG;
DirectoryItemIDList: PItemIDList;
dwAttributes: ULONG;
Folder: IShellFolder;
i: Integer;
ItemIDLists: array of PItemIDList;
dwOKEffects: Longint;
begin
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(Directory)),
pchEaten, DirectoryItemIDList, dwAttributes));
try
OleCheck(Root.BindToObject(DirectoryItemIDList, nil, IShellFolder, Folder));
SetLength(ItemIDLists, AFileList.Count);
for i:=0 to AFileList.Count-1 do OleCheck(Folder.ParseDisplayName(0, nil,
PWideChar(WideString(AFileList[i])),
pchEaten, ItemIDLists[i], dwAttributes));
try
OleCheck(Folder.GetUIObjectOf(0, AFileList.Count, ItemIDLists[0],
IDataObject, nil, dataObj));
finally
for i:=0 to AFileList.Count-1 do CoTaskMemFree(ItemIDLists[i]);
end;
dwOKEffects:=0;
if deNone = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_NONE;
if deCopy = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_COPY;
if deMove = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_MOVE;
if deLink = DropEffect then dwOKEffects:=dwOKEffects or DROPEFFECT_LINK;
DoDragDrop(dataObj, Self, dwOKEffects, Result);
finally
CoTaskMemFree(DirectoryItemIDList);
end;
end;
function TDropFile.DropOut(Directory, AFileName: String): Integer;
begin
Files.Clear;
try
Files.Add(AFileName);
Result:=DropOut(Directory, Files);
finally
Files.Clear;
end;
end;
function TDropFile.DropOut(AFileName: String): Integer;
begin
Files.Clear;
try
Files.Add(ExtractFileName(AFileName));
Result:=DropOut(ExtractFilePath(AFileName), Files);
finally
Files.Clear;
end;
end;
function TDropFile.GiveFeedback(dwEffect: Integer): HResult;
begin
Result:=DRAGDROP_S_USEDEFAULTCURSORS;
end;
function TDropFile.MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y, offset: Integer): boolean;
begin
result:=false;
if not (Sender is TControl) then exit;
if (ssLeft in Shift) and
((x<=offset)or(x>=TControl(Sender).Width-5-offset) or
(y<=offset)or(y>=TControl(Sender).Height-5-offset)) then result:=true;
end;
function TDropFile.QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Integer): HResult;
begin
if fEscapePressed then Result:=DRAGDROP_S_CANCEL
else if (grfKeyState and MK_LBUTTON)=0 then Result:=DRAGDROP_S_DROP
else Result:=S_OK;
end;
initialization
OleInitialize(nil);
finalization
OleUninitialize;
end.
Методы
DropEffect: TDropEffect;
Тип операции
deNone (0) - нет
deCopy (1) - копирование
deMove (2) - перемещение
deLink (3) - ярлык
Files: TStringList;
Список файлов или папок после события OnDropFiles
Список перемещенных файлов в программу
Constructor Create(Aowner: TWinControl);
От того что передается в качестве родителя компонента TDropFile зависит реакция обработчика
OnDropFiles
То есть если передана форма
Код:
df:=TDropFile.Create(Form1);
То значит форма будет реагировать на перетаскивание
Если, например, панель
Код:
df:=TDropFile.Create(Panel1);
То значит панель будет реагировать на перетаскивание, а форма НЕТ
и тп
OnDropFiles : TNotifyEvent;
Ссылка на событие перетаскивания файлов
Задается вручную
Код:
type
TForm2 = class(TForm)
Label1: TLabel;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
df: TDropFile; // экземляр класса TDropFile
procedure FromDropFiles(Sender: TObject); // событие обработчик OnDropFiles
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
df:=TDropFile.Create(self); // создаем объект
df.OnDropFiles:=self.FromDropFiles; // задаем обработчик
end;
procedure TForm2.FromDropFiles(Sender: TObject);
begin
// обрабатываем событие перетаскивания файлов в программу
ListBox1.Clear;
ListBox1.Items.AddStrings(df.Files);
// в df.Files лежит список файлов или папок которые были перенесены в программу
end;
function DropOut(Directory: String; AFileName: String): Integer; overload;
function DropOut(Directory: String; AFileList: TStrings): Integer; overload;
function DropOut(AFileList: TStrings): Integer; overload;
function DropOut(AFileName: String): Integer; overload;
1) работает с одним файлом
2) второй со списком.
3) Третий работает со списком абсолютных путей
4) Червертый работает с одним абсолютным адресом файла
Directory указывает на каталог в котором находятся файлы. AFileName и AFileList содержат имена файлов.
Результат операции:
0 - отменено пользователем (нажал Esc) = DROPEFFECT_NONE
1 - файл скопирован = DROPEFFECT_COPY
2 - файл перемещен. Если поддерживает источник, то исходный файл будет удален = DROPEFFECT_MOVE
4 - создана ссылка на файл = DROPEFFECT_LINK
function MouseMoveDrop(Sender: TObject; Shift: TShiftState; X, Y: Integer; offset: integer = 0):boolean;
Функция проверяет что можно запускать DropOut
Вызывается внутри MouseMove события компонента
offset - отступ от рамки внутрь. Рекомендуется 10 пикселей.
Проще говоря задает отступ от рамки при котором разрешен DropOut
Код:
procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if df.MouseMoveDrop(Sender,Shift,X,Y,10) then // проверяем что запуск разрешен
df.DropOut(FileListBox1.Directory,FileListBox1.Items); // запускаем перетаскивание
end;
Можно написать любой свой обработчик