rzshellopenform.pas

Raize控件汉化版

{===============================================================================
  RzShellOpenForm Unit

  Raize Components - Component Source Unit
  Raize Shell Controls are licensed from Plasmatech Software Design.


  Components
  ------------------------------------------------------------------------------
  TRzShellOpenSaveForm
    Custom dialog box form for Open and Save Dialog boxes.


  Modification History
  ------------------------------------------------------------------------------
  4.0    (23 Dec 2005)
    * Fixed problem where invoking the Open/Save dialog and specifying a
      DefaultExt but not any filters, caused an Index Out of Range exception if
      the user typed a file without an extension and closed the dialog box.
    * Fixed problem where invoking a TRzOpenDialog or TRzSaveDialog in Delphi 5
      would result in an exception.
    * Fixed issue where certain REG_EXPAND_SZ format Custom Places were not
      handled correctly in the TRzOpenDialog and TRzSaveDialog.
    * The icons displayed in the Custom Places bar now correctly pick up
      specialized folder icons.
  ------------------------------------------------------------------------------
  3.1    (04 Aug 2005)
    * The TRzOpenDialog and TRzSaveDialog components are now aware of changes
      made to the Custom Places bar.
    * Added new ButtonColor property to shell dialog boxes, which can be used to
      change the color of the push buttons used in the dialog boxes. This is
      useful when using the HotTracking feature.
  ------------------------------------------------------------------------------
  3.0.8  (29 Aug 2003)
    * Fixed problem where ShellList would not be initialized correctly if user
      specified a Filter and FilterIndex value for the TRzOpenDialog or
      TRzSaveDialog.
    * Replaced call to Application.HelpContext with a call to
      Application.HelpCommand to work-around the problem of HelpContext not
      generating a wm_Help message.
  ------------------------------------------------------------------------------
  3.0    (20 Dec 2002)
    * Initial inclusion in Raize Components.
  ------------------------------------------------------------------------------
  Copyright ?1995-2006 by Raize Software, Inc.  All Rights Reserved.
  Copyright ?1996-2006 by Plasmatech Software Design. All Rights Reserved.
===============================================================================}

{$I RzComps.inc}

{$RANGECHECKS OFF}
{$WRITEABLECONST OFF}
{$TYPEDADDRESS ON}

unit RzShellOpenForm;

interface

uses
  {$IFDEF USE_CS}
  CodeSiteLogging,
  {$ENDIF}
  Classes,
  Windows,
  Messages,
  Controls,
  Forms,
  Graphics,
  Menus,
  Contnrs,
  ComCtrls,
  StdCtrls,
  ExtCtrls,
  Buttons,
  RzCommon,
  RzListVw,
  RzTreeVw,
  RzCmboBx,
  RzPanel,
  RzSplit,
  ImgList,
  RzButton,
  RzRadChk,
  Mask,
  RzEdit,
  RzShellCtrls,
  RzShellDialogs;

type
  TRzShellOpenSaveForm_LIS = ( lisEdit, lisList ); // C++ Builder demands formal type decl for enumerations.

  TRzShellOpenSaveForm = class( TForm )
    ShellCombo: TRzShellCombo;
    UpOneLevelBtn: TSpeedButton;
    ListBtn: TSpeedButton;
    DetailsBtn: TSpeedButton;
    CreateNewFolderBtn: TSpeedButton;
    PnlEdits: TPanel;
    FileNameTxt: TLabel;
    FilesOfTypeTxt: TLabel;
    FileTypesCbx: TRzComboBox;
    FileNameEdt: TRzEdit;
    OpenBtn: TRzButton;
    CancelBtn: TRzButton;
    FileNameCbx: TRzComboBox;
    ReadOnlyChk: TRzCheckBox;
    ShowTreeBtn: TSpeedButton;
    HelpBtn: TRzButton;
    LvPopup: TPopupMenu;
    View1Mitm: TMenuItem;
    N1: TMenuItem;
    New1Mitm: TMenuItem;
    N2: TMenuItem;
    Properties1Mitm: TMenuItem;
    Folder1Mitm: TMenuItem;
    LargeIcons1Mitm: TMenuItem;
    Smallicons1MItm: TMenuItem;
    List1Mitm: TMenuItem;
    Details1Mitm: TMenuItem;
    Paste1Mitm: TMenuItem;
    N3: TMenuItem;
    ShowDesktopBtn: TSpeedButton;
    RzSplitter1: TRzSplitter;
    ShellTree: TRzShellTree;
    ShellList: TRzShellList;
    ImageList1: TImageList;
    PnlJumps: TPanel;
    btnPlace0: TRzToolButton;
    btnPlace1: TRzToolButton;
    btnPlace2: TRzToolButton;
    btnPlace3: TRzToolButton;
    btnPlace4: TRzToolButton;
    LookInTxt: TLabel;
    PnlWork: TPanel;
    procedure ViewBtnClick( Sender: TObject );
    procedure ShellListChange( Sender: TObject; Item: TListItem; Change: TItemChange );
    procedure UpOneLevelBtnClick( Sender: TObject );
    procedure ShowTreeBtnClick( Sender: TObject );
    procedure FormDestroy( Sender: TObject );
    procedure FormKeyDown( Sender: TObject; var Key: Word; Shift: TShiftState );
    procedure FormCloseQuery( Sender: TObject; var CanClose: Boolean );
    procedure ShellTreeChange( Sender: TObject; Node: TTreeNode );
    procedure FileTypesCbxSelEndOk( Sender: TObject );
    procedure CreateNewFolderBtnClick( Sender: TObject );
    procedure FileNameEdtChange( Sender: TObject );
    procedure Paste1MitmClick( Sender: TObject );
    procedure Properties1MitmClick( Sender: TObject );
    procedure HelpBtnClick( Sender: TObject );
    procedure ReadOnlyChkClick( Sender: TObject );
    procedure ShellListFolderChanged( Sender: TObject );
    procedure FormResize( Sender: TObject );
    procedure ShowDesktopBtnClick( Sender: TObject );
    procedure FormCreate(Sender: TObject);
    procedure btnPlaceClick(Sender: TObject);
  private
    {$IFDEF VCL60_OR_HIGHER}
    FPlacesList: TObjectList;
    {$ENDIF}
    function FormHelp( Command: Word; Data: Integer; var CallHelp: Boolean ): Boolean;
    procedure ListDblClickOpen( Sender: TObject;  var Handled: Boolean );
    procedure WMGetMinMaxInfo( var Msg: TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;
    {$IFDEF VCL60_OR_HIGHER}
    procedure InitCustomPlaces;
    procedure JumpToPlace( Num: Integer );
    {$ENDIF}
  protected
    FDefaultExt: string;
    FOptions: TRzOpenSaveOptions;
    FFiles: TStrings;  // Last request for 'files'
    FFilter: string;
    FInitialDir: string;

    FOnTypeChanged: TNotifyEvent;
    FOnFolderChanged: TNotifyEvent;
    FOnSelectionChanged: TNotifyEvent;
    FOnFormShow: TNotifyEvent;
    FOnFormClose: TNotifyEvent;
    FOnFormHelp: THelpEvent;

    procedure DoOnFormClose; dynamic;
    procedure DoOnFolderChanged; dynamic;
    procedure DoOnSelectionChanged; dynamic;
    procedure DoOnFormShow; dynamic;
    procedure DoOnTypeChanged; dynamic;

    function  GetFilename: string;
    function  GetFiles: TStrings;
    function  GetFilterIndex: Integer;
    function  GetFormSplitterPos: Integer;
    function  GetOnAddListItem: TRzShAddItemEvent;
    function  GetOnAddTreeItem: TRzShAddItemEvent;
    function  GetOnAddComboItem: TRzShAddItemEvent;

    procedure SetFilename( const Value: string );
    procedure SetFilter( const Value: string );
    procedure SetFilterIndex( Value: Integer );
    procedure SetFormSplitterPos( Value: Integer );
    procedure SetInitialDir( const Value: string );
    procedure SetOptions( Value: TRzOpenSaveOptions );
    procedure SetOnAddListItem( Value: TRzShAddItemEvent );
    procedure SetOnAddTreeItem( Value: TRzShAddItemEvent );
    procedure SetOnAddComboItem( Value: TRzShAddItemEvent );

  protected
    FUserFilter: string; // Used for filters typed into the filename box
    FExecuting: Boolean;

    FSelections: TStrings;
    FLastInputState: TRzShellOpenSaveForm_LIS;

    FHGripWindow: HWND;

    procedure CreateWnd; override;
    procedure DoTranslation; dynamic;
    procedure ApplyUserFilter( Filter: string );
    procedure GetSelectedFiles( s: TStrings );
    procedure ShowTree( Show: Boolean );

    procedure DoHide; override;
    procedure DoShow; override;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    function  ParseInputstring( const ins: string ): Boolean;

    procedure InitFraming( FrameColor: TColor; FrameStyle: TFrameStyle;
                           FrameVisible: Boolean;
                           FramingPreference: TFramingPreference );
    procedure InitHotTracking( ButtonColor: TColor;
                               HotTrack: Boolean; HighlightColor: TColor;
                               HotTrackColor: TColor;
                               HotTrackColorType: TRzHotTrackColorType );

    property DefaultExt: string
      read FDefaultExt
      write FDefaultExt;

    property Executing: Boolean
      read FExecuting;

    property Options: TRzOpenSaveOptions
      read FOptions
      write SetOptions;

    property FileName: string
      read GetFilename
      write SetFilename;

    property Files: TStrings
      read GetFiles;

    property Filter: string
      read FFilter
      write SetFilter;

    property FilterIndex: Integer
      read GetFilterIndex
      write SetFilterIndex
      default 1; // Does default count in this situation?

    property FormSplitterPos: Integer
      read GetFormSplitterPos
      write SetFormSplitterPos
      default -1; // Does default count in this situation?

    property HelpContext;

    property InitialDir: string
      read FInitialDir
      write SetInitialDir;

    property OnAddListItem: TRzShAddItemEvent
      read GetOnAddListItem
      write SetOnAddListItem;

    property OnAddTreeItem: TRzShAddItemEvent
      read GetOnAddTreeItem
      write SetOnAddTreeItem;

    property OnAddComboItem: TRzShAddItemEvent
      read GetOnAddComboItem
      write SetOnAddComboItem;

    property OnHelp;

    property OnFormHelp: THelpEvent
      read FOnFormHelp
      write FOnFormHelp;

    property OnFormClose: TNotifyEvent
      read FOnFormClose
      write FOnFormClose;

    property OnFormShow: TNotifyEvent
      read FOnFormShow
      write FOnFormShow;

    property OnFolderChanged: TNotifyEvent
      read FOnFolderChanged
      write FOnFolderChanged;

    property OnSelectionChanged: TNotifyEvent
      read FOnSelectionChanged
      write FOnSelectionChanged;

    property OnTypeChanged: TNotifyEvent
      read FOnTypeChanged
      write FOnTypeChanged;
  end;


implementation

{$R *.dfm}

uses
  SysUtils,
  Dialogs,
  TypInfo,
  Registry,
  ShlObj,
  RzShellConsts,
  RzShellIntf,
  RzShellUtils;

const
  SIZEGRIP_SIZE = 13;


{The list of filter strings is thus:
  [Visible][TStringList of extensions:[]]
  ---------------------------------------
  [Item1 ( *.* )][ [*.*] ]
  [Item2 ( *.doc )][ [*.doc] ]
  [Item3 ( *.gif, *.jpg, *.bmp )][ [*.gif][*.jpg][*.bmp] ]
}

type
  TFilterItemRec = record
    FExtension: string;
  end;
  PFilterItemRec = ^TFilterItemRec;


function NewFilterItemRec: PFilterItemRec;
begin
  New( Result );
end;


procedure DisposeFilterItemRec( pfir: PFilterItemRec );
begin
  Dispose( pfir );
end;


procedure GetCharsUpToNextCharDB( var Pos: Integer; Source: string; var Dest: string; CharToFind: Char );
begin
  Dest := '';
  while ( Source[ Pos ] <> CharToFind ) and ( Pos <= Length( Source ) ) do
    CopyCharDB( Pos, Source, Dest );
end;


// Takes a filter in the form "FileType1|*.ext11;*.ext12;*.ext1n|FileType2|*.ext21|" etc.
// and fills astrings.strings[] with the FileType part and the .Objects[] part with a TFilterItemRec.
// The TFilterItemRec comprises a TStringList itSelf which is a list of all the extensions
// eg. [*.ext11][*.ext12][*.ext1n]. The ExtensionsToTStrings method takes a semi-colon delimited list of
// extensions and adds them to a TStrings.

procedure FilterToTStrings( Filter: string; Strings: TStrings );
var
  pos: Integer;
  tmp: string;
  displayName: string;
  extensions: string;  // All extensions ( *.gif;*.jpg;*.bmp;etc... )
  p: PFilterItemRec;
begin
  pos := 1;
  SetLength( tmp, 255 ); tmp:='';  // Allocate some space now to prevent reallocations
  while ( pos <= Length( Filter ) ) do
  begin
   // Get all chars up to '|' character
    GetCharsUpToNextCharDB( pos, Filter, displayName, '|' ); Inc( pos ); // skip bar
    GetCharsUpToNextCharDB( pos, Filter, extensions, '|' );  Inc( pos ); // skip bar
    p := NewFilterItemRec;
    p.FExtension := extensions;
    Strings.AddObject( displayName, TObject( p ) );
  end;
end;


procedure FilterstringsFree( Strings: TStrings );
var
  I: Integer;
begin
  for I := 0 to Strings.Count-1 do
    DisposeFilterItemRec( Pointer( Strings.Objects[ I ] ) );
end;

{$IFDEF VCL60_OR_HIGHER}

function GetFriendlyCaption( CSIDL: TCSIDL ): string; overload;
var
  idList: PItemIdList;
begin
  try
    ShellGetSpecialFolderIdList( 0, CSIDL, idList );
    Result := ShellGetFriendlyNameFromIdList( nil, idList, fnNormal );
  finally
    ShellMemFree( idlist );
  end;
end;


function GetFriendlyCaption( const path: string ): string; overload;
var
  idList: PItemIdList;
begin
  try
    ShellGetIdListFromPath( path, idList );
    Result := ShellGetFriendlyNameFromIdList( nil, idList, fnNormal );
  finally
    ShellMemFree( idList );
  end;
end;

{$ENDIF}


{$IFDEF VCL60_OR_HIGHER}

{========================}
{== TRzPlaceData Class ==}
{========================}

type
  TRzPlaceData = class
    CSIDL: TCSIDL;
    Caption: string;