home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmBrowseFor.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  3KB  |  108 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmBrowseFor
  5. Purpose  : Dialog Wrapper for the Win32 BrowseForFolder API Call.  
  6. Date     : 03-15-1999
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmBrowseFor;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses
  18.    Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
  19.    ShlObj;
  20.  
  21. type
  22.    TbfType = (bftFolders,bftPrinters,bftComputers,bftFileorFolders);
  23.    TbfRoot = (bfrDesktop,bfrMyComputer,bfrNetworkNeighborhood,bfrPrinters);
  24.  
  25.    TrmBrowseForFolder = class(TComponent)
  26.    private
  27.       fFolder: string;
  28.       fBrowseInfo: TBrowseInfo;
  29.       fRoot: TBFRoot;
  30.       fType: TBFType;
  31.       fTitle: string;
  32.    public
  33.       function Execute: Boolean;
  34.       constructor create(AOwner: TComponent); override;
  35.       property Folder: string read fFolder write fFolder;
  36.    Published
  37.       property BrowseForType: TBFType read fType write fType default bftFolders;
  38.       property RootNode: TBFRoot read fRoot write fRoot default bfrDeskTop;
  39.       property Title: string read fTitle write fTitle;
  40.    end;
  41.  
  42. implementation
  43.  
  44. function BrowseCallback(Wnd: HWND; uMsg: UINT; lParam,lpData: LPARAM): Integer stdcall;
  45. begin
  46.    Result := 0;
  47.    if uMsg = BFFM_Initialized then
  48.    begin
  49.       with TrmBrowseForFolder(lpData) do
  50.       begin
  51.          if Length(Folder) > 0 then
  52.             SendMessage(Wnd,BFFM_SetSelection,1,Longint(PChar(Folder)));
  53.       end;
  54.    end;
  55. end;
  56.  
  57. { TrmBrowseForFolder }
  58.  
  59. constructor TrmBrowseForFolder.create(AOwner: TComponent);
  60. begin
  61.    inherited;
  62.    fRoot := bfrDesktop;
  63.    fType := bftFolders;
  64. end;
  65.  
  66. function TrmBrowseForFolder.Execute: Boolean;
  67. var
  68.    Buffer: array[0..MAX_PATH] of char;
  69.    ItemIdList: PItemIDList;
  70.  
  71. begin
  72.    Result := False;
  73.  
  74.    with fBrowseInfo do
  75.    begin
  76.       hwndOwner := Application.Handle;
  77.       pszDisplayName := Buffer;
  78.       lpszTitle := PChar(FTitle);
  79.       lpfn := BrowseCallback;
  80.       lParam := longint(self);
  81.  
  82.       case fRoot of
  83.          bfrDesktop: pidlRoot := nil;
  84.          bfrMyComputer: SHGetSpecialFolderLocation(application.handle,CSIDL_DRIVES,pidlRoot);
  85.          bfrNetworkNeighborhood: SHGetSpecialFolderLocation(application.handle,CSIDL_NETWORK,pidlRoot);
  86.          bfrPrinters: SHGetSpecialFolderLocation(application.handle,CSIDL_PRINTERS,pidlRoot);
  87.       end;
  88.  
  89.       case fType of
  90.          bftFolders: ulFlags := BIF_RETURNONLYFSDIRS;
  91.          bftPrinters: ulFlags := BIF_BROWSEFORPRINTER;
  92.          bftComputers: ulFlags := BIF_BROWSEFORCOMPUTER;
  93.          bftFileorFolders: ulFlags := BIF_BROWSEINCLUDEFILES;
  94.       end;
  95.    end;
  96.  
  97.    ItemIdList := ShBrowseForFolder(FBrowseInfo);
  98.  
  99.    if ItemIDList = nil then
  100.       Exit;
  101.  
  102.    Result := SHGetPathFromIDList(ItemIDList,Buffer);
  103.    fFolder := Buffer;
  104. end;
  105.  
  106. end.
  107.  
  108.