本文根据EmailX45的视频文件,进行了优化改进,原文参见:Delphi: Drag and Drop Files from Explorer into TPanel / TMemo - YouTube
在Windows中,如果将选择的文件拖动到Delphi程序的控件上,有很多实现方法,特别是三方的成熟控件,但是这个方法最简单,无需使用第三方资源,简单使用windows API即可。
直接上代码入如下:
主窗体:
unit uDragFile_Form;interfaceusesWinapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,uMyPanelWithDropFileEvents,uMyMemoWithDropFileEvents;typeTForm4 = class(TForm)Panel1: TPanel;Memo1: TMemo;Label1: TLabel;GestureManager1: TGestureManager;procedure FormCreate(Sender: TObject);privateprocedure OnDraopFileToPanel(Sender : TObject; FileName : string); //重点,必须是这个类型 TOnDropFileprocedure OnDraopFileToMemo(Sender : TObject; FileName : string);public{ Public declarations }end;varForm4: TForm4;implementationusesWinapi.ShellAPI;{$R *.dfm}{ TForm4 }procedure TForm4.FormCreate(Sender: TObject);
beginPanel1.EnableFileDrop(OnDraopFileToPanel);Memo1.EnableFileDrop(OnDraopFileToMemo);end;procedure TForm4.OnDraopFileToMemo(Sender: TObject; FileName: string);
beginMemo1.Lines.Add(FileName);
end;procedure TForm4.OnDraopFileToPanel(Sender: TObject; FileName: string);
beginLabel1.Caption := Label1.Caption + sLineBreak + Filename;end;end.
以下两段代码分别是Panel和Memo的实现代码,需要在主窗体中引用。
{sensor 参考:https://www.youtube.com/watch?v=XaO0YWRcxMw
使用说明:
1. 主程序中引用这个单元
2. 主程序中必须定义 TOnDropFile 事件 ,例如: procedure OnDraopFileToPanel(Sender : TObject; FileName : string);
3. 主程序CreateForm中:Panel1.EnableFileDrop(OnDraopFileToPanel);4. 如果不需要拖动文件: DisableFileDrop2025-06-02
}
unit uMyPanelWithDropFileEvents;interface
usesWinapi.Messages,VCL.ExtCtrls;typeTOnDropFile = procedure(Sender : TObject; FileName : string) of Object;TPanel = class(VCL.ExtCtrls.TPanel)privateFOnDropFile : TOnDropFile;procedure DropFileEvent(var MSG : TWMDropFiles); message WM_DROPFILES;publicprocedure EnableFileDrop(FOnDrop: TOnDropFile);procedure DisableFileDrop;property OnDropFile : TOnDropFile read FOnDropFile write FOnDropFile;end;implementationusesWinapi.Windows,Winapi.ShellAPI;constMY_FILE_COUNTING = $FFFFFFFF;{ TPanel }procedure TPanel.DisableFileDrop;
beginDragAcceptFiles(Self.Handle,False);FOnDropFile := nil;
end;procedure TPanel.DropFileEvent(var MSG: TWMDropFiles);
varLFileCounting : Cardinal;LFileName : array[0..MAX_Path] of char;
beginLFileCounting := DragQueryFile(MSG.Drop,MY_FILE_COUNTING,LFileName, MAX_Path);if Assigned(FOnDropFile) thenbeginfor var i := 0 to LFileCounting - 1 dobeginDragQueryFile(MSG.Drop,i,LFileName, MAX_Path);FOnDropFile(Self, String(LFileName));end;end;DragFinish(MSG.Drop);
end;procedure TPanel.EnableFileDrop(FOnDrop: TOnDropFile);
beginDragAcceptFiles(Self.Handle,True);FOnDropFile := FOnDrop;
end;end.
Memo代码
unit uMyMemoWithDropFileEvents;interface
usesWinapi.Messages,VCL.StdCtrls;typeTOnDropFile = procedure(Sender : TObject; FileName : string) of Object;TMemo = class(VCL.StdCtrls.TMemo)privateFOnDropFile : TOnDropFile;procedure DropFileEvent(var MSG : TWMDropFiles); message WM_DROPFILES;publicprocedure EnableFileDrop(FOnDrop: TOnDropFile);procedure DisableFileDrop;property OnDropFile : TOnDropFile read FOnDropFile write FOnDropFile;end;implementationusesWinapi.Windows,Winapi.ShellAPI;constMY_FILE_COUNTING = $FFFFFFFF;{ TMemo }procedure TMemo.DisableFileDrop;
beginDragAcceptFiles(Self.Handle,False);FOnDropFile := nil;
end;procedure TMemo.DropFileEvent(var MSG: TWMDropFiles);
varLFileCounting : Cardinal;LFileName : array[0..MAX_Path] of char;
beginLFileCounting := DragQueryFile(MSG.Drop,MY_FILE_COUNTING,LFileName, MAX_Path);if Assigned(FOnDropFile) thenbeginfor var i := 0 to LFileCounting - 1 dobeginDragQueryFile(MSG.Drop,i,LFileName, MAX_Path);FOnDropFile(Self, String(LFileName));end;end;DragFinish(MSG.Drop);
end;procedure TMemo.EnableFileDrop(FOnDrop: TOnDropFile);
beginDragAcceptFiles(Self.Handle,True);FOnDropFile := FOnDrop;
end;end.