home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmFileDrop.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  7KB  |  250 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmFileDrop
  5. Purpose  : Allows for files to be dropped from the Shell on target WinControl
  6. Date     : 08-02-1997
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmFileDrop;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses
  18.   Windows, Messages, Classes, Controls, rmGlobalComponentHook;
  19.  
  20. type
  21.   TrmFileDrop = class(TComponent)
  22.   private
  23.     { Private declarations }
  24.     fXPoint: integer;
  25.     fYPoint: integer;
  26.     fFileList: tstringlist;
  27.     fOnFileDrop: TNotifyEvent;
  28.     fDropLocation: TWinControl;
  29.     fActive: boolean;
  30.     fNeedReactivate: TNotifyEvent;
  31.     procedure Activate;
  32.     procedure Deactivate;
  33.     procedure GetFileList(fhnd: integer);
  34.     procedure SetDropLocation(location: TWinControl);
  35.   protected
  36.     { Protected declarations }
  37.     OldWndProc: TFarProc;
  38.     NewWndProc: Pointer;
  39.     procedure HookWin;
  40.     procedure UnhookWin;
  41.     procedure Loaded; override;
  42.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  43.     function DropLocationHandle:THandle;
  44.   public
  45.     { Public declarations }
  46.     procedure HookWndProc(var AMsg: TMessage);
  47.     constructor Create(AOwner: TComponent); override;
  48.     destructor Destroy; override;
  49.     procedure ResetFileList;
  50.     procedure Reparented;
  51.     property Active : boolean read fActive default false;
  52.     property FileList: tstringlist read ffilelist;
  53.     property X: integer read fxpoint default -1;
  54.     property Y: integer read fypoint default -1;
  55.   published
  56.     { Published declarations }
  57.     property DropLocation: TWinControl read fDropLocation write SetDropLocation;
  58.     property OnFileDroped: TNotifyEvent read fOnFileDrop write fOnFileDrop;
  59.     property OnReactivateNeeded: TNotifyEvent read fNeedReactivate write fNeedReactivate;
  60.   end;
  61.  
  62. implementation
  63.  
  64. uses SysUtils, Forms, ShellAPI;
  65.  
  66. procedure TrmFileDrop.activate;
  67. begin
  68.   if (csDesigning in componentstate) then exit;
  69.   if fDropLocation = nil then exit;
  70.   if factive = true then exit;
  71.   if DropLocationHandle = 0 then exit;
  72.   DragAcceptFiles(DropLocationHandle, true);
  73.   Hookwin;
  74.   factive := true;
  75. end;
  76.  
  77. procedure TrmFileDrop.deactivate;
  78. begin
  79.   if (csDesigning in componentstate) then exit;
  80.   if fDropLocation = nil then exit;
  81.   if factive = false then exit;
  82.   if DropLocationHandle = 0 then exit;
  83.   DragAcceptFiles(DropLocationHandle, false);
  84.   unhookwin;
  85.   factive := false;
  86. end;
  87.  
  88. procedure TrmFileDrop.getfilelist(fhnd: integer);
  89. var
  90.   fname: pchar;
  91.   fnsize, fcount, index: integer;
  92.   fdroppoint: tpoint;
  93. begin
  94.   ffilelist.Clear;
  95.   DragQueryPoint(fhnd, fdroppoint);
  96.   fxpoint := fdroppoint.x;
  97.   fypoint := fdroppoint.y;
  98.   fcount := dragqueryfile(fhnd, $FFFFFFFF, nil, 0);
  99.   index := 0;
  100.   while index < fcount do
  101.   begin
  102.     fnsize := DragQueryFile(fhnd, index, nil, 0);
  103.     fname := stralloc(fnsize + 1);
  104.     DragQueryFile(fhnd, index, fname, fnsize + 1);
  105.     ffilelist.Add(strpas(fname));
  106.     strdispose(fname);
  107.     inc(index);
  108.   end;
  109.   dragfinish(fhnd);
  110. end;
  111.  
  112. procedure TrmFileDrop.SetDropLocation(location: TWinControl);
  113. begin
  114.   if location <> fdroplocation then
  115.   begin
  116.     fdroplocation := location;
  117.     deactivate;
  118.     activate;
  119.   end;
  120. end;
  121.  
  122. procedure TrmFileDrop.HookWin;
  123. begin
  124.   if csDesigning in componentstate then exit;
  125.   if not assigned(NewWndProc) then
  126.   begin
  127.     OldWndProc := TFarProc(GetWindowLong(DroplocationHandle, GWL_WNDPROC));
  128.     {$ifdef BD6}
  129.     NewWndProc := Classes.MakeObjectInstance(HookWndProc);
  130.     {$else}
  131.     NewWndProc := MakeObjectInstance(HookWndProc);
  132.     {$endif}
  133.     SetWindowLong(DroplocationHandle, GWL_WNDPROC, LongInt(NewWndProc));
  134.     PushOldProc(fDroplocation, OldWndProc);
  135.   end;
  136. end; { HookWin }
  137.  
  138. procedure TrmFileDrop.UnhookWin;
  139. begin
  140.   if csDesigning in componentstate then exit;
  141.   if assigned(NewWndProc) then
  142.   begin
  143.     SetWindowLong(DroplocationHandle, GWL_WNDPROC, LongInt(PopOldProc(fDroplocation)));
  144.     if assigned(NewWndProc) then
  145.     {$ifdef BD6}
  146.        Classes.FreeObjectInstance(NewWndProc);
  147.     {$else}
  148.        FreeObjectInstance(NewWndProc);
  149.     {$endif}
  150.     NewWndProc := nil;
  151.   end;
  152. end; { UnHookWin }
  153.  
  154. procedure TrmFileDrop.loaded;
  155. begin
  156.   inherited loaded;
  157.   activate;
  158. end;
  159.  
  160. procedure TrmFileDrop.HookWndProc(var AMsg: TMessage);
  161. begin
  162.   if (AMsg.msg = WM_Destroy) then
  163.   begin
  164.     Deactivate;
  165.     SendMessage(DropLocationHandle, AMsg.msg, AMsg.WParam, AMsg.LParam);
  166.     AMsg.Result := 1;
  167.     exit;
  168.   end;
  169.   if (AMsg.Msg = WM_DROPFILES) then
  170.   begin
  171.     if assigned(fonfiledrop) then
  172.     begin
  173.       getfilelist(AMsg.wparam);
  174.       fonfiledrop(self);
  175.     end;
  176.     AMsg.Result := 0;
  177.   end
  178.   else
  179.     AMsg.Result := CallWindowProc(OldWndProc, DropLocationHandle, AMsg.Msg, AMsg.wParam, AMsg.lParam);
  180. end; { HookWndProc }
  181.  
  182. constructor TrmFileDrop.Create(AOwner: TComponent);
  183. begin
  184.   inherited Create(AOwner);
  185.   ffilelist := tstringlist.create;
  186.   factive := false;
  187.   fdroplocation := nil;
  188. end;
  189.  
  190. destructor TrmFileDrop.Destroy;
  191. begin
  192.   ffilelist.free;
  193.   deactivate;
  194.   inherited destroy; {Call default processing.}
  195. end;
  196.  
  197. procedure TrmFileDrop.ResetFileList;
  198. begin
  199.   fFileList.Clear;
  200.   fxPoint := -1;
  201.   fyPoint := -1;
  202. end;
  203.  
  204. procedure TrmFileDrop.Reparented;
  205. begin
  206.   Deactivate;
  207.   Activate;
  208. end;
  209.  
  210. procedure TrmFileDrop.Notification(AComponent: TComponent;
  211.   Operation: TOperation);
  212. begin
  213.   inherited;
  214.   if aComponent = fDropLocation then
  215.   begin
  216.     if operation = opRemove then
  217.     begin
  218.       fDropLocation := nil;
  219.       if not (csDestroying in ComponentState) and assigned(fNeedReactivate) then
  220.         fNeedReactivate(self);
  221.     end;
  222.   end;
  223. end;
  224.  
  225. function TrmFileDrop.DropLocationHandle: THandle;
  226. begin
  227.    if assigned(FDropLocation) then
  228.    begin
  229.       if fDropLocation <> owner then
  230.          result := fDroplocation.handle
  231.       else
  232.       begin
  233.          if (fDropLocation is TForm) and (TForm(fDropLocation).FormStyle = fsMDIForm) then
  234.          begin
  235.             if TForm(fDroplocation).Clienthandle > 0 then
  236.                result := TForm(fDroplocation).Clienthandle
  237.             else
  238.                result := THandle(0);
  239.          end
  240.          else
  241.            result := fDroplocation.handle;
  242.       end;
  243.    end
  244.    else
  245.    result := THandle(0);
  246. end;
  247.  
  248. end.
  249.  
  250.