unit kDragTarget;
{
  Component for accepting original WinAPI Drag and Drop.

  Author:     Vesa Lappalainen, Kave Oy, vesal@mit.jyu.fi
  Date:       28.8.1999
  Copyright:  Kave Oy
              Component may be used for free, if the origin is mentioned
              somewhere in program documents.

  Usage:      Drop component to the form and choose the Window control for
              it.  If the form is choosed for target window, then the
              name of the form must be writen to the window (for some
              reason it is not in the selection list?)
  Properties: Window : TwinControl
                - window to accept dropping
              Accept : boolean
                - to accept or not dropping
              Name : string
                - name for the component
              DropName[i] : string (read only)
                - i's dropped name
              Count : integer      (read only)
                - number of dropped items
  Methods:    procedure AddTo(s:TStrings);
                - adds all the names dropped to the stringlist
  Events:     OnDrop : procedure(sender:TkDragTarget; pt:TPoint);
                - when something is dropped over the Window
                  sender - component that accepct the drop
                  pt     - point in senders Window where the mouse was
                           released

  Comments:
    Thanks to Mika Viskari for advise how to hook to Window Procedure.
    This component hooks to the Window's WindowProc (compare WinAPI)
    and the handles the message WM_DROPFILES.  The dropped names
    are collected in privite string list.  After the drop is done, the
    event OnDrop is called.

    If you want to do opposite way, so drag from Your application, then
    use Ander Melander's excellent Drag and Drop component Suite
    http://www.melander.dk.

    Example of the event handler:

      procedure TFormDrag.Target1Drop(Sender: TkDragTarget; pt:TPoint);
      var i:integer;
      begin
        for i := 0 to Sender.Count-1 do
          ListBoxNames.Items.Add(Sender.DropName[i]);
      end;

    Or this very usual ocassion can be even done with:

      procedure TFormDrag.Target1Drop(Sender: TkDragTarget; pt:TPoint);
      begin
        Sender.AddTo(ListBoxNames.Items);
      end;

}

interface

uses Classes,
{$ifdef CLX}
   QControls,
{$else}
   Windows,Controls,Messages,
{$endif}
   Types;

type

  TkDragTarget = class;
  TkDragTargetEvent = procedure(Sender:TkDragTarget; pt:TPoint) of object;

{$ifdef CLX}
  TkDragTarget = class(TComponent)
  private
    FWindow : TControl;
    FOnDrop : TkDragTargetEvent;
    FCount  : integer;
    FAccept : boolean;
    FDropName : TStrings;
  public
    property DropName : TStrings read FDropName;  
  published
    property Window : TControl read FWindow write FWindow;
    property OnDrop : TkDragTargetEvent read FOnDrop write FOnDrop;
    property Count  : integer read FCount;
    property Accept : boolean read FAccept write FAccept default true;
  end;
{$else}

  TkDragTarget = class(TComponent)
  private
    FWindow: TWinControl;
    FhWndWindow : hWnd;
    FOldWndProc : TFarProc;
    FNewWndProc : TFarProc;
    FOnDrop: TkDragTargetEvent;
    FNames : TStrings;
    FAccept: boolean;
    procedure SetWindow(const Value: TWinControl);
    procedure SetOnDrop(const Value: TkDragTargetEvent);
    function GetCount: integer;
    function GetDropName(i: integer): string;
    procedure SetAccept(const Value: boolean);
  protected
    procedure WindowProc(var M: TMessage);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  public
    constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;
    procedure AddTo(s:TStrings); virtual;
    property DropName[i:integer]:string read GetDropName;

  published
    property Window : TWinControl read FWindow write SetWindow;
    property OnDrop : TkDragTargetEvent read FOnDrop write SetOnDrop;
    property Count  : integer read GetCount;
    property Accept : boolean read FAccept write SetAccept default true;
  end;
{$endif}

  procedure Register;

implementation
{$ifdef CLX}
{$else}
uses
ShellApi, Forms,SysUtils;
{$endif}

procedure Register;
begin
  RegisterComponents('DragDrop',[TkDragTarget]);
end;

{$ifdef CLX}
{$else}

{ TkDragTarget }

procedure TkDragTarget.AddTo(s: TStrings);
begin
  s.AddStrings(FNames);
end;

constructor TkDragTarget.Create(AOwner: TComponent);
begin
  inherited;
  FNames := TStringList.Create;
  FAccept := true;
end;

destructor TkDragTarget.Destroy;
begin
  SetWindow(nil);   // Remove the hook
  if ( FNewWndProc <> nil ) then FreeObjectInstance(FNewWndProc);
  FNames.Free;
  inherited;
end;

function TkDragTarget.GetCount: integer;
begin
  Result := FNames.Count;
end;

function TkDragTarget.GetDropName(i: integer): string;
begin
  if ( i < 0 ) or ( Count <= i ) then Result := ''
  else Result := FNames[i];
end;

procedure TkDragTarget.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  If ( AComponent <> FWindow ) then exit;
  if ( Operation <> opRemove ) then exit;
  SetWindow(nil);
end;

procedure TkDragTarget.SetAccept(const Value: boolean);
begin
  FAccept := Value;
  if ( FhWndWindow <> 0 ) then DragAcceptFiles(FhWndWindow,Accept);
end;

procedure TkDragTarget.SetOnDrop(const Value: TkDragTargetEvent);
begin
  FOnDrop := Value;
end;

procedure TkDragTarget.SetWindow(const Value: TWinControl);
{ If there is a hook to the WndProc, it is first removed.
  Then if Window <> nil, the new hook is taken.
}
begin
{  if csDesigning in ComponentState then begin
    FWindow := Value;
    exit;
  end;
}
  if ( FhWndWindow <> 0 ) then DragAcceptFiles(FhWndWindow,false);

  if ( FOldWndProc <> nil ) and ( FhWndWindow <> 0 ) then begin
    SetWindowLong(FhWndWindow,GWL_WNDPROC,Integer(FOldWndProc));
  end;

  FOldWndProc := nil;
  FWindow := Value;
  FhWndWindow := 0;

  if ( FWindow = nil ) then exit;

  FhWndWindow := Window.Handle;

  if ( FNewWndProc = nil ) then FNewWndProc := MakeObjectInstance(WindowProc);

  FOldWndProc := TFarProc(GetWindowLong(FhWndWindow,GWL_WNDPROC));
  SetWindowLong(FhWndWindow,GWL_WNDPROC,Integer(FNewWndProc));
  DragAcceptFiles(FhWndWindow,Accept); // Needed so that the form accepts files
end;

procedure TkDragTarget.WindowProc(var M: TMessage);
var hd : HDROP; i,n:integer; name:string; pt : TPoint;
begin
  if ( Window = nil ) then exit;
  case M.Msg of
    WM_DROPFILES: begin
      hd := M.WParam;
      n := DragQueryFile(hd,UINT(-1),nil,0); // Get number of items
      FNames.Clear;
      for i:=0 to n-1 do begin
        SetLength(name,500);                 // Enough space for name
        DragQueryFile(hd,i,PChar(name),500); // Ask the next name
        name := StrPas(PChar(name));         // NULL-trem string to Pascal
        FNames.Add(name);                    // Add the name to list
      end;
      DragQueryPoint(hd,pt);
      DragFinish(hd);                        // Release the memory!
      if ( Assigned(FOnDrop) ) then OnDrop(self,pt);
      M.Result := 0;
      Exit;
    end;
  end;
  M.Result := CallWindowProc(FOldWndProc,FhWndWindow,M.Msg,M.WParam,M.LParam);
end;
{$endif}

end.