A
Another_eYes
Unregistered / Unconfirmed
GUEST, unregistred user!
使用很简单:
control属性填/选你要接收拖放操作的控件(比如Panel, Edit..., 如果是form的话需要手工写入form的Name)
设置Active = true
运行时拖放操作会触发OnDropFile事件。你可以在这个事件中操作所有拖放的文件。
另提供一个实用过程:GetPathFiles,该过程将某个目录下所有文件名取到一个StringList中(包括子目录下所有文件)
OnDropFile事件参数说明:
RootPath: 批量拖入的文件/目录的根目录
Files: 所有被拖进来的文件名(所有目录及子目录已经展开)
OriginFiles: 实际拖动操作拖入的文件/目录名(目录未展开)
unit DropLink;
interface
uses
windows, controls, SysUtils, Classes, Messages, ShellApi;
type
TDropFileEvent = procedure (Sender: TObject; RootPath: string; var Files, OriginFiles: TStringList) of object;
TDropLink = class(TComponent)
private
FCtrlWnd: TWndMethod;
FActive: Boolean;
FOnDropFile: TDropFileEvent;
FControl: TWinControl;
procedure SetActive(const Value: Boolean);
procedure SetControl(const Value: TWinControl);
protected
procedure NewWndProc(var Message: TMessage); virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Control: TWinControl read FControl write SetControl;
property Active: Boolean read FActive write SetActive;
property OnDropFile: TDropFileEvent read FOnDropFile write FOnDropFile;
end;
procedure GetPathFiles(ps: string; Lst: TStringList);
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TDropLink]);
end;
{ TDropLink }
constructor TDropLink.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TDropLink.Destroy;
begin
setcontrol(nil);
inherited;
end;
procedure TDropLink.Loaded;
begin
inherited;
if assigned(fcontrol) then
dragacceptfiles(fcontrol.Handle, factive);
end;
procedure GetPathFiles(ps: string; Lst: TStringList);
var
dt: _WIN32_FIND_DATAA;
h: Cardinal;
s: string;
begin
if ps[length(ps)] <> '/' then ps := ps + '/';
s := ps + '*.*';
h := findfirstfile(pchar(s), dt);
if h <> INVALID_HANDLE_VALUE then
begin
repeat
if (dt.cFileName[0] <> '.') then
if(dt.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
getPathFiles(ps+dt.cFileName, lst)
else lst.Add(ps+dt.cFileName);
until not findnextfile(h, dt);
windows.FindClose(h);
end;
end;
procedure TDropLink.NewWndProc(var Message: TMessage);
var
FName: array [0..261] of char;
i, n: Integer;
lst, lst1: TStringList;
path, s: string;
begin
if message.Msg = WM_DROPFILES then
begin
path := '';
message.Result := 0;
if assigned(fondropfile) then
begin
n := -1;
lst := TStringList.Create;
lst1 := TStringList.Create;
n := dragqueryfile(message.WParam, n, pchar(@fname), 262);
for i := 0 to n - 1 do
begin
dragqueryfile(message.WParam, i, pchar(@fname), 262);
s := fname;
if path = '' then
path := extractfilepath(s);
lst1.Add(s);
if directoryexists(s) then
getpathfiles(s, lst)
else lst.Add(s);
end;
dragfinish(message.WParam);
fondropfile(self, path, lst, lst1);
if lst <> nil then
lst.Free;
if lst1<>nil then
lst1.Free;
end;
end
else fctrlwnd(message);
end;
procedure TDropLink.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if (operation = opRemove) and (acomponent = fcontrol) then
setcontrol(nil);
inherited;
end;
procedure TDropLink.SetActive(const Value: Boolean);
begin
if FActive <> Value then
begin
FActive := Value;
if (fcontrol<>nil) and fcontrol.HandleAllocated then
dragacceptfiles(fcontrol.Handle, value);
end;
end;
procedure TDropLink.SetControl(const Value: TWinControl);
begin
if FControl <> Value then
begin
if fcontrol <> nil then
begin
if fcontrol.HandleAllocated then
dragacceptfiles(fcontrol.Handle, false);
fcontrol.WindowProc := fctrlwnd;
fctrlwnd := nil;
end;
FControl := Value;
if assigned(fcontrol) then
begin
fctrlwnd := fcontrol.WindowProc;
fcontrol.WindowProc := NewWndProc;
if fcontrol.HandleAllocated and factive then
dragacceptfiles(fcontrol.Handle, true);
end;
end;
end;
end.
control属性填/选你要接收拖放操作的控件(比如Panel, Edit..., 如果是form的话需要手工写入form的Name)
设置Active = true
运行时拖放操作会触发OnDropFile事件。你可以在这个事件中操作所有拖放的文件。
另提供一个实用过程:GetPathFiles,该过程将某个目录下所有文件名取到一个StringList中(包括子目录下所有文件)
OnDropFile事件参数说明:
RootPath: 批量拖入的文件/目录的根目录
Files: 所有被拖进来的文件名(所有目录及子目录已经展开)
OriginFiles: 实际拖动操作拖入的文件/目录名(目录未展开)
unit DropLink;
interface
uses
windows, controls, SysUtils, Classes, Messages, ShellApi;
type
TDropFileEvent = procedure (Sender: TObject; RootPath: string; var Files, OriginFiles: TStringList) of object;
TDropLink = class(TComponent)
private
FCtrlWnd: TWndMethod;
FActive: Boolean;
FOnDropFile: TDropFileEvent;
FControl: TWinControl;
procedure SetActive(const Value: Boolean);
procedure SetControl(const Value: TWinControl);
protected
procedure NewWndProc(var Message: TMessage); virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Control: TWinControl read FControl write SetControl;
property Active: Boolean read FActive write SetActive;
property OnDropFile: TDropFileEvent read FOnDropFile write FOnDropFile;
end;
procedure GetPathFiles(ps: string; Lst: TStringList);
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TDropLink]);
end;
{ TDropLink }
constructor TDropLink.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TDropLink.Destroy;
begin
setcontrol(nil);
inherited;
end;
procedure TDropLink.Loaded;
begin
inherited;
if assigned(fcontrol) then
dragacceptfiles(fcontrol.Handle, factive);
end;
procedure GetPathFiles(ps: string; Lst: TStringList);
var
dt: _WIN32_FIND_DATAA;
h: Cardinal;
s: string;
begin
if ps[length(ps)] <> '/' then ps := ps + '/';
s := ps + '*.*';
h := findfirstfile(pchar(s), dt);
if h <> INVALID_HANDLE_VALUE then
begin
repeat
if (dt.cFileName[0] <> '.') then
if(dt.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
getPathFiles(ps+dt.cFileName, lst)
else lst.Add(ps+dt.cFileName);
until not findnextfile(h, dt);
windows.FindClose(h);
end;
end;
procedure TDropLink.NewWndProc(var Message: TMessage);
var
FName: array [0..261] of char;
i, n: Integer;
lst, lst1: TStringList;
path, s: string;
begin
if message.Msg = WM_DROPFILES then
begin
path := '';
message.Result := 0;
if assigned(fondropfile) then
begin
n := -1;
lst := TStringList.Create;
lst1 := TStringList.Create;
n := dragqueryfile(message.WParam, n, pchar(@fname), 262);
for i := 0 to n - 1 do
begin
dragqueryfile(message.WParam, i, pchar(@fname), 262);
s := fname;
if path = '' then
path := extractfilepath(s);
lst1.Add(s);
if directoryexists(s) then
getpathfiles(s, lst)
else lst.Add(s);
end;
dragfinish(message.WParam);
fondropfile(self, path, lst, lst1);
if lst <> nil then
lst.Free;
if lst1<>nil then
lst1.Free;
end;
end
else fctrlwnd(message);
end;
procedure TDropLink.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if (operation = opRemove) and (acomponent = fcontrol) then
setcontrol(nil);
inherited;
end;
procedure TDropLink.SetActive(const Value: Boolean);
begin
if FActive <> Value then
begin
FActive := Value;
if (fcontrol<>nil) and fcontrol.HandleAllocated then
dragacceptfiles(fcontrol.Handle, value);
end;
end;
procedure TDropLink.SetControl(const Value: TWinControl);
begin
if FControl <> Value then
begin
if fcontrol <> nil then
begin
if fcontrol.HandleAllocated then
dragacceptfiles(fcontrol.Handle, false);
fcontrol.WindowProc := fctrlwnd;
fctrlwnd := nil;
end;
FControl := Value;
if assigned(fcontrol) then
begin
fctrlwnd := fcontrol.WindowProc;
fcontrol.WindowProc := NewWndProc;
if fcontrol.HandleAllocated and factive then
dragacceptfiles(fcontrol.Handle, true);
end;
end;
end;
end.