browsedr.~pas

browsedr,一个自己编写的小控件,适合DELPHI5下用

       If, for example, the user chose the Control Panel folder, the Selection...
       property would be blank, but DisplayName would be "Control Panel".  You...
       could not actually use this value to get to the Control Panel, for that...
       you need to use the SelectionPIDL property and various Shell Namespace...
       API functions. }
		property DisplayName: string
       read GetDisplayName;
  published
    property Version: TDFSVersion
       read GetVersion
       write SetVersion
       stored FALSE;

    {: The selected item in the browse folder dialog.

       Setting this before calling the Execute method will cause the assigned...
       value to be initially selected when the dialog is initially displayed...
       if the item exists.  If it does not exist, the root item will be selected.

       If this value is blank, the SelectionPIDL item will be used instead.

       After the Execute method returns, you can read this value to determine...
       what item the user selected, unless that item does not have a string...
       representation (Control Panel, for example). }
    property Selection: string
       read FSelection
       write SetSelection;
    {: Specifies the text to appear at the top of the dialog above the tree...
       control.  There is enough room for two lines of text, and it will be...
       word-wrapped for you automatically.

       Generally, this is used to provide user instructions or as a title for
       the StatusText property.

       Example:

       // Title property set to "The current selection is:"
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection
         BrowseDirectoryDlg.StatusText := NewSel;
       end;
    }
    property Title: string
       read FTitle
       write FTitle;
    {: Specifies the item that is to be treated as the root of the tree...
       display.

    idDesktop: Windows desktop -- virtual folder at the root of the name space.
    idInternet: Internet Explorer -- virtual folder of the Internet Explorer.
    idPrograms: File system directory that contains the user's program groups...
       (which are also file system directories).
    idControlPanel: Control Panel -- virtual folder containing icons for the...
       control panel applications.
    idPrinters: Printers folder -- virtual folder containing installed printers.
    idPersonal: File system directory that serves as a common respository for...
       documents.
    idFavorites: Favorites folder -- virtual folder containing the user's...'
       Internet Explorer bookmark items and subfolders.
    idStartup: File system directory that corresponds to the user's Startup...
       program group.
    idRecent: File system directory that contains the user's most recently...
       used documents.
    idSendTo: File system directory that contains Send To menu items.
    idRecycleBin: Recycle bin -- file system directory containing file...
       objects in the user's recycle bin. The location of this directory is...
       not in the registry; it is marked with the hidden and system...
       attributes to prevent the user from moving or deleting it.
    idStartMenu: File system directory containing Start menu items.
    idDesktopDirectory: File system directory used to physically store file...
       objects on the desktop (not to be confused with the desktop folder itself).
    idDrives: My Computer -- virtual folder containing everything on the...
       local computer: storage devices, printers, and Control Panel. The...
       folder may also contain mapped network drives.
    idNetwork: Network Neighborhood -- virtual folder representing the top...
       level of the network hierarchy.
    idNetHood: File system directory containing objects that appear in the...
       network neighborhood.
    idFonts: Virtual folder containing fonts.
    idTemplates: File system directory that serves as a common repository for...
       document templates.
    idCommonStartMenu: File system directory that contains the programs and...
       folders that appear on the Start menu for all users on Windows NT.
    idCommonPrograms: File system directory that contains the directories for...
       the common program groups that appear on the Start menu for all users...
       on Windows NT.
    idCommonStartup: File system directory that contains the programs that...
       appear in the Startup folder for all users. The system starts these...
       programs whenever any user logs on to Windows NT.
    idCommonDesktopDirectory: File system directory that contains files and...
       folders that appear on the desktop for all users on Windows NT.
    idAppData: File system directory that contains data common to all...
       applications.
    idPrintHood: File system directory containing object that appear in the...
       printers folder.
    idDesktopExpanded: Same as idDesktop except that the root item is already...
       expanded when the dialog is initally displayed.

    NOTE: idCommonStartMenu, idCommonPrograms, idCommonStartup, and...
       idCommonDesktopDirectory only have effect when the dialog is being...
       displayed on an NT system.  On Windows 95, these values will be...
       mapped to thier "non-common" equivalents, i.e. idCommonPrograms will...
       become idPrograms.
    }
    property Root: TRootID
       read FRoot
       write FRoot
       default idDesktop;
    {: Options is a set of TBrowseFlag items that controls what is allowed to...
       be selected and expanded in the tree.  It can be a combination of any...
       (or none) of the following:

     bfDirectoriesOnly: Only returns file system directories. If the user...
        selects folders that are not part of the file system, the OK button...
        is grayed.
     bfDomainOnly: Does not include network folders below the domain level...
        in the dialog.
     bfAncestors: Only returns file system ancestors (items which contain...
        files, like drives).  If the user selects anything other than a file...
        system ancestor, the OK button is grayed.
     bfComputers: Shows other computers.  If anything other than a computer...
        is selected, the OK button is disabled.
     bfPrinters:	Shows all printers.  If anything other than a printers is...
        selected, the OK button is disabled.
     bfIncludeFiles: Show non-folder items that exist in the folders.
     bfEditBox:   Includes an edit control in which the user can type the ...
        of an item.  If the user enters an invalid path, the OnValidateFailed...
        event will fire.  Requires v4.71 of COMCTL32.DLL.
    }
    property Options: TBrowseFlags
       read FOptions
       write FOptions
       default [];
    {: Indicates whether the dialog should be centered on the screen or shown...
      in a default, system-determined location. }
    property Center: boolean
       read FCenter
       write FCenter
       default TRUE;
    {: A string that is displayed directly above the tree view control and...
       just under the Title text in the dialog box. This string can be used...
       for any purpose such as to specify instructions to the user, or show...
       the full path of the currently selected item.  You can modify this...
       value while the dialog is displayed from the the OnSelChanged event.

       If StatusText is blank when the Execute method is called, the dialog...
       will not have a status text area and assigning to the StatusText...
       property will have no effect.

       Example:

       // Title property set to "The current selection is:"
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection
         BrowseDirectoryDlg.StatusText := NewSel;
       end;
       }
    property StatusText: string
       read FStatusText
       write SetStatusText;
    {: Indicates whether the StatusText string should be shortened to make it...
       fit in available status text area.  The status text area is only large...
       enough to hold one line of text, and if the text is too long for the...
       available space, it will simply be chopped off.  However, if this...
       property is set to TRUE, the text will be shortened using an ellipsis...
       ("...").

       For example, if the status text property were...
       "C:\Windows\Start Menu\Programs\Applications\Microsoft Reference", it
       could be shortened to...
       "C:\...\Start Menu\Programs\Applications\Microsoft Reference" depending
       on the screen resolution and dialog font size.
    }
    property FitStatusText: boolean
       read FFitStatusText
       write SetFitStatusText
       default TRUE;
    {: This property enables or disables the OK button on the browse folders...
       dialog.  This allows control over whether a selection can be made or...
       not. You can modify this value while the dialog is displayed from the...
       the OnSelChanged event.  This allows you to control whether the user...
       can select an item based on what the current selection is.

       Example:
       procedure TForm1.BrowseDirectoryDlgSelChanged(Sender: TObject; const NewSel: string);
       begin
         // NewSel has the full selection.  Only allow items greater than 10 characters to be selected.
         BrowseDirectoryDlg.EnableOKButton := Length(NewSel > 10);
       end;
    }
    property EnableOKButton: boolean
       read FEnableOKButton
       write SetEnableOKButton
       default TRUE;
    {: After a selection has been made in the dialog, this property will...
       contain the index into the system image list of the selected node. See...
       the demo application for an example how this can be used. }
    property ImageIndex: integer
       read FImageIndex;
    {: Specifies the text in the dialog's caption bar. Use Caption to specify...
       the text that appears in the browse folder dialog's title bar. If no...
       value is assigned to Title, the dialog has a title based on the...
       Options property.

       For example, if bfPrinters was set, the title would be "Browse for...
       Printer". }
    property Caption: string
       read GetCaption
       write SetCaption;
    {: Automatically shows the current selection in the status text area of...
       the dialog.  }
    property ShowSelectionInStatus: boolean
       read FShowSelectionInStatus
       write FShowSelectionInStatus;
    {: The OnSelChange event is fired every time a new item is selected in...
       the tree.

      The Sender parameter is the TBrowseDirectoryDlg object whose event...
      handler is called.  The NewSel parameter is the text representation of...
      the new selection.  The NewSelPIDL is the new PItemIDList...
      representation of the new selection.

      NOTE:  You will need to add ShlObj to your uses clause if you define...
      a handler for this event. }
    property OnSelChanged: TBDSelChangedEvent
       read FSelChanged
       write FSelChanged;
    { The OnCreate event is fired when dialog has been created, but just...
       before it is displayed to the user. }
    property OnCreate: TNotifyEvent
       read FOnCreate
       write FOnCreate;
    { If the bfEditBox flag is set in the Options property, the user can type...
      a path into the dialog.  If the path entered is invalid, this event...
      will be fired.  This event is not used if bfEditBox is not specified in...
      Options.  Requires v4.71 of COMCTL32.DLL. }
    property OnValidateFailed: TBDValidateFailedEvent
       read FOnValidateFailed
       write FOnValidateFailed;
  end;

{ Utility function you may find useful }
function DirExists(const Dir: string): boolean;

implementation

uses
  Forms, SysUtils, Messages, ShellAPI;

// Utility functions used to convert from Delphi set types to API constants.
function ConvertRoot(Root: TRootID): integer;
const
  WinNT_RootValues: array[TRootID] of integer = (
    CSIDL_DESKTOP, CSIDL_INTERNET, CSIDL_PROGRAMS, CSIDL_CONTROLS,
    CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP,
    CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU,
    CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES, CSIDL_NETWORK, CSIDL_NETHOOD,
    CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS,
    CSIDL_COMMON_STARTUP, CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_APPDATA,
    CSIDL_PRINTHOOD, CSIDL_DESKTOPEXPANDED
  );
  Win95_RootValues: array[TRootID] of integer = (
    CSIDL_DESKTOP, CSIDL_INTERNET, CSIDL_PROGRAMS, CSIDL_CONTROLS,
    CSIDL_PRINTERS, CSIDL_PERSONAL, CSIDL_FAVORITES, CSIDL_STARTUP,
    CSIDL_RECENT, CSIDL_SENDTO, CSIDL_BITBUCKET, CSIDL_STARTMENU,
    CSIDL_DESKTOPDIRECTORY, CSIDL_DRIVES, CSIDL_NETWORK, CSIDL_NETHOOD,
    CSIDL_FONTS, CSIDL_TEMPLATES, CSIDL_STARTMENU, CSIDL_PROGRAMS,
    CSIDL_STARTUP, CSIDL_DESKTOPDIRECTORY, CSIDL_APPDATA, CSIDL_PRINTHOOD,
    CSIDL_DESKTOPEXPANDED
  );
var
  VerInfo: TOSVersionInfo;
begin
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(VerInfo);
  if VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
    Result := WinNT_RootValues[Root]
  else
    Result := Win95_RootValues[Root];
end;

function ConvertFlags(Flags: TBrowseFlags): UINT;
const
  FlagValues: array[TBrowseFlag] of UINT = (
    BIF_RETURNONLYFSDIRS, BIF_DONTGOBELOWDOMAIN, BIF_RETURNFSANCESTORS,
    BIF_BROWSEFORCOMPUTER, BIF_BROWSEFORPRINTER, BIF_BROWSEINCLUDEFILES,
    BIF_EDITBOX
   );
var
  Opt: TBrowseFlag;
begin
  Result := 0;
  { Loop through all possible values }
  for Opt := Low(TBrowseFlag) to High(TBrowseFlag) do
    if Opt in Flags then
      Result := Result OR FlagValues[Opt];
end;

function GetTextWidth(DC: HDC; const Text: String): Integer;
var
  Extent: TSize;
begin
  if GetTextExtentPoint(DC, PChar(Text), Length(Text), Extent) then
    Result := Extent.cX
  else
    Result := 0;
end;

function MinimizeName(Wnd: HWND; const Filename: string): string;