home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / FILEEXP.ZIP / BROWSEDR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-12  |  11.1 KB  |  282 lines

  1. {-----------------------------------------------------------------------------}
  2. { A component and a function (use the one you prefer) to encapsulate the      }
  3. { Win95 style directory selection dialog SHBrowseForFolder().                 }
  4. { Copyright 1996, Brad Stowers.  All Rights Reserved.                         }
  5. { This component can be freely used and distributed in commercial and private }
  6. { environments, provied this notice is not modified in any way and there is   }
  7. { no charge for it other than nomial handling fees.  Contact me directly for  }
  8. { modifications to this agreement.                                            }
  9. {-----------------------------------------------------------------------------}
  10. { Feel free to contact me if you have any questions, comments or suggestions  }
  11. { at bstowers@pobox.com or 72733,3374 on CompuServe.                          }
  12. { The lateset version will always be available on the web at:                 }
  13. {   http://www.pobox.com/~bstowers/delphi/delphi.html                         }
  14. {-----------------------------------------------------------------------------}
  15. { Date last modified:  03/17/96                                               }
  16. {-----------------------------------------------------------------------------}
  17.  
  18. { ----------------------------------------------------------------------------}
  19. { TBrowseDirectory v1.00                                                      }
  20. { ----------------------------------------------------------------------------}
  21. { Description:                                                                }
  22. {   A dialog that displays the user's system in a heirarchial manner and      }
  23. {   allows a selection to be made.  It is a wrapper for SHBrowseForFolder(),  }
  24. {   which is rather messy to use directly.                                    }
  25. { Notes:                                                                      }
  26. {   * Requires Pat Ritchey's ShellObj unit.  It is freely available on his    }
  27. {     web site at http://ourworld.compuserve.com/homepages/PRitchey/          }
  28. {   * Callbacks are not implemented in this version.                          }
  29. { ----------------------------------------------------------------------------}
  30. { Revision History:                                                           }
  31. { 1.00:  + Initial release                                                    }
  32. { 1.01:  added support for non Win95 or WinNT40 systems, so that it works with}
  33. {        with the general SelectDirectory() calls too                         }  
  34. { ----------------------------------------------------------------------------}
  35.  
  36. unit BrowseDr;
  37.  
  38. {$IFNDEF WIN32}
  39.   ERROR!  This unit only available on Win32!
  40. {$ENDIF}
  41.  
  42. interface
  43.  
  44. uses ShellObj, Controls, Classes, DsgnIntf, StdCode, FileCtrl;
  45.  
  46. type
  47.   { These are equivalent to the CSIDL_* constants in the Win32 (95?) API.  }
  48.   { They are used to specify the root of the heirarchy.                    }
  49.   { NOTE: the idDesktopExpanded is not docuemnted, but it seems to be used }
  50.   {       by the Win95 Explorer.  I find it useful, but use at your own    }
  51.   {       risk.  It may be "fixed" in some future release of Win95.        }
  52.   TRootID = (
  53.     idDesktop, idDesktopExpanded, idPrograms, idControlPanel, idPrinters,
  54.     idPersonal, idFavorites, idStartup, idRecent, idSendTo, idRecycleBin,
  55.     idStartMenu, idDesktopDirectory, idDrives, idNetwork, idNetHood, idFonts,
  56.     idTemplates
  57.    );
  58.   { These are equivalent to the BIF_* constants in the Win32 (95?) API.   }
  59.   { They are used to specify what items can be expanded, and what itmes   }
  60.   { can be selected.                                                      }
  61.   TBrowseFlag = (
  62.     bfDirectoriesOnly, bfDomainOnly, bfAncestors, bfComputers, bfPrinters
  63.     { , bfStatusText // Will be added when callback is implemented.       }
  64.    );
  65.   TBrowseFlags = set of TBrowseFlag;
  66.  
  67. { For those of you who prefer to, you can display this dialog with only a }
  68. { function call, no component necessary.  Actually, the component simply  }
  69. { collects parameters and calls this function.                            }
  70. function BrowseDirectory(var   Dest: string;         // Receives selected path
  71.                          const AParent: TWinControl; // Who owns the window
  72.                          const Title: string;        // Text shown above list
  73.                                Root: TRootID;        // Root to browse from
  74.                                Flags: TBrowseFlags   // What is legal to select
  75.                         ): boolean;                  // True if selection made
  76.  
  77. { For the component lover in all of us }
  78. type
  79.   TBrowseDirectoryDlg = class(TComponent)
  80.   private
  81.     { Property variables }
  82.     FTitle: string;
  83.     FRoot: TRootID;
  84.     FOptions: TBrowseFlags;
  85.     { Internal variables }
  86.     FSelected: string;
  87.   public
  88.     constructor Create(AOwner: TComponent); override;
  89.     destructor Destroy; override;
  90.     { Displays the dialog.  Returns true if user selected an item and       }
  91.     { pressed OK, otherwise it returns false.                               }
  92.     function Execute: boolean; virtual;
  93.     { Runtime only property containing the item selected.  This will only   }
  94.     { be valid after Execute is called and it returns TRUE.  At any other   }
  95.     { time, it should be an empty ('') string.                              }
  96.     property Selected: string read FSelected;
  97.   published
  98.     { Text to display above the selection tree.                             }
  99.     property Title: string read FTitle write FTitle;
  100.     { Item that is to be treated as the root of the display.                }
  101.     property Root: TRootID read FRoot write FRoot default idDesktopExpanded;
  102.     { Options to control what is allowed to be selected and expanded.       }
  103.     property Options: TBrowseFlags read FOptions write FOptions default [];
  104.   end;
  105.  
  106.   { A component editor (not really) to allow on-the-fly testing of the      }
  107.   { dialog.  Right click the component and select 'Test Dialog', or simply  }
  108.   { double click the component, and the browse dialog will be displayed     }
  109.   { with the current settings.                                              }
  110.   TBrowseDialogEditor = class(TDefaultEditor)
  111.   public
  112.     procedure ExecuteVerb(Index : Integer); override;
  113.     function GetVerb(Index : Integer): string; override;
  114.     function GetVerbCount : Integer; override;
  115.     procedure Edit; override;
  116.   end;
  117.  
  118.   //procedure Register;
  119.  
  120. implementation
  121.  
  122. uses Windows, OLE2, Forms, Dialogs, SysUtils;
  123.  
  124. // Utility functions used to convert from Delphi set types to API constants.
  125. function ConvertRoot(Root: TRootID): integer;
  126. const
  127.   RootValues: array[TRootID] of integer = (
  128.     CSIDL_DESKTOP, $0001, CSIDL_PROGRAMS, CSIDL_CONTROLS, CSIDL_PRINTERS,
  129.     CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP, CSIDL_RECENT, CSIDL_SENDTO,
  130.     CSIDL_BITBUCKET, CSIDL_STARTMENU, CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES,
  131.     CSIDL_NETWORK, CSIDL_NETHOOD, CSIDL_FONTS, CSIDL_TEMPLATES
  132.    );
  133. begin
  134.   Result := RootValues[Root];
  135. end;
  136.  
  137. function ConvertFlags(Flags: TBrowseFlags): UINT;
  138. const
  139.   FlagValues: array[TBrowseFlag] of UINT = (
  140.     BIF_RETURNONLYFSDIRS, BIF_DONTGOBELOWDOMAIN, BIF_RETURNFSANCESTORS,
  141.     BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER
  142.     {, BIF_STATUSTEXT // Will be added when callback is implemented.        }
  143.    );
  144. var
  145.   Opt: TBrowseFlag;
  146. begin
  147.   Result := 0;
  148.   { Loop through all possible values }
  149.   for Opt := Low(TBrowseFlag) to High(TBrowseFlag) do
  150.     if Opt in Flags then
  151.       Result := Result OR FlagValues[Opt];
  152. end;
  153.  
  154.  
  155. function BrowseDirectory(var Dest: string; const AParent: TWinControl;
  156.                          const Title: string; Root: TRootID;
  157.                          Flags: TBrowseFlags): boolean;
  158. var
  159.   ShellMalloc: IMALLOC;
  160.   shBuff: PChar;
  161.   BrowseInfo: TBrowseInfo;
  162.   idRoot, idBrowse: PItemIDList;
  163. begin
  164.   LoadLibs;
  165.   Result := FALSE; // Assume the worst.
  166.   Dest := ''; // Clear it out.
  167.   SetLength(Dest, MAX_PATH);  // Make sure their will be enough room in dest.
  168.   if SHGetMalloc(ShellMalloc) = NOERROR then begin
  169.     try
  170.       shBuff := PChar(ShellMalloc.Alloc(MAX_PATH)); // Shell allocate buffer.
  171.       if assigned(shBuff) then begin
  172.         try
  173.           // Get id for desired root item.
  174.           SHGetSpecialFolderLocation(AParent.Handle, ConvertRoot(Root), idRoot);
  175.           try
  176.             with BrowseInfo do begin  // Fill info structure
  177.               hwndOwner := AParent.Handle;
  178.               pidlRoot := idRoot;
  179.               pszDisplayName := shBuff;
  180.               lpszTitle := PChar(Title);
  181.               ulFlags := ConvertFlags(Flags);
  182.               lpfn := NIL;
  183.               lParam := 0;
  184.             end;
  185.             idBrowse := SHBrowseForFolder(@BrowseInfo);
  186.             if assigned(idBrowse) then begin
  187.               try
  188.                 SHGetPathFromIDList(idBrowse, shBuff); // Turn into real path.
  189.                 Dest := shBuff; // Put it in user's variable.
  190.                 Result := TRUE; // Success!
  191.               finally
  192.                 ShellMalloc.Free(idBrowse); // Clean up after ourselves
  193.               end;
  194.             end;
  195.           finally
  196.             ShellMalloc.Free(idRoot); // Clean-up.
  197.           end;
  198.         finally
  199.           ShellMalloc.Free(shBuff); // Clean-up.
  200.         end;
  201.       end;
  202.     finally
  203.       ShellMalloc.Release; // Clean-up.
  204.     end;
  205.   end;
  206.   FreeLibs;
  207. end;
  208.  
  209.  
  210. constructor TBrowseDirectoryDlg.Create(AOwner: TComponent);
  211. begin
  212.   inherited Create(AOwner);
  213.   FTitle := '';
  214.   FRoot := idDesktopExpanded;
  215.   FOptions := [];
  216.   FSelected := '';
  217. end;
  218.  
  219. destructor TBrowseDirectoryDlg.Destroy;
  220. begin
  221.   inherited Destroy;
  222. end;
  223.  
  224. function TBrowseDirectoryDlg.Execute: boolean;
  225. var
  226.   S: string;
  227.   Parent: TWinControl;
  228. begin
  229.   if not (GetSimpleOS in [eovWin95, eovWinNT40]) then
  230.     Result:=SelectDirectory(FSelected, [], 0)
  231.   else begin
  232.     { Determine who the parent is. }
  233.     if Owner is TWinControl then
  234.       Parent := Owner as TWinControl
  235.     else
  236.       Parent := Application.MainForm;
  237.     { Call the function }
  238.     Result := BrowseDirectory(S, Parent, FTitle, FRoot, FOptions);
  239.     { If selectino made, update property }
  240.     if Result then
  241.       FSelected := S;
  242.   end;
  243. end;
  244.  
  245. // Component Editor (not really) to allow on the fly testing of the dialog
  246. procedure TBrowseDialogEditor.ExecuteVerb(Index: Integer);
  247. begin
  248.   {we only have one verb, so exit if this ain't it}
  249.   if Index <> 0 then Exit;
  250.   Edit;
  251. end;
  252.  
  253. function TBrowseDialogEditor.GetVerb(Index: Integer): AnsiString;
  254. begin
  255.   Result := 'Test Dialog';
  256. end;
  257.  
  258. function TBrowseDialogEditor.GetVerbCount: Integer;
  259. begin
  260.   Result := 1;
  261. end;
  262.  
  263. procedure TBrowseDialogEditor.Edit;
  264. begin
  265.   with TBrowseDirectoryDlg(Component) do
  266.     if Execute then
  267.       MessageDlg(Format('Item selected:'#13#13'%s', [Selected]),
  268.                  mtInformation, [mbOk], 0);
  269. end;
  270.  
  271. (*
  272. procedure Register;
  273. begin
  274.   { You may prefer it on the Dialogs page, I like it on Win95 because it is
  275.     only available on Win95.                                                }
  276.   RegisterComponents('Dialogs', [TBrowseDirectoryDlg]);
  277.   RegisterComponentEditor(TBrowseDirectoryDlg, TBrowseDialogEditor);
  278. end;
  279. *)
  280.  
  281. end.
  282.