DragDropFile.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859
  1. unit DragDropFile;
  2. // -----------------------------------------------------------------------------
  3. // Project: Drag and Drop Component Suite.
  4. // Module: DragDropFile
  5. // Description: Implements Dragging and Dropping of files and folders.
  6. // Version: 4.0
  7. // Date: 18-MAY-2001
  8. // Target: Win32, Delphi 5-6
  9. // Authors: Anders Melander, anders@melander.dk, http://www.melander.dk
  10. // Copyright © 1997-2001 Angus Johnson & Anders Melander
  11. // -----------------------------------------------------------------------------
  12. interface
  13. uses
  14. DragDrop,
  15. DropTarget,
  16. DropSource,
  17. DragDropFormats,
  18. ActiveX,
  19. Windows,
  20. Classes;
  21. type
  22. ////////////////////////////////////////////////////////////////////////////////
  23. //
  24. // TFileClipboardFormat
  25. //
  26. ////////////////////////////////////////////////////////////////////////////////
  27. TFileClipboardFormat = class(TCustomSimpleClipboardFormat)
  28. private
  29. FFiles: TStrings;
  30. protected
  31. function ReadData(Value: pointer; Size: integer): boolean; override;
  32. function WriteData(Value: pointer; Size: integer): boolean; override;
  33. function GetSize: integer; override;
  34. public
  35. constructor Create; override;
  36. destructor Destroy; override;
  37. function GetClipboardFormat: TClipFormat; override;
  38. function Assign(Source: TCustomDataFormat): boolean; override;
  39. function AssignTo(Dest: TCustomDataFormat): boolean; override;
  40. procedure Clear; override;
  41. function HasData: boolean; override;
  42. property Files: TStrings read FFiles;
  43. end;
  44. ////////////////////////////////////////////////////////////////////////////////
  45. //
  46. // TFilenameClipboardFormat
  47. //
  48. ////////////////////////////////////////////////////////////////////////////////
  49. TFilenameClipboardFormat = class(TCustomTextClipboardFormat)
  50. public
  51. function GetClipboardFormat: TClipFormat; override;
  52. function Assign(Source: TCustomDataFormat): boolean; override;
  53. function AssignTo(Dest: TCustomDataFormat): boolean; override;
  54. property Filename: string read GetString write SetString;
  55. end;
  56. ////////////////////////////////////////////////////////////////////////////////
  57. //
  58. // TFilenameWClipboardFormat
  59. //
  60. ////////////////////////////////////////////////////////////////////////////////
  61. TFilenameWClipboardFormat = class(TCustomWideTextClipboardFormat)
  62. public
  63. function GetClipboardFormat: TClipFormat; override;
  64. function Assign(Source: TCustomDataFormat): boolean; override;
  65. function AssignTo(Dest: TCustomDataFormat): boolean; override;
  66. property Filename: WideString read GetText write SetText;
  67. end;
  68. ////////////////////////////////////////////////////////////////////////////////
  69. //
  70. // TFilenameMapClipboardFormat
  71. //
  72. ////////////////////////////////////////////////////////////////////////////////
  73. // DONE -oanme -cStopShip : Rename TFilenameMapClipboardFormat to TFilenameMapClipboardFormat. Also wide version.
  74. TFilenameMapClipboardFormat = class(TCustomSimpleClipboardFormat)
  75. private
  76. FFileMaps : TStrings;
  77. protected
  78. function ReadData(Value: pointer; Size: integer): boolean; override;
  79. function WriteData(Value: pointer; Size: integer): boolean; override;
  80. function GetSize: integer; override;
  81. public
  82. constructor Create; override;
  83. destructor Destroy; override;
  84. function GetClipboardFormat: TClipFormat; override;
  85. procedure Clear; override;
  86. function HasData: boolean; override;
  87. property FileMaps: TStrings read FFileMaps;
  88. end;
  89. ////////////////////////////////////////////////////////////////////////////////
  90. //
  91. // TFilenameMapWClipboardFormat
  92. //
  93. ////////////////////////////////////////////////////////////////////////////////
  94. TFilenameMapWClipboardFormat = class(TCustomSimpleClipboardFormat)
  95. private
  96. FFileMaps : TStrings;
  97. protected
  98. function ReadData(Value: pointer; Size: integer): boolean; override;
  99. function WriteData(Value: pointer; Size: integer): boolean; override;
  100. function GetSize: integer; override;
  101. public
  102. constructor Create; override;
  103. destructor Destroy; override;
  104. function GetClipboardFormat: TClipFormat; override;
  105. procedure Clear; override;
  106. function HasData: boolean; override;
  107. property FileMaps: TStrings read FFileMaps;
  108. end;
  109. ////////////////////////////////////////////////////////////////////////////////
  110. //
  111. // TFileMapDataFormat
  112. //
  113. ////////////////////////////////////////////////////////////////////////////////
  114. TFileMapDataFormat = class(TCustomDataFormat)
  115. private
  116. FFileMaps : TStrings;
  117. public
  118. constructor Create(AOwner: TDragDropComponent); override;
  119. destructor Destroy; override;
  120. function Assign(Source: TClipboardFormat): boolean; override;
  121. function AssignTo(Dest: TClipboardFormat): boolean; override;
  122. procedure Clear; override;
  123. function HasData: boolean; override;
  124. function NeedsData: boolean; override;
  125. property FileMaps: TStrings read FFileMaps;
  126. end;
  127. ////////////////////////////////////////////////////////////////////////////////
  128. //
  129. // TFileDataFormat
  130. //
  131. ////////////////////////////////////////////////////////////////////////////////
  132. TFileDataFormat = class(TCustomDataFormat)
  133. private
  134. FFiles : TStrings;
  135. protected
  136. public
  137. constructor Create(AOwner: TDragDropComponent); override;
  138. destructor Destroy; override;
  139. function Assign(Source: TClipboardFormat): boolean; override;
  140. function AssignTo(Dest: TClipboardFormat): boolean; override;
  141. procedure Clear; override;
  142. function HasData: boolean; override;
  143. function NeedsData: boolean; override;
  144. property Files: TStrings read FFiles;
  145. end;
  146. ////////////////////////////////////////////////////////////////////////////////
  147. //
  148. // TDropFileTarget
  149. //
  150. ////////////////////////////////////////////////////////////////////////////////
  151. TDropFileTarget = class(TCustomDropMultiTarget)
  152. private
  153. FFileFormat : TFileDataFormat;
  154. FFileMapFormat : TFileMapDataFormat;
  155. protected
  156. function GetFiles: TStrings;
  157. function GetMappedNames: TStrings;
  158. function GetPreferredDropEffect: LongInt; override;
  159. public
  160. constructor Create(AOwner: TComponent); override;
  161. destructor Destroy; override;
  162. property Files: TStrings read GetFiles;
  163. property MappedNames: TStrings read GetMappedNames;
  164. end;
  165. ////////////////////////////////////////////////////////////////////////////////
  166. //
  167. // TDropFileSource
  168. //
  169. ////////////////////////////////////////////////////////////////////////////////
  170. TDropFileSource = class(TCustomDropMultiSource)
  171. private
  172. FFileFormat : TFileDataFormat;
  173. FFileMapFormat : TFileMapDataFormat;
  174. function GetFiles: TStrings;
  175. function GetMappedNames: TStrings;
  176. protected
  177. procedure SetFiles(AFiles: TStrings);
  178. procedure SetMappedNames(ANames: TStrings);
  179. public
  180. constructor Create(aOwner: TComponent); override;
  181. destructor Destroy; override;
  182. published
  183. property Files: TStrings read GetFiles write SetFiles;
  184. // MappedNames is only needed if files need to be renamed during a drag op.
  185. // E.g. dragging from 'Recycle Bin'.
  186. property MappedNames: TStrings read GetMappedNames write SetMappedNames;
  187. end;
  188. ////////////////////////////////////////////////////////////////////////////////
  189. //
  190. // Component registration
  191. //
  192. ////////////////////////////////////////////////////////////////////////////////
  193. procedure Register;
  194. ////////////////////////////////////////////////////////////////////////////////
  195. //
  196. // Misc.
  197. //
  198. ////////////////////////////////////////////////////////////////////////////////
  199. function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean; // V4: renamed
  200. function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
  201. function ReadFilesFromZeroList(Data: pointer; Size: integer;
  202. Wide: boolean; Files: TStrings): boolean;
  203. function WriteFilesToZeroList(Data: pointer; Size: integer;
  204. Wide: boolean; Files: TStrings): boolean;
  205. ////////////////////////////////////////////////////////////////////////////////
  206. ////////////////////////////////////////////////////////////////////////////////
  207. //
  208. // IMPLEMENTATION
  209. //
  210. ////////////////////////////////////////////////////////////////////////////////
  211. ////////////////////////////////////////////////////////////////////////////////
  212. implementation
  213. uses
  214. DragDropPIDL,
  215. SysUtils,
  216. ShlObj;
  217. ////////////////////////////////////////////////////////////////////////////////
  218. //
  219. // Component registration
  220. //
  221. ////////////////////////////////////////////////////////////////////////////////
  222. procedure Register;
  223. begin
  224. RegisterComponents(DragDropComponentPalettePage, [TDropFileTarget,
  225. TDropFileSource]);
  226. end;
  227. ////////////////////////////////////////////////////////////////////////////////
  228. //
  229. // Utilities
  230. //
  231. ////////////////////////////////////////////////////////////////////////////////
  232. function ReadFilesFromHGlobal(const HGlob: HGlobal; Files: TStrings): boolean;
  233. var
  234. DropFiles : PDropFiles;
  235. begin
  236. DropFiles := PDropFiles(GlobalLock(HGlob));
  237. try
  238. Result := ReadFilesFromData(DropFiles, GlobalSize(HGlob), Files)
  239. finally
  240. GlobalUnlock(HGlob);
  241. end;
  242. end;
  243. function ReadFilesFromData(Data: pointer; Size: integer; Files: TStrings): boolean;
  244. var
  245. Wide : boolean;
  246. begin
  247. Files.Clear;
  248. if (Data <> nil) then
  249. begin
  250. Wide := PDropFiles(Data)^.fWide;
  251. dec(Size, PDropFiles(Data)^.pFiles);
  252. inc(PChar(Data), PDropFiles(Data)^.pFiles);
  253. ReadFilesFromZeroList(Data, Size, Wide, Files);
  254. end;
  255. Result := (Files.Count > 0);
  256. end;
  257. function ReadFilesFromZeroList(Data: pointer; Size: integer;
  258. Wide: boolean; Files: TStrings): boolean;
  259. var
  260. StringSize : integer;
  261. begin
  262. Result := False;
  263. if (Data <> nil) then
  264. while (Size > 0) and (PChar(Data)^ <> #0) do
  265. begin
  266. if (Wide) then
  267. begin
  268. Files.Add(PWideChar(Data));
  269. StringSize := (Length(PWideChar(Data)) + 1) * 2;
  270. end else
  271. begin
  272. Files.Add(PChar(Data));
  273. StringSize := Length(PChar(Data)) + 1;
  274. end;
  275. inc(PChar(Data), StringSize);
  276. dec(Size, StringSize);
  277. Result := True;
  278. end;
  279. end;
  280. function WriteFilesToZeroList(Data: pointer; Size: integer;
  281. Wide: boolean; Files: TStrings): boolean;
  282. var
  283. i : integer;
  284. begin
  285. Result := False;
  286. if (Data <> nil) then
  287. begin
  288. i := 0;
  289. dec(Size);
  290. while (Size > 0) and (i < Files.Count) do
  291. begin
  292. if (Wide) then
  293. begin
  294. StringToWideChar(Files[i], Data, Size);
  295. dec(Size, (Length(Files[i])+1)*2);
  296. end else
  297. begin
  298. StrPLCopy(Data, Files[i], Size);
  299. dec(Size, Length(Files[i])+1);
  300. end;
  301. inc(PChar(Data), Length(Files[i])+1);
  302. inc(i);
  303. Result := True;
  304. end;
  305. // Final teminating zero.
  306. if (Size >= 0) then
  307. PChar(Data)^ := #0;
  308. end;
  309. end;
  310. ////////////////////////////////////////////////////////////////////////////////
  311. //
  312. // TFileClipboardFormat
  313. //
  314. ////////////////////////////////////////////////////////////////////////////////
  315. constructor TFileClipboardFormat.Create;
  316. begin
  317. inherited Create;
  318. FFiles := TStringList.Create;
  319. // Note: Setting dwAspect to DVASPECT_SHORT will request that the data source
  320. // returns the file names in short (8.3) format.
  321. // FFormatEtc.dwAspect := DVASPECT_SHORT;
  322. end;
  323. destructor TFileClipboardFormat.Destroy;
  324. begin
  325. FFiles.Free;
  326. inherited Destroy;
  327. end;
  328. function TFileClipboardFormat.GetClipboardFormat: TClipFormat;
  329. begin
  330. Result := CF_HDROP;
  331. end;
  332. procedure TFileClipboardFormat.Clear;
  333. begin
  334. FFiles.Clear;
  335. end;
  336. function TFileClipboardFormat.HasData: boolean;
  337. begin
  338. Result := (FFiles.Count > 0);
  339. end;
  340. function TFileClipboardFormat.GetSize: integer;
  341. var
  342. i : integer;
  343. begin
  344. Result := SizeOf(TDropFiles) + FFiles.Count + 1;
  345. for i := 0 to FFiles.Count-1 do
  346. inc(Result, Length(FFiles[i]));
  347. end;
  348. function TFileClipboardFormat.ReadData(Value: pointer;
  349. Size: integer): boolean;
  350. begin
  351. Result := (Size > SizeOf(TDropFiles));
  352. if (not Result) then
  353. exit;
  354. Result := ReadFilesFromData(Value, Size, FFiles);
  355. end;
  356. function TFileClipboardFormat.WriteData(Value: pointer;
  357. Size: integer): boolean;
  358. begin
  359. Result := (Size > SizeOf(TDropFiles));
  360. if (not Result) then
  361. exit;
  362. PDropFiles(Value)^.pfiles := SizeOf(TDropFiles);
  363. PDropFiles(Value)^.fwide := False;
  364. inc(PChar(Value), SizeOf(TDropFiles));
  365. dec(Size, SizeOf(TDropFiles));
  366. WriteFilesToZeroList(Value, Size, False, FFiles);
  367. end;
  368. function TFileClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
  369. begin
  370. if (Source is TFileDataFormat) then
  371. begin
  372. FFiles.Assign(TFileDataFormat(Source).Files);
  373. Result := True;
  374. end else
  375. Result := inherited Assign(Source);
  376. end;
  377. function TFileClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
  378. begin
  379. if (Dest is TFileDataFormat) then
  380. begin
  381. TFileDataFormat(Dest).Files.Assign(FFiles);
  382. Result := True;
  383. end else
  384. Result := inherited AssignTo(Dest);
  385. end;
  386. ////////////////////////////////////////////////////////////////////////////////
  387. //
  388. // TFilenameClipboardFormat
  389. //
  390. ////////////////////////////////////////////////////////////////////////////////
  391. var
  392. CF_FILENAMEA: TClipFormat = 0;
  393. function TFilenameClipboardFormat.GetClipboardFormat: TClipFormat;
  394. begin
  395. if (CF_FILENAMEA = 0) then
  396. CF_FILENAMEA := RegisterClipboardFormat(CFSTR_FILENAMEA);
  397. Result := CF_FILENAMEA;
  398. end;
  399. function TFilenameClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
  400. begin
  401. if (Source is TFileDataFormat) then
  402. begin
  403. Result := (TFileDataFormat(Source).Files.Count > 0);
  404. if (Result) then
  405. Filename := TFileDataFormat(Source).Files[0];
  406. end else
  407. Result := inherited Assign(Source);
  408. end;
  409. function TFilenameClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
  410. begin
  411. if (Dest is TFileDataFormat) then
  412. begin
  413. TFileDataFormat(Dest).Files.Add(Filename);
  414. Result := True;
  415. end else
  416. Result := inherited AssignTo(Dest);
  417. end;
  418. ////////////////////////////////////////////////////////////////////////////////
  419. //
  420. // TFilenameWClipboardFormat
  421. //
  422. ////////////////////////////////////////////////////////////////////////////////
  423. var
  424. CF_FILENAMEW: TClipFormat = 0;
  425. function TFilenameWClipboardFormat.GetClipboardFormat: TClipFormat;
  426. begin
  427. if (CF_FILENAMEW = 0) then
  428. CF_FILENAMEW := RegisterClipboardFormat(CFSTR_FILENAMEW);
  429. Result := CF_FILENAMEW;
  430. end;
  431. function TFilenameWClipboardFormat.Assign(Source: TCustomDataFormat): boolean;
  432. begin
  433. if (Source is TFileDataFormat) then
  434. begin
  435. Result := (TFileDataFormat(Source).Files.Count > 0);
  436. if (Result) then
  437. Filename := TFileDataFormat(Source).Files[0];
  438. end else
  439. Result := inherited Assign(Source);
  440. end;
  441. function TFilenameWClipboardFormat.AssignTo(Dest: TCustomDataFormat): boolean;
  442. begin
  443. if (Dest is TFileDataFormat) then
  444. begin
  445. TFileDataFormat(Dest).Files.Add(Filename);
  446. Result := True;
  447. end else
  448. Result := inherited AssignTo(Dest);
  449. end;
  450. ////////////////////////////////////////////////////////////////////////////////
  451. //
  452. // TFilenameMapClipboardFormat
  453. //
  454. ////////////////////////////////////////////////////////////////////////////////
  455. var
  456. CF_FILENAMEMAP: TClipFormat = 0;
  457. constructor TFilenameMapClipboardFormat.Create;
  458. begin
  459. inherited Create;
  460. FFileMaps := TStringList.Create;
  461. end;
  462. destructor TFilenameMapClipboardFormat.Destroy;
  463. begin
  464. FFileMaps.Free;
  465. inherited Destroy;
  466. end;
  467. function TFilenameMapClipboardFormat.GetClipboardFormat: TClipFormat;
  468. begin
  469. if (CF_FILENAMEMAP = 0) then
  470. CF_FILENAMEMAP := RegisterClipboardFormat(CFSTR_FILENAMEMAPA);
  471. Result := CF_FILENAMEMAP;
  472. end;
  473. procedure TFilenameMapClipboardFormat.Clear;
  474. begin
  475. FFileMaps.Clear;
  476. end;
  477. function TFilenameMapClipboardFormat.HasData: boolean;
  478. begin
  479. Result := (FFileMaps.Count > 0);
  480. end;
  481. function TFilenameMapClipboardFormat.GetSize: integer;
  482. var
  483. i : integer;
  484. begin
  485. Result := FFileMaps.Count + 1;
  486. for i := 0 to FFileMaps.Count-1 do
  487. inc(Result, Length(FFileMaps[i]));
  488. end;
  489. function TFilenameMapClipboardFormat.ReadData(Value: pointer;
  490. Size: integer): boolean;
  491. begin
  492. Result := ReadFilesFromZeroList(Value, Size, False, FFileMaps);
  493. end;
  494. function TFilenameMapClipboardFormat.WriteData(Value: pointer;
  495. Size: integer): boolean;
  496. begin
  497. Result := WriteFilesToZeroList(Value, Size, False, FFileMaps);
  498. end;
  499. ////////////////////////////////////////////////////////////////////////////////
  500. //
  501. // TFilenameMapWClipboardFormat
  502. //
  503. ////////////////////////////////////////////////////////////////////////////////
  504. var
  505. CF_FILENAMEMAPW: TClipFormat = 0;
  506. constructor TFilenameMapWClipboardFormat.Create;
  507. begin
  508. inherited Create;
  509. FFileMaps := TStringList.Create;
  510. end;
  511. destructor TFilenameMapWClipboardFormat.Destroy;
  512. begin
  513. FFileMaps.Free;
  514. inherited Destroy;
  515. end;
  516. function TFilenameMapWClipboardFormat.GetClipboardFormat: TClipFormat;
  517. begin
  518. if (CF_FILENAMEMAPW = 0) then
  519. CF_FILENAMEMAPW := RegisterClipboardFormat(CFSTR_FILENAMEMAPW);
  520. Result := CF_FILENAMEMAPW;
  521. end;
  522. procedure TFilenameMapWClipboardFormat.Clear;
  523. begin
  524. FFileMaps.Clear;
  525. end;
  526. function TFilenameMapWClipboardFormat.HasData: boolean;
  527. begin
  528. Result := (FFileMaps.Count > 0);
  529. end;
  530. function TFilenameMapWClipboardFormat.GetSize: integer;
  531. var
  532. i : integer;
  533. begin
  534. Result := FFileMaps.Count + 1;
  535. for i := 0 to FFileMaps.Count-1 do
  536. inc(Result, Length(FFileMaps[i]));
  537. inc(Result, Result);
  538. end;
  539. function TFilenameMapWClipboardFormat.ReadData(Value: pointer;
  540. Size: integer): boolean;
  541. begin
  542. Result := ReadFilesFromZeroList(Value, Size, True, FFileMaps);
  543. end;
  544. function TFilenameMapWClipboardFormat.WriteData(Value: pointer;
  545. Size: integer): boolean;
  546. begin
  547. Result := WriteFilesToZeroList(Value, Size, True, FFileMaps);
  548. end;
  549. ////////////////////////////////////////////////////////////////////////////////
  550. //
  551. // TFileMapDataFormat
  552. //
  553. ////////////////////////////////////////////////////////////////////////////////
  554. constructor TFileMapDataFormat.Create(AOwner: TDragDropComponent);
  555. begin
  556. inherited Create(AOwner);
  557. FFileMaps := TStringList.Create;
  558. TStringList(FFileMaps).OnChanging := DoOnChanging;
  559. end;
  560. destructor TFileMapDataFormat.Destroy;
  561. begin
  562. FFileMaps.Free;
  563. inherited Destroy;
  564. end;
  565. function TFileMapDataFormat.Assign(Source: TClipboardFormat): boolean;
  566. begin
  567. Result := True;
  568. if (Source is TFilenameMapClipboardFormat) then
  569. FFileMaps.Assign(TFilenameMapClipboardFormat(Source).FileMaps)
  570. else if (Source is TFilenameMapWClipboardFormat) then
  571. FFileMaps.Assign(TFilenameMapWClipboardFormat(Source).FileMaps)
  572. else
  573. Result := inherited Assign(Source);
  574. end;
  575. function TFileMapDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
  576. begin
  577. Result := True;
  578. if (Dest is TFilenameMapClipboardFormat) then
  579. TFilenameMapClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
  580. else if (Dest is TFilenameMapWClipboardFormat) then
  581. TFilenameMapWClipboardFormat(Dest).FileMaps.Assign(FFileMaps)
  582. else
  583. Result := inherited AssignTo(Dest);
  584. end;
  585. procedure TFileMapDataFormat.Clear;
  586. begin
  587. FFileMaps.Clear;
  588. end;
  589. function TFileMapDataFormat.HasData: boolean;
  590. begin
  591. Result := (FFileMaps.Count > 0);
  592. end;
  593. function TFileMapDataFormat.NeedsData: boolean;
  594. begin
  595. Result := (FFileMaps.Count = 0);
  596. end;
  597. ////////////////////////////////////////////////////////////////////////////////
  598. //
  599. // TFileDataFormat
  600. //
  601. ////////////////////////////////////////////////////////////////////////////////
  602. constructor TFileDataFormat.Create(AOwner: TDragDropComponent);
  603. begin
  604. inherited Create(AOwner);
  605. FFiles := TStringList.Create;
  606. TStringList(FFiles).OnChanging := DoOnChanging;
  607. end;
  608. destructor TFileDataFormat.Destroy;
  609. begin
  610. FFiles.Free;
  611. inherited Destroy;
  612. end;
  613. function TFileDataFormat.Assign(Source: TClipboardFormat): boolean;
  614. begin
  615. Result := True;
  616. if (Source is TFileClipboardFormat) then
  617. FFiles.Assign(TFileClipboardFormat(Source).Files)
  618. else if (Source is TPIDLClipboardFormat) then
  619. FFiles.Assign(TPIDLClipboardFormat(Source).Filenames)
  620. else
  621. Result := inherited Assign(Source);
  622. end;
  623. function TFileDataFormat.AssignTo(Dest: TClipboardFormat): boolean;
  624. begin
  625. Result := True;
  626. if (Dest is TFileClipboardFormat) then
  627. TFileClipboardFormat(Dest).Files.Assign(FFiles)
  628. else if (Dest is TPIDLClipboardFormat) then
  629. TPIDLClipboardFormat(Dest).Filenames.Assign(FFiles)
  630. else
  631. Result := inherited AssignTo(Dest);
  632. end;
  633. procedure TFileDataFormat.Clear;
  634. begin
  635. FFiles.Clear;
  636. end;
  637. function TFileDataFormat.HasData: boolean;
  638. begin
  639. Result := (FFiles.Count > 0);
  640. end;
  641. function TFileDataFormat.NeedsData: boolean;
  642. begin
  643. Result := (FFiles.Count = 0);
  644. end;
  645. ////////////////////////////////////////////////////////////////////////////////
  646. //
  647. // TDropFileTarget
  648. //
  649. ////////////////////////////////////////////////////////////////////////////////
  650. constructor TDropFileTarget.Create(AOwner: TComponent);
  651. begin
  652. inherited Create(AOwner);
  653. OptimizedMove := True;
  654. FFileFormat := TFileDataFormat.Create(Self);
  655. FFileMapFormat := TFileMapDataFormat.Create(Self);
  656. end;
  657. destructor TDropFileTarget.Destroy;
  658. begin
  659. FFileFormat.Free;
  660. FFileMapFormat.Free;
  661. inherited Destroy;
  662. end;
  663. function TDropFileTarget.GetFiles: TStrings;
  664. begin
  665. Result := FFileFormat.Files;
  666. end;
  667. function TDropFileTarget.GetMappedNames: TStrings;
  668. begin
  669. Result := FFileMapFormat.FileMaps;
  670. end;
  671. function TDropFileTarget.GetPreferredDropEffect: LongInt;
  672. begin
  673. Result := inherited GetPreferredDropEffect;
  674. if (Result = DROPEFFECT_NONE) then
  675. Result := DROPEFFECT_COPY;
  676. end;
  677. ////////////////////////////////////////////////////////////////////////////////
  678. //
  679. // TDropFileSource
  680. //
  681. ////////////////////////////////////////////////////////////////////////////////
  682. constructor TDropFileSource.Create(aOwner: TComponent);
  683. begin
  684. inherited Create(AOwner);
  685. FFileFormat := TFileDataFormat.Create(Self);
  686. FFileMapFormat := TFileMapDataFormat.Create(Self);
  687. end;
  688. destructor TDropFileSource.Destroy;
  689. begin
  690. FFileFormat.Free;
  691. FFileMapFormat.Free;
  692. inherited Destroy;
  693. end;
  694. function TDropFileSource.GetFiles: TStrings;
  695. begin
  696. Result := FFileFormat.Files;
  697. end;
  698. function TDropFileSource.GetMappedNames: TStrings;
  699. begin
  700. Result := FFileMapFormat.FileMaps;
  701. end;
  702. procedure TDropFileSource.SetFiles(AFiles: TStrings);
  703. begin
  704. FFileFormat.Files.Assign(AFiles);
  705. end;
  706. procedure TDropFileSource.SetMappedNames(ANames: TStrings);
  707. begin
  708. FFileMapFormat.FileMaps.Assign(ANames);
  709. end;
  710. ////////////////////////////////////////////////////////////////////////////////
  711. //
  712. // Initialization/Finalization
  713. //
  714. ////////////////////////////////////////////////////////////////////////////////
  715. initialization
  716. // Data format registration
  717. TFileDataFormat.RegisterDataFormat;
  718. TFileMapDataFormat.RegisterDataFormat;
  719. // Clipboard format registration
  720. TFileDataFormat.RegisterCompatibleFormat(TFileClipboardFormat, 0, csSourceTarget, [ddRead]);
  721. TFileDataFormat.RegisterCompatibleFormat(TPIDLClipboardFormat, 1, csSourceTarget, [ddRead]);
  722. TFileDataFormat.RegisterCompatibleFormat(TFilenameClipboardFormat, 2, csSourceTarget, [ddRead]);
  723. TFileDataFormat.RegisterCompatibleFormat(TFilenameWClipboardFormat, 2, csSourceTarget, [ddRead]);
  724. TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapClipboardFormat, 0, csSourceTarget, [ddRead]);
  725. TFileMapDataFormat.RegisterCompatibleFormat(TFilenameMapWClipboardFormat, 0, csSourceTarget, [ddRead]);
  726. finalization
  727. // Data format unregistration
  728. TFileDataFormat.UnregisterDataFormat;
  729. TFileMapDataFormat.UnregisterDataFormat;
  730. // Clipboard format unregistration
  731. TFileClipboardFormat.UnregisterClipboardFormat;
  732. TFilenameClipboardFormat.UnregisterClipboardFormat;
  733. TFilenameWClipboardFormat.UnregisterClipboardFormat;
  734. TFilenameMapClipboardFormat.UnregisterClipboardFormat;
  735. TFilenameMapWClipboardFormat.UnregisterClipboardFormat;
  736. end.