Thursday, September 10, 2009

Enable file drop on a control?

Now this is cool, want to enable drag and drop files in you application on a TPanel or TForm? Look no further here's a component which does just that(can't remember from where I found this)
unit uDGDropSite;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ShellApi;

type
  TDGDropSite = class(TComponent)
  private
    FNameWithPath: TStrings;
    FNumDropped: Integer;
    FEnabled: Boolean;
    FWndHandle: HWND;
    FDefProc: Pointer;
    FWndProcInstance: Pointer;
    FOnDrop: TNotifyEvent;
    FDropPt: TPoint;
    FParentControl: TWinControl;
  private
    procedure DropFiles(hDropHandle: HDrop);
    procedure SetEnabled(Value: Boolean);
    procedure WndProc(var Msg: TMessage);
    procedure InitControl;
    procedure DestroyControl;
    procedure SetParentControl(Value : TWinControl);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Files: TStrings
      read FNameWithPath;
    property FileCount: Integer
      read FNumDropped;
    property DropPoint: TPoint
      read FDropPt;
    property EnableDrop: Boolean
      read FEnabled write SetEnabled;
    property DropControl: TWinControl
      read FParentControl write SetParentControl;
    property OnDrop: TNotifyEvent
      read FOnDrop write FOnDrop;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Delphigeist', [TDGDropSite]);
end;

constructor TDGDropSite.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNumDropped := 0;
  FNameWithPath := TStringList.Create;
  if AOwner is TWinControl then 
    SetParentControl(AOwner as TWinControl) else
    FWndHandle := 0;
  FDropPt.X := 0;
  FDropPt.Y := 0;
end;

destructor TDGDropSite.Destroy;
begin
  DestroyControl;
  SetEnabled(False);
  FNameWithPath.Free;
  inherited Destroy;
end;

procedure TDGDropSite.InitControl;
var
  WinCtl: TWinControl;
begin
  if FParentControl is TWinControl then begin
    WinCtl := TWinControl(FParentControl);
    FWndHandle := WinCtl.Handle;
    FWndProcInstance := MakeObjectInstance(WndProc);
    FDefProc := Pointer(GetWindowLong(FWndHandle, GWL_WNDPROC));
    SetWindowLong(FWndHandle, GWL_WNDPROC, Longint(FWndProcInstance));
  end else
  FEnabled := False;
end;

procedure TDGDropSite.DestroyControl;
begin
  if FWndHandle <> 0 then begin
    SetWindowLong(FWndHandle, GWL_WNDPROC, Longint(FDefProc));
    FreeObjectInstance(FWndProcInstance);
  end
end;
procedure TDGDropSite.SetParentControl(Value: TWinControl);
begin
  if Value = nil then begin
    SetWindowLong(FWndHandle, GWL_WNDPROC, Longint(FDefProc));
    FreeObjectInstance(FWndProcInstance);
    SetEnabled(False);
    FParentControl := nil;
    Exit;
  end else
    if Value<>FParentControl then begin
      FParentControl := Value;
      InitControl;
      SetEnabled(True);
    end;
end;
procedure TDGDropSite.SetEnabled(Value: Boolean);
begin
  if FParentControl = nil then
    Exit;
  FEnabled := Value;
  DragAcceptFiles(FWndHandle, FEnabled);
end;

procedure TDGDropSite.DropFiles(hDropHandle: HDrop);
var
  pszFileWithPath: PChar;
  iFile, iStrLen, iTempLen: Integer;
begin
  iStrLen := 128;
  pszFileWithPath := StrAlloc(iStrLen);
  iFile := 0;
  FNameWithPath.Clear;
  FNumDropped := DragQueryFile(hDropHandle, $FFFFFFFF, nil, iStrLen);
  DragQueryPoint(hDropHandle, FDropPt);
  while (iFile < FNumDropped) do begin
    iTempLen := DragQueryFile(hDropHandle, iFile, nil, 0) + 1;
    if (iTempLen > iStrLen) then begin
      iStrLen := iTempLen;
      StrDispose(pszFileWithPath);
      pszFileWithPath := StrAlloc(iStrLen);
    end;
    DragQueryFile(hDropHandle, iFile, pszFileWithPath, iStrLen);
    FNameWithPath.Add(StrPas(pszFileWithPath));
    Inc(iFile);
  end;
  StrDispose(pszFileWithPath);
  if Assigned(FOnDrop) then
    FOnDrop(Self);
end;

procedure TDGDropSite.WndProc(var Msg: TMessage);
begin
  with Msg do begin
    if Msg = WM_DROPFILES then
      DropFiles(HDrop(wParam)) else
      Result := CallWindowProc(FDefProc, FWndHandle, Msg, WParam, LParam);
    end;
end;

end.

When you add it on a form it will automatically add the form as a "Drop Site" for files, OnDrop will be triggered when one or more files are dropped on a designated control.
If you need the install package of this component you can get it from this link.

No comments:

Post a Comment

Blogroll(General programming and Delphi feeds)