Title: Adding FileDrop capabilities to any visual control
Question: How to add FileDrop capabilities to any visual control?
Answer:
It is quite easy:
1. Derive new component from some existing visual component
2. Add File Drop message accepting
3. Add Event that should be fired when message is received
4. Use the control
-----/-----
1. Derive new component from some existing visual component
-From the Delphi main window select Component/New Component
-For the "Ancestor type" select required ancestor visual control; I'll select a TEdit
-Select some name for the new control. I've named mine TFileDropEdit
-Set other parameters as needed and select OK or Install if you wish to automatically install the component in the component palette.
2. Add File Drop message accepting
In the private section of the TFileDropEdit class declaration declare a procedure as follows:
procedure WMDROPFILES(var Message: TWMDROPFILES);message WM_DROPFILES;
This procedure will accept WM_DROPFILES messages from Windows. In this procedure we implement default actions that the class should do when receives this message, but also, if we want users of the control to have their action, then we have to implement an event to which they can hook. This event will be called from this procedure only if user has set an event handler.
Control must be registered with Windows so that it knows that the control can process WM_DROPFILES message. Registration and unregistration is done through DragAcceptFiles Windows function. Because it requires handle of the control, it cannot be implemented in the component's constructor (the component doesn't have a handle in that time and the handle cannot be obtained at that time according to the Delphi Help). Therefore additional class public property AcceptFiles will be defined that (un)registers the control for accepting files.
3. Add Event that should be fired when message is received
We want to give user in the event the list of all dropped files. Define the type of the event as follows:
TFileDropEvent = procedure(files:tstringlist) of object;
In the published section of the TFileDropEdit class declaration declare a property as follows:
property OnFileDrop:TFileDropEvent read FFileDrop write FFileDrop;
and in the private section add variable:
FFileDrop:TFileDropEvent;
The source of the whole control is below. Note that when created control does not accept dropped files until component user doesn't set it's AcceptFiles property to True;
unit FileDropEdit;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
ShellApi;
type
TFileDropEvent = procedure(files: tstringlist) of object;
TFileDropEdit = class(TEdit)
private
{ Private declarations }
FFileDrop: TFileDropEvent;
FAcceptFiles: Boolean;
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
procedure SetAcceptFiles(const Value: Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
property AcceptFiles: Boolean read FAcceptFiles write SetAcceptFiles;
published
{ Published declarations }
property OnFileDrop: TFileDropEvent read FFileDrop write FFileDrop;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TFileDropEdit]);
end;
constructor TFileDropEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner: TComponent);
FFileDrop := nil;
FAcceptFiles := False;
end;
procedure TFileDropEdit.WMDROPFILES(var Message: TWMDROPFILES);
var
NumFiles: integer;
buffer: array[0..255] of char;
i: integer;
l: TStringList;
begin
if Assigned(FFiledrop) then
begin
l := TStringList.Create;
NumFiles := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0); {thanks to Mike Heydon for D5 adjustment of parameters}
for i := 0 to NumFiles - 1 do {Accept the dropped file}
begin
DragQueryFile(Message.Drop, i, buffer, sizeof(buffer));
l.append(StrPas(buffer))
end;
FFileDrop(l);
l.free
end
end;
procedure TFileDropEdit.SetAcceptFiles(const Value: Boolean);
begin
if FAcceptFiles Value then
begin
FAcceptFiles := Value;
DragAcceptFiles(Handle, Value);
end
end;
end.