lsfileexplorer27.pas

TLsDirComboBox 及 TLsFileListView 是类似资源管理器 ( File Explorer ) 式样的加强版 TComboBox 构件

{Unit LsFileExplorer27.pas  v2.70}
{=============================================================================}
{
Archive    :- FileExpl.zip

Components :- TLsDirTree20, TLsDirTreeCombo27 and
              TLsFilelistView27

Version    :- 2.70  For Delphi versions 3, 4 and 5

Author     :- Leo D. Shih <[e-mail]>

Copyright  :- (C)1998/2000 Leo D. Shih, All rights reserved

------------------------------------------------------------------------------
DISCLAIMER
==========
  These components are currently distributed as Freeware, without
  warranty of any kind, either expressed or implied. In no event shall
  the author be liable for any problems or damages that may result from
  the use of these components.

  Suggestions for improvement or bug-fixing will be welcome.
------------------------------------------------------------------------------
ACKNOWLEDGMENTS
===============
  I'm most grateful to those people in the Delphi community who have
  reported bugs, suggested fixings or recommanded improvements. In
  particular, I would like to thank Ales Trtnik, Brad Huggins,
  Claude Hunter, Detlef Scheil, Harrie Roaymans, Marcelo Rodrigues,
  Helmut Knaack, Peter Caliban, Steve Pinneo, and Tom Lisjac for their
  professional suggestions.

------------------------------------------------------------------------------
Brief Description
=================

TLsDirTree20
------------
  TLsDirTree20 is a simple but fully functional Directory TreeView, that
  displays the structure of the File System. It supports creating, renaming
  and deleting of directories, it can also calculate the size of a selected
  portion of the directory-tree, through the use of its context menu.

TLsDirTreeCombo27
-----------------
  TLsDirTreeCombo27 is a specialized ComboBox with a dropdown Directory
  TreeView, that is similar to TLsDirTree20, displaying a hierarchical tree
  of drives and directories of the File System.

TLsFilelistView27 w/TLsFileListView27PopUp
------------------------------------------
  TLsFilelistView27 is a File ListView component. In addition to its normal
  functions, it can perform various file management tasks, such as cut, copy,
  paste, rename, delete, open, view and send_to operations on files.  It also
  provides statistics on Disk-FreeSpace, Selected-Numbers and Selected-Size as
  those available in the Windows Explorer.

  TLsFileListView27PopUp is LsFilelistView27's Context Menu, containing
  commands that perform operations on files.

  -> For further information please refer to LsFileExplorer27.txt
                                                                              }
{=============================================================================}


{$IFNDEF VER80}  // If not Delphi 1     //53
{$DEFINE D2_OR_HIGHER}
{$IFNDEF VER90}  // If not Delphi 2
{$DEFINE D3_OR_HIGHER}
{$IFNDEF VER100} // If not Delphi 3
{$DEFINE D4_OR_HIGHER}
{$IFNDEF VER120} // If not Delphi 4
{$DEFINE D5_OR_HIGHER}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}


unit LsFileExplorer27;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Buttons,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, CommCtrl, FileCtrl, ShellAPI,
  ClipBrd, Menus,
{$IFNDEF D3_OR_HIGHER}
  ShellObj, OLE2
{$ELSE}
  ShlObj, ActiveX, ComObj
{$ENDIF}
{$IFDEF D4_OR_HIGHER},
  ImgList
{$ENDIF}
{$IFNDEF D5_OR_HIGHER},
  DsgnIntf
{$ENDIF};


type

  TFileAttr = (ftReadOnly, ftHidden, ftSystem, ftArchive, ftNormal);
  TFileType = set of TFileAttr;

  TDTFormat = (df_MMddyyyy, df_MMddyy, df_ddMMyyyy, //70
    df_ddMMyy_GB, df_ddMMyy_DE, df_ddMMyy_IT,
    df_yyyyMMdd, df_yyMMdd, df_Customize);

  TLsFilelistView27 = class;
  TLsFileListView27PopUp = class;
  TLsDirTreeCombo27 = class;
  TLsDirTree20PopUp = class;
{$IFNDEF D5_OR_HIGHER}
  TAboutProperty = class;
{$ENDIF}

  {*******************************************}
  {             TLsDirTreeView                }
  {  Drop-down TreeView of TLsDirTreeCombo27  }
  {*******************************************}

  TLsDirTreeView = class(TCustomTreeView)
  private
    TreeViewPath: string;
    FSelectedPath: string;
    FExpandRoot: Boolean;
    FMouseInControl: Boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message
      WM_LBUTTONDOWN;

  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Expand(Node: TTreeNode); override;
    procedure LoadDrives;
    procedure MakePath(Node: TTreeNode);
    procedure AddSubs(Path: string; Node: TTreeNode);
    procedure Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
  end;

  {*******************************************}
  {            TLsDirTreeCombo27              }
  {*******************************************}

  TLsDirTreeCombo27 = class(TCustomEdit)
    Btn: TSpeedButton;
    Tree: TLsDirTreeView;

  private

{$IFNDEF D5_OR_HIGHER}
    FAbout: TAboutProperty;
{$ENDIF}
    FFileList: TLsFilelistView27;
    FWinDir: string;
    ImageIndex: integer;
    ImagLst: TImageList;
    FCanvas: TControlCanvas;

  protected
    procedure CreateWnd; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetEditRect;
    procedure BtnClick(Sender: TObject);
    function GetFileList: TLsFilelistView27;
    procedure SetFileList(Value: TLsFilelistView27);
    function GetBtnGlyph: TBitmap;
    procedure SetBtnGlyph(NewValue: TBitmap);
    function GetTreeHeight: Integer;
    procedure SetTreeHeight(newValue: Integer);
    function GetSelectedPath: string;
    procedure SetSelectedPath(Value: string);
    function GetExpandRoot: Boolean;
    procedure SetExpandRoot(Value: Boolean);
    function GetHideSelection: Boolean;
    procedure SetHideSelection(Value: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure Keydown(var Key: Word; Shift: TShiftState); override; //52

  public
  { Public declarations }
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure SetBounds(Left, Top, Width, Height: Integer); override;
    procedure OpenPath(dPath: string);
    procedure ResetTreeView;

  published
{$IFNDEF D5_OR_HIGHER}
    property About: TAboutProperty read FAbout write FAbout;
{$ENDIF}
    property SelectedPath: string read GetSelectedPath write SetSelectedPath;
    property FileList: TLsFilelistView27 read GetFileList write SetFileList;
    property ExpandRoot: Boolean read GetExpandRoot write SetExpandRoot
      default True;
    property HideSelection: Boolean read GetHideSelection
      write SetHideSelection default True;
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property HelpContext;
    property Hint;
    property Left;
    property Name;
    property Glyph: TBitmap read GetBtnGlyph write SetBtnGlyph;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly; //53+
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Tag;
    property Top;
    property TreeHeight: Integer read GetTreeHeight write SetTreeHeight;
    property Visible;
    property Width;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
{$IFDEF D4_OR_HIGHER}
    property Anchors;
    property BiDiMode;
    property Constraints;
{$ENDIF}
  end;

 {*******************************************}
 {             TLsDirTree20              //60}
 {*******************************************}

  TLsDirTree20 = class(TCustomTreeView)
  private
    FFileList: TLsFilelistView27;
    FSelectedPath: string;
    TreeViewPath: string;
    FPopUpMenu: TLsDirTree20PopUp;
    FPopUpMenuEnabled: Boolean;
    FIsNewFolder: Boolean;
{$IFNDEF D5_OR_HIGHER}
    FAbout: TAboutProperty;
{$ENDIF}

  protected
    procedure CreateWnd; override;
    procedure SetSelectedPath(Value: string);
    procedure Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure MouseDown(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure LoadRoot;
    procedure LoadDrives;
    procedure Loaded; override;
    procedure MakePath(Node: TTreeNode);
    procedure AddSubs(Path: string; Node: TTreeNode);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function CanEdit(Node: TTreeNode): Boolean; override;
    procedure Edit(const Item: TTVItem); override;
    procedure SetPopUpMenuEnabled(Value: Boolean);
    procedure SetFileList(Value: TLsFilelistView27);
    function GetPathFromNode(Node: TTreeNode): string;

  public
  { Public declarations }
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure ReLoad;
    procedure OpenPath(dPath: string);
    function AddNewNode(ParentNode: TTreeNode; NodeName: string):
      Boolean;
    function DeleteNode(Node: TTreeNode): Boolean;
    function GetTreeSize: integer;

  published
{$IFNDEF D5_OR_HIGHER}
    property About: TAboutProperty read FAbout write FAbout;
{$ENDIF}
    property FileList: TLsFilelistView27 read FFileList write SetFileList;
    property SelectedPath: string read FSelectedPath write SetSelectedPath;
    property PopUpMenuEnabled: Boolean read FPopUpMenuEnabled
      write SetPopUpMenuEnabled default True;
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property HelpContext;
    property HideSelection;
    property Hint;
    property Images;
    property Indent;
    property Items;
    property Left;
    property Name;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowButtons;
    property ShowHint;
    property ShowLines;
    property ShowRoot;
    property SortType;
    property TabOrder;
    property TabStop;
    property Tag;
    property Top;
    property Visible;
    property Width;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnCollapsed;
    property OnCollapsing;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEditing;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnExpanded;
    property OnExpanding;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  { ***** TLsDirTree20PopUp ***** }

  TLsDirTree20PopUp = class(TPopupMenu)
  private
    FDirTree: TLsDirTree20; //70
    Bmp1,
      Bmp2,
      Bmp3,
      Bmp4: HBitmap; //70
  protected
    function AddNewItem(const aCaption: string; aShortCut: TShortCut;
      aChecked, aEnabled: Boolean; aGroup: integer; aOnClick: TNotifyEvent;
      hCtx: word; const aName: string; aBitMap: HBitMap): TMenuItem;

    procedure SetDirTree(Value: TLsDirTree20);
    procedure ItemOnClick(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BuildItems;
    procedure Popup(X, Y: integer); override;
    property DirTree: TLsDirTree20 read FDirTree;
  end;


 {*******************************************}
 {           LsFileListView26                }
 {*******************************************}

  TLsFilelistView27 = class(TCustomListView)
  private
  { Private declarations }
    FColumnWidths: record
      cwName: integer;
      cwSize: integer;
      cwType: integer;
      cwMod: integer;
      cwAttr: integer;
    end;
{$IFNDEF D5_OR_HIGHER}
    FAbout: TAboutProperty;
{$ENDIF}
    FDirTreeCombo: TLsDirTreeCombo27;
    FDirTree: TLsDirTree20;
    FDirectory: string;
    FDirectorySize: integer;
    FSelectedItem: string;
    FFileType: TFileType;
    FOpMode: Integer;
    FMask: string;
    FPopupMenu: TLsFileListView27PopUp;
    FPopUpMenuEnabled: Boolean;
    FSelectedFiles: TStrings;
    FShowFolders: Boolean;
    FSortColumn: integer;
    FSortForward: boolean;
    OldFName: string;
    FDblClickToOpen: Boolean; //70
    FDateFormat: TDTFormat; //70
    FDFormatStr: string; //70
    FTFormatStr: string; //70
    FHideFileExt: Boolean; //70
    GoUpIdx: integer; //70
    SGoUpBmp: TBitmap; //70
    LGoUpBmp: TBitmap; //70
    Bmp_Up: HBitMap; //70
    Bmp_Down: HBitMap; //70
    FBitMap: TBitmap; //70
    FColumnClickEnabled : Boolean;  //70

    function GetFreeSpace: Integer;
    function GetSelectedNum: Integer;
    function GetSelectedSize: Integer;

    procedure Createimages;
    procedure CompareFiles(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ColumnClick(Sender: TObject; Column: TListColumn);
    procedure SetPopUpMenuEnabled(Value: Boolean);
    procedure SetDblClickToOpen(Value: Boolean);

  protected
  { Protected declarations }
    function AddFiles(FileMask: string; Attr: DWORD): Boolean;
    function CanEdit(Item: TListItem): Boolean; override;
    function GetSelectedItem: string;
    function GetDirectory: string;

    procedure AddDrives;
    procedure Click; override;
    procedure CreateWnd; override;
    procedure CreateDriveColumns;
    procedure CreateFileColumns;
    procedure DblClick; override;
    procedure Edit(const Item: TLVItem); override;
    procedure Loaded; override;
    procedure Keydown(var Key: Word; Shift: TShiftState); override;
    procedure SetDirectory(NewDir: string);
    procedure SetDirTreeCombo(Val: TLsDirTreeCombo27);
    procedure SetDirTree(VaL: TLsDirTree20);
    procedure SetSelectedItem(NewItem: string);
    procedure SetFileType(NewFileType: TFileType);
    procedure SetMask(const NewMasks: string);
    procedure SetShowFolders(Value: Boolean);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SendTo(SubItems: integer);
    procedure SendTo2(Path: string);
    procedure SendToPath(DestPath: string);
    procedure SendToDrive(DriveID: string);
    procedure SetHideFileExt(Value: Boolean); //70
    procedure SetDaTeFormat(Value: TDTFormat); //70
    procedure SetTFormatStr(Value: string); //70