📄 browsedr.pas
字号:
{$I DFS.INC} { Standard defines for all Delphi Free Stuff components }
{------------------------------------------------------------------------------}
{ TdfsBrowseDirectoryDlg v2.62 }
{------------------------------------------------------------------------------}
{ A component to encapsulate the Win32 style directory selection dialog }
{ SHBrowseForFolder(). }
{ }
{ Copyright 1999-2001, Brad Stowers. All Rights Reserved. }
{ }
{ Copyright: }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive }
{ property of the author. }
{ }
{ Distribution Rights: }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of }
{ the DFS source code unless specifically stated otherwise. }
{ You are further granted permission to redistribute any of the DFS source }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TdfsColorButton, you must include in }
{ the distribution package the colorbtn.zip file in the exact form that you }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip. }
{ }
{ Restrictions: }
{ Without the express written consent of the author, you may not: }
{ * Distribute modified versions of any DFS source code by itself. You must }
{ include the original archive as you found it at the DFS site. }
{ * Sell or lease any portion of DFS source code. You are, of course, free }
{ to sell any of your own original code that works with, enhances, etc. }
{ DFS source code. }
{ * Distribute DFS source code for profit. }
{ }
{ Warranty: }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no }
{ event shall the author of the softare, Bradley D. Stowers, be held }
{ accountable for any damages or losses that may occur from use or misuse of }
{ the software. }
{ }
{ Support: }
{ Support is provided via the DFS Support Forum, which is a web-based message }
{ system. You can find it at http://www.delphifreestuff.com/discus/ }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I }
{ receive and address all problems that are reported to me, you must }
{ understand that I simply can not guarantee that this will always be so. }
{ }
{ Clarifications: }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at: }
{ http://www.delphifreestuff.com/ }
{ See BrowseDr.txt for notes, known issues, and revision history. }
{------------------------------------------------------------------------------}
{ Date last modified: June 27, 2001 }
{------------------------------------------------------------------------------}
{: This unit provides a component that displays a standard Windows 95/NT 4...
dialog containing the user's system in a heirarchial manner and allows a...
selection to be made. It is a wrapper for the SHBrowseForFolder() API,...
which is quite messy to use directly. Also provided is an editor which...
allows you to display the dialog at design time with the selected options.
Note:
This component Requires Delphi 3 or Delphi v2.01's ShlObj unit. If you...
have Delphi 2.00, you can get the equivalent using Pat Ritchey's ShellObj...
unit. It is freely available on his web site at...
http://ourworld.compuserve.com/homepages/PRitchey/. Both Borland's ShlObj...
unit and Pat's ShellObj unit contain errors that should be fixed. I have...
included instructions on how to do this. They are in the included...
ShellFix.txt file. Delphi 3's ShlObj unit does not have any errors that I...
am currently aware of.
}
unit BrowseDr;
{$IFNDEF DFS_WIN32}
ERROR! Only available for Win32!
{$ENDIF}
interface
uses
Windows, Dialogs,
{$IFDEF DFS_COMPILER_3_UP}
ActiveX,
{$ELSE}
OLE2,
{$ENDIF}
{$IFDEF DFS_USEDEFSHLOBJ}
ShlObj, { Delphi 3 fixes all of 2.01's bugs! }
{$ELSE}
// If you get a compiler error here, read the included SHELLFIX.TXT file for
// instructions on creating MyShlObj.pas.
MyShlObj,
{$ENDIF}
Controls, Classes;
const
{ This shuts up C++Builder 3 about the redefiniton being different. There
seems to be no equivalent in C1. Sorry. }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM DFS_COMPONENT_VERSION}
{$ENDIF}
DFS_COMPONENT_VERSION = 'TdfsBrowseDirectoryDlg v2.62';
{: This is a newly documented folder identifier that is not in the Delphi...
units yet. You can use it with any of the Win32 Shell API functions...
that wants a CSIDL_* identifier such as SHGetSpecialFolderLocation. }
{ This shuts up C++Builder 3 about the redefiniton being different. There
seems to be no equivalent in C1. Sorry. }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM CSIDL_INTERNET}
{$ENDIF}
CSIDL_INTERNET = $0001;
{$IFDEF DFS_COMPILER_2}
{ IDs that exist in Delphi/C++B 3 ShlObj.pas unit, but not Delphi 2. }
CSIDL_COMMON_STARTMENU = $0016;
CSIDL_COMMON_PROGRAMS = $0017;
CSIDL_COMMON_STARTUP = $0018;
CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
CSIDL_APPDATA = $001a;
CSIDL_PRINTHOOD = $001b;
{$ENDIF}
{: This folder identifer is undocumented, but should work for a long time...
since the highest ID is currently around 30 or so. It is used to open...
the tree already expanded with the desktop as the root item. }
CSIDL_DESKTOPEXPANDED = $FEFE;
{$IFDEF DFS_COMPILER_2}
{: This constant was missing from the Delphi 2 units, but was added to...
Delphi 3. It causes files to be included in the tree as well as folders. }
BIF_BROWSEINCLUDEFILES = $4000;
{$ENDIF}
{$IFNDEF DFS_COMPILER_4_UP}
{: These constants are new to v4.71 of SHELL32.DLL. Delphi 4 defines them...
but the are missing in all previous versions. }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM BIF_EDITBOX}
{$ENDIF}
BIF_EDITBOX = $0010;
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM BIF_VALIDATE}
{$ENDIF}
BIF_VALIDATE = $0020; { insist on valid result (or CANCEL) }
{$IFDEF DFS_CPPB_3_UP}
{$EXTERNALSYM BFFM_VALIDATEFAILED}
{$ENDIF}
BFFM_VALIDATEFAILED = 3; { lParam:szPath ret:1(cont),0(EndDialog) }
{$ENDIF}
{$IFNDEF DFS_COMPILER_7_UP}
{$IFDEF DFS_CPPB_3_UP} {EXTERNALSYM BIF_BROWSEINCLUDEURLS} {$ENDIF}
BIF_BROWSEINCLUDEURLS = $0080;
{$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_NEWDIALOGSTYLE} {$ENDIF}
BIF_NEWDIALOGSTYLE = $0040;
{$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_SHAREABLE} {$ENDIF}
BIF_SHAREABLE = $8000;
{$IFDEF DFS_CPPB_3_UP} {$EXTERNALSYM BIF_USENEWUI} {$ENDIF}
BIF_USENEWUI = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
{$ENDIF}
type
{: This enumerated type is the equivalent of the CSIDL_* constants in the...
Win32 API. They are used to specify the root of the heirarchy tree.
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.
}
TRootID = (
idDesktop, idInternet, idPrograms, idControlPanel, idPrinters, idPersonal,
idFavorites, idStartup, idRecent, idSendTo, idRecycleBin, idStartMenu,
idDesktopDirectory, idDrives, idNetwork, idNetHood, idFonts, idTemplates,
idCommonStartMenu, idCommonPrograms, idCommonStartup,
idCommonDesktopDirectory, idAppData, idPrintHood, idDesktopExpanded
);
{: These are equivalent to the BIF_* constants in the Win32 API. They are...
used to specify what items can be expanded, and what items can be...
selected by combining them in a set in the Options property.
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. Requires v4.71 of SHELL32.DLL.
bfIncludeURLs: The browse dialog box can display URLs. The bfUseNewUI and
bfIncludeFiles flags must also be set. If these three flags are not set,
the browser dialog box will reject URLs. Even when these flags are set,
the browse dialog box will only display URLs if the folder that contains
the selected item supports them. When the folder's
IShellFolder::GetAttributesOf method is called to request the selected
item's attributes, the folder must set the SFGAO_FOLDER attribute flag.
Otherwise, the browse dialog box will not display the URL. Requires
v5.0 of SHELL32.DLL
bfNewDialogStyle: Use the new user-interface. Setting this flag provides
the user with a larger dialog box that can be resized. It has several
new capabilities including: drag and drop capability within the dialog
box, reordering, context menus, new folders, delete, and other context
menu commands. Requires v5.0 of SHELL32.DLL
bfShareable: The browse dialog box can display shareable resources on
remote systems. It is intended for applications that want to expose
remote shares on a local system. The bfUseNewUI flag must also be set.
Requires v5.0 of SHELL32.DLL
bfUseNewUI: Use the new user-interface including an edit box. This flag is
equivalent to bfEditBox and bfNewDialogStyle. Requires v5.0 of
SHELL32.DLL
}
TBrowseFlag = (
bfDirectoriesOnly, bfDomainOnly, bfAncestors, bfComputers, bfPrinters,
bfIncludeFiles, bfEditBox, bfIncludeURLs, bfNewDialogStyle, bfShareable,
bfUseNewUI
);
{: A set of TBrowseFlag items. }
TBrowseFlags = set of TBrowseFlag;
{ TBDSelChangedEvent is used for events associated with...
TdfsBrowseDirectoryDlg's OnSelChanged event.
The Sender parameter is the TdfsBrowseDirectoryDlg 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. }
TBDSelChangedEvent = procedure(Sender: TObject; NewSel: string;
NewSelPIDL: PItemIDList) of object;
TBDValidateFailedEvent = procedure(Sender: TObject; Path: string;
var Cancel: boolean) of object;
type
{: TdfsBrowseDirectoryDlg provides a component that displays a standard...
Windows 95/NT 4 dialog containing the user's system in a heirarchial...
manner and allows a selection to be made. It is a wrapper for the...
SHBrowseForFolder() API, which is quite messy to use directly. }
TdfsBrowseDirectoryDlg = class(TComponent)
private
{ Property variables }
FDlgWnd: HWND;
FCaption: string;
FParent: TWinControl;
FShowSelectionInStatus: boolean;
FFitStatusText: boolean;
FTitle: string;
FRoot: TRootID;
FOptions: TBrowseFlags;
FSelection: string;
FCenter: boolean;
FStatusText: string;
FEnableOKButton: boolean;
FImageIndex: integer;
FSelChanged: TBDSelChangedEvent;
FOnCreate: TNotifyEvent;
FSelectionPIDL: PItemIDList;
FShellMalloc: IMalloc;
FDisplayName: string;
FOnValidateFailed: TBDValidateFailedEvent;
function GetDisplayName: string;
procedure ShowStatusTextLabel;
protected
// internal methods
function FittedStatusText: string;
procedure SendSelectionMessage;
// internal event methods.
procedure DoInitialized(Wnd: HWND); virtual;
procedure DoSelChanged(Wnd: HWND; Item: PItemIDList); virtual;
procedure DoValidateFailed(Path: string; var Cancel: boolean); virtual;
// property methods
procedure SetFitStatusText(Val: boolean);
procedure SetOptions(const Val: TBrowseFlags);
procedure SetStatusText(const Val: string);
procedure SetSelection(const Val: string);
procedure SetSelectionPIDL(Value: PItemIDList);
procedure SetEnableOKButton(Val: boolean);
function GetCaption: string;
procedure SetCaption(const Val: string);
procedure SetParent(AParent: TWinControl);
function GetVersion: string;
procedure SetVersion(const Val: string);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{: Displays the browser folders dialog. It returns TRUE if user selected...
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -