Subversion Repositories decoder

Rev

Blame | Last modification | View Log | RSS feed

  1. unit DropFileSource3;
  2.  
  3. // -----------------------------------------------------------------------------
  4. //
  5. //                      *** NOT FOR RELEASE ***
  6. //
  7. //                     *** INTERNAL USE ONLY ***
  8. //
  9. // -----------------------------------------------------------------------------
  10. // Project:         Drag and Drop Component Suite
  11. // Module:          DropFileSource3
  12. // Description:     Test case for deprecated TDropSource class.
  13. // Version:         4.0
  14. // Date:            25-JUN-2000
  15. // Target:          Win32, Delphi 3-6 and C++ Builder 3-5
  16. // Authors:         Angus Johnson, ajohnson@rpi.net.au
  17. //                  Anders Melander, anders@melander.dk, http://www.melander.dk
  18. // Copyright        © 1997-2000 Angus Johnson & Anders Melander
  19. // -----------------------------------------------------------------------------
  20.  
  21.  
  22. interface
  23.  
  24. uses
  25.   DragDrop,
  26.   DragDropPIDL,
  27.   DragDropFormats,
  28.   DragDropFile,
  29.   DropSource3,
  30.   ActiveX, Classes;
  31.  
  32. {$include DragDrop.inc}
  33.  
  34. type
  35.   TDropFileSourceX = class(TDropSource)
  36.   private
  37.     fFiles: TStrings;
  38.     fMappedNames: TStrings;
  39.     FFileClipboardFormat: TFileClipboardFormat;
  40.     FPIDLClipboardFormat: TPIDLClipboardFormat;
  41.     FPreferredDropEffectClipboardFormat: TPreferredDropEffectClipboardFormat;
  42.     FFilenameMapClipboardFormat: TFilenameMapClipboardFormat;
  43.     FFilenameMapWClipboardFormat: TFilenameMapWClipboardFormat;
  44.  
  45.     procedure SetFiles(files: TStrings);
  46.     procedure SetMappedNames(names: TStrings);
  47.   protected
  48.     function DoGetData(const FormatEtcIn: TFormatEtc;
  49.       out Medium: TStgMedium):HRESULT; override;
  50.     function CutOrCopyToClipboard: boolean; override;
  51.   public
  52.     constructor Create(aOwner: TComponent); override;
  53.     destructor Destroy; override;
  54.   published
  55.     property Files: TStrings read fFiles write SetFiles;
  56.     //MappedNames is only needed if files need to be renamed during a drag op
  57.     //eg dragging from 'Recycle Bin'.
  58.     property MappedNames: TStrings read fMappedNames write SetMappedNames;
  59.   end;
  60.  
  61. procedure Register;
  62.  
  63. implementation
  64.  
  65. uses
  66.   Windows,
  67.   ShlObj,
  68.   SysUtils,
  69.   ClipBrd;
  70.  
  71. procedure Register;
  72. begin
  73.   RegisterComponents(DragDropComponentPalettePage, [TDropFileSourceX]);
  74. end;
  75.  
  76. // -----------------------------------------------------------------------------
  77. // -----------------------------------------------------------------------------
  78. // -----------------------------------------------------------------------------
  79. // -----------------------------------------------------------------------------
  80.  
  81. constructor TDropFileSourceX.Create(aOwner: TComponent);
  82. begin
  83.   inherited Create(aOwner);
  84.   fFiles := TStringList.Create;
  85.   fMappedNames := TStringList.Create;
  86.  
  87.   FFileClipboardFormat := TFileClipboardFormat.Create;
  88.   FPIDLClipboardFormat := TPIDLClipboardFormat.Create;
  89.   FPreferredDropEffectClipboardFormat := TPreferredDropEffectClipboardFormat.Create;
  90.   FFilenameMapClipboardFormat := TFilenameMapClipboardFormat.Create;
  91.   FFilenameMapWClipboardFormat := TFilenameMapWClipboardFormat.Create;
  92.  
  93.   AddFormatEtc(FFileClipboardFormat.GetClipboardFormat, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);
  94.   AddFormatEtc(FPIDLClipboardFormat.GetClipboardFormat, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);
  95.   AddFormatEtc(FPreferredDropEffectClipboardFormat.GetClipboardFormat, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);
  96.   AddFormatEtc(FFilenameMapClipboardFormat.GetClipboardFormat, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);
  97.   AddFormatEtc(FFilenameMapWClipboardFormat.GetClipboardFormat, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);
  98. end;
  99. // -----------------------------------------------------------------------------
  100.  
  101. destructor TDropFileSourceX.destroy;
  102. begin
  103.   FFileClipboardFormat.Free;
  104.   FPIDLClipboardFormat.Free;
  105.   FPreferredDropEffectClipboardFormat.Free;
  106.   FFilenameMapClipboardFormat.Free;
  107.   FFilenameMapWClipboardFormat.Free;
  108.   fFiles.Free;
  109.   fMappedNames.free;
  110.   inherited Destroy;
  111. end;
  112. // -----------------------------------------------------------------------------
  113.  
  114. procedure TDropFileSourceX.SetFiles(files: TStrings);
  115. begin
  116.   fFiles.assign(files);
  117. end;
  118. // -----------------------------------------------------------------------------
  119.  
  120. procedure TDropFileSourceX.SetMappedNames(names: TStrings);
  121. begin
  122.   fMappedNames.assign(names);
  123. end;
  124. // -----------------------------------------------------------------------------
  125.  
  126. function TDropFileSourceX.CutOrCopyToClipboard: boolean;
  127. var
  128.   FormatEtcIn: TFormatEtc;
  129.   Medium: TStgMedium;
  130. begin
  131.   FormatEtcIn.cfFormat := CF_HDROP;
  132.   FormatEtcIn.dwAspect := DVASPECT_CONTENT;
  133.   FormatEtcIn.tymed := TYMED_HGLOBAL;
  134.   if (Files.count = 0) then result := false
  135.   else if GetData(formatetcIn,Medium) = S_OK then
  136.   begin
  137.     Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal);
  138.     result := true;
  139.   end else result := false;
  140. end;
  141. // -----------------------------------------------------------------------------
  142.  
  143. function TDropFileSourceX.DoGetData(const FormatEtcIn: TFormatEtc;
  144.          out Medium: TStgMedium):HRESULT;
  145. begin
  146.   Medium.tymed := 0;
  147.   Medium.UnkForRelease := NIL;
  148.   Medium.hGlobal := 0;
  149.  
  150.   result := E_UNEXPECTED;
  151.   if fFiles.count = 0 then
  152.     exit;
  153.  
  154.   //--------------------------------------------------------------------------
  155.   if FFileClipboardFormat.AcceptFormat(FormatEtcIn) then
  156.   begin
  157.     FFileClipboardFormat.Files.Assign(FFiles);
  158.     if FFileClipboardFormat.SetDataToMedium(FormatEtcIn, Medium) then
  159.       result := S_OK;
  160.   end else
  161.   //--------------------------------------------------------------------------
  162.   if FFilenameMapClipboardFormat.AcceptFormat(FormatEtcIn) then
  163.   begin
  164.     FFilenameMapClipboardFormat.FileMaps.Assign(fMappedNames);
  165.     if FFilenameMapClipboardFormat.SetDataToMedium(FormatEtcIn, Medium) then
  166.       result := S_OK;
  167.   end else
  168.   //--------------------------------------------------------------------------
  169.   if FFilenameMapWClipboardFormat.AcceptFormat(FormatEtcIn) then
  170.   begin
  171.     FFilenameMapWClipboardFormat.FileMaps.Assign(fMappedNames);
  172.     if FFilenameMapWClipboardFormat.SetDataToMedium(FormatEtcIn, Medium) then
  173.       result := S_OK;
  174.   end else
  175.   //--------------------------------------------------------------------------
  176.   if FPIDLClipboardFormat.AcceptFormat(FormatEtcIn) then
  177.   begin
  178.     FPIDLClipboardFormat.Filenames.Assign(FFiles);
  179.     if FPIDLClipboardFormat.SetDataToMedium(FormatEtcIn, Medium) then
  180.       result := S_OK;
  181.   end else
  182.   //--------------------------------------------------------------------------
  183.   //This next format does not work for Win95 but should for Win98, WinNT ...
  184.   //It stops the shell from prompting (with a popup menu) for the choice of
  185.   //Copy/Move/Shortcut when performing a file 'Shortcut' onto Desktop or Explorer.
  186.   if FPreferredDropEffectClipboardFormat.AcceptFormat(FormatEtcIn) then
  187.   begin
  188.     FPreferredDropEffectClipboardFormat.Value := FeedbackEffect;
  189.     if FPreferredDropEffectClipboardFormat.SetDataToMedium(FormatEtcIn, Medium) then
  190.       result := S_OK;
  191.   end else
  192.     result := DV_E_FORMATETC;
  193. end;
  194.  
  195. end.
  196.