home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / VCL / DROPCLNT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  5KB  |  165 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira Visual Component Library 1.0                 }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Dropclnt;
  10.  
  11. { TDropClient component
  12.  
  13.   Allows Delphi programs to accept file drops from File Manager.
  14.   Another ubiquitous component, but I couldn't find a freeware one
  15.   with source code so I wrote my own.  Since I already had a handler
  16.   for Application.OnMessage, I decided against low level subclassing.
  17.   Consequently, you'll need to call TDropClient.CheckMessage inside
  18.   the OnMessage handler.
  19.  
  20.   Files : TStrings; (inherited, run-time only)
  21.     Contains a list of dropped files after another program has
  22.     dropped them.  This list is cleared before each drop if the
  23.     AutoClear property is True.
  24.  
  25.   AutoClear : Boolean (inherited)
  26.     Determines whether to clear the Files list before a drop.
  27.  
  28.   Handle : HWND (read and run-time only)
  29.     The window handle of the owning windowed control
  30.  
  31.   DropPos : TPoint (read and run-time only)
  32.     The coordinates of the last drop, in the coordinate system
  33.     of the owning windowed control (usually a TForm)
  34.  
  35.   OnDropFiles
  36.     When this event occurs, the Files property contains a list of
  37.     dropped files and DropPos contains the coordinates of the cursor
  38.     when the drop occured.
  39.  
  40.   CheckMessage(var Msg : TMsg; var Handled : Boolean);
  41.     You need to call this message in the application's OnMessage handler.
  42.     It checks an application message record to see if it is a file drop
  43.     message.  If so, the corresponding DropClient component is activated
  44.     to trigger the OnDropFiles event which you can handle.
  45.     Handled is set to True if the message has been processed.
  46. }
  47.  
  48. interface
  49.  
  50. uses
  51.   SysUtils, WinTypes, WinProcs, Messages, Classes, Controls, Forms,
  52.   Dialogs, DragDrop;
  53.  
  54. type
  55.   TDropClient = class(TDragDrop)
  56.   private
  57.     { Private declarations }
  58.     FDropPos     : TPoint;
  59.     FOnDropFiles : TNotifyEvent;
  60.     FHandle      : HWND;
  61.   protected
  62.     { Protected declarations }
  63.     procedure Loaded; override;
  64.     procedure ExtractFiles(Drop: THandle);
  65.   public
  66.     { Public declarations }
  67.     constructor Create(AOwner: TComponent); override;
  68.     destructor Destroy; override;
  69.     class procedure CheckMessage(var Msg: TMsg; var Handled: Boolean);
  70.     property  DropPos: TPoint read FDropPos;
  71.   published
  72.     { Published declarations }
  73.     property OnDropFiles: TNotifyEvent read FOnDropFiles write FOnDropFiles;
  74.     property Handle : HWND read FHandle;
  75.   end;
  76.  
  77. procedure Register;
  78.  
  79. implementation
  80.  
  81. uses ShellAPI;
  82.  
  83. var Clients : TList;
  84.  
  85. constructor TDropClient.Create(AOwner: TComponent);
  86. begin
  87.   if not (AOwner is TWinControl) then
  88.     raise EInvalidOperation.Create('A TDropClient must be owned by a windowed control');
  89.   inherited Create(AOwner);
  90.   Clients.Add(self);
  91. end;
  92.  
  93.  
  94. destructor TDropClient.Destroy;
  95. begin
  96.   Clients.Remove(self);
  97.   inherited Destroy;
  98. end;
  99.  
  100.  
  101. procedure TDropClient.ExtractFiles(drop: THandle);
  102. var
  103.   fcount : Integer;
  104.   i      : Integer;
  105.   s      : array[0..127] of Char;
  106. begin
  107.   if AutoClear then Files.Clear;
  108.   fcount := DragQueryFile(drop, Word(-1), @s, 127);
  109.   for i := 0 to fcount-1 do begin
  110.     DragQueryFile(drop, i, @s, 127);
  111.     Files.Add(Lowercase(StrPas(@s)));
  112.   end;
  113.   DragQueryPoint(drop, FDropPos);
  114.   DragFinish(drop);
  115.   if Assigned(FOnDropFiles) then FOnDropFiles(self);
  116. end;
  117.  
  118.  
  119. procedure TDropClient.Loaded;
  120. begin
  121.   inherited Loaded;
  122.   FHandle := (Owner as TWinControl).Handle;
  123.   DragAcceptFiles(FHandle, True);
  124. end;
  125.  
  126.  
  127. class procedure TDropClient.CheckMessage(var Msg: TMsg; var Handled: Boolean);
  128. var
  129.   i: Integer;
  130.   L: PPointerList;
  131. begin
  132.   if Msg.Message = WM_DROPFILES then begin
  133.     L := Clients.List;
  134.     for i := 0 to Clients.Count-1 do
  135.       with TDropClient(L^[i]) do
  136.       if Handle = Msg.HWnd then begin
  137.         try
  138.           ExtractFiles(Msg.wParam);
  139.         except
  140.           on E: Exception do Application.HandleException(E);
  141.         end;
  142.         Handled := True;
  143.         Exit;
  144.       end;
  145.   end;
  146. end;
  147.  
  148.  
  149. procedure Register;
  150. begin
  151.   RegisterComponents('Samples', [TDropClient]);
  152. end;
  153.  
  154.  
  155. procedure Done; far;
  156. begin
  157.   Clients.Free;
  158. end;
  159.  
  160.  
  161. initialization
  162.   Clients := TList.Create;
  163.   AddExitProc(Done);
  164. end.
  165.