bsskinshellctrls.pas

漂亮的皮肤控件 for delphi 567

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 2.52                                                }
{                                                                   }
{       Copyright (c) 2000-2003 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit bsSkinShellCtrls;

{$WARNINGS OFF}
{$HINTS OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, CommCtrl, ShellAPI, ShlObj,
  Menus, ImgList, bsSkinCtrls, BusinessSkinForm, bsSkinData, bsSkinBoxCtrls,
  bsFileCtrl, bsMessages;

type
  TDiskSign = String[2];

  TMediaType = (dtUnknown, dtNotExists, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk);

  TFileFlag = (fsCaseIsPreserved, fsCaseSensitive, fsUnicodeStoredOnDisk,
               fsPersistentAcls, fsFileCompression, fsVolumeIsCompressed,
               fsLongFileNames,
               fsEncryptedFileSystemSupport, fsObjectIDsSupport, fsReparsePointsSupport,
               fsSparseFilesSupport, fsDiskQuotasSupport);
  TFileFlags = set of TFileFlag;

  TDiskInfo = record
    Sign: TDiskSign;
    MediaType: TMediaType;
    FileFlags: TFileFlags;
    SectorsPerCluster,
    BytesPerSector,
    FreeClusters,
    TotalClusters,
    Serial: DWORD;
    Capacity,
    FreeSpace: Int64;
    VolumeLabel,
    SerialNumber,
    FileSystem: String;
  end;

  TObjectType = (otFile, otDirectory, otDisk);
  TObjectTypes = set of TObjectType;

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

  TbsSkinFileListView = class(TbsSkinListView)
  private
    FSkinMessage: TbsSkinMessage;
    FDirectory: String;
    FDirectorySize: integer;
    FFileName: String;
    FFileType: TFileType;
    FMask: String;
    FContextMenu: Boolean;
    FSortColumn: integer;
    FSortForward: boolean;
    LImageList, SImageList: TImageList;
    FContextAction: Boolean;
    FSelectedFiles :tStringlist;
    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 WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
      Shift: TShiftState);
    function GetSelectedFilenames: String;
    function GetObjectTypes: TObjectTypes;
    function GetDiskCap: Int64;
    function GetDiskFree: Int64;
  protected
    function AddFile(FileMask: String; Attr: DWORD): Boolean;
    function GetFileName: String;
    function GetDirectory: String;
    procedure AddDrives;
    procedure Click; override;
    procedure DblClick; override;
    procedure Keydown(var Key: Word; Shift: TShiftState); override;
    procedure SetFileName(NewFile: String);
    procedure SetDirectory(NewDir: String);
    procedure SetFileType(NewFileType: TFileType);
    procedure SetMask(const NewMasks: String);
    function GetDiskInfo(Value: TDiskSign): TDiskInfo;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;
    procedure OneLevelUp;
    procedure UpdateFileList;
    property FileName: String read GetFileName write SetFileName;
    property DiskCapacity: Int64 read GetDiskCap;
    property DiskFree: Int64 read GetDiskFree;
    function GetMediaTypeStr(MT: TMediaType): String;
    function IsFile(Item: TListItem): Boolean;
  published
    property SkinMessage: TbsSkinMessage
     read FSkinMessage write FSkinMessage; 
    property HScrollBar;
    property VScrollBar;
    property SkinData;
    property SkinDataName;
    property Directory: String read GetDirectory write SetDirectory;
    property FileType: TFileType read FFileType write SetFileType;
    property Mask: String read FMask write SetMask;
    property ContextMenu: Boolean read FContextMenu write FContextMenu;
    property ContextAction: Boolean read FContextAction write FContextAction;
    property SelectedCount: Integer read GetSelectedNum;
    property SelectedSize: Integer read GetSelectedSize;
    property SelectedFilenames :String read GetSelectedFilenames;
    property SelectedTypes :TObjectTypes read GetObjectTypes;
    property Align;
    property BorderStyle;
    property Color;
    property DragCursor;
    property Font;
    property HideSelection;
    property IconOptions;
    property MultiSelect;
    property ParentShowHint;
    property ReadOnly;
    property RowSelect;
    property ShowColumnHeaders;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property ViewStyle;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnColumnClick;
    property OnCompare;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEditing;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnInsert;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TDirChangeEvent = procedure(Sender: TObject; SelectedPath: string) of object;

  TbsSkinDirTreeView = class(TbsSkinCustomTreeView)
  private
    FSkinMessage: TbsSkinMessage;
    FPreviousPath: string;
    FSelectedPath: string;
    TreeViewPath: string;
    OldTreeViewPath: string;
    FIsNewFolder: Boolean;
    FInitialDir: String;
    FisCutCopy: Boolean;
    FOpMode: integer;
    FSrcPath: string;
    FDestPath: String;
  protected
    function GetDirectory: String;
    procedure SetDirectory(Value: String);
    procedure CreateWnd; override;
    procedure Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure LoadRoot;
    procedure LoadDrives;
    procedure Loaded; override;
    procedure AddSubs(Path: string; Node: TTreeNode);
    procedure MakePath(Node: TTreeNode);
    procedure MouseDown(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure SetInitialDir(Value: string);
    procedure SetSelectedPath(Value: string);
    function CanEdit(Node: TTreeNode): Boolean; override;
    procedure Edit(const Item: TTVItem); override;
    function GetPathFromNode(Node: TTreeNode): string;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    property InitialDir: string read FInitialDir Write SetInitialDir;
    procedure ChangeSkinData; override;
    procedure ReLoad;
    procedure OpenPath(dPath: string);
    property Images;
    property Items;
    property Directory: String read GetDirectory write SetDirectory;
  published
    property SkinMessage: TbsSkinMessage
     read FSkinMessage write FSkinMessage; 
    property HScrollBar;
    property VScrollBar;
    property SkinData;
    property SkinDataName;
    property Align;
    property BorderStyle;
    property Color;
    property DragCursor;
    property Enabled;
    property Font;
    property Height;
    property HelpContext;
    property HideSelection;
    property Hint;
    property Indent;
    property Left;
    property Name;
    property ParentColor;
    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 OnClick;
    property OnChange;
    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;
    property Anchors;
    property BiDiMode;
    property Constraints;
  end;

  TbsSkinShellDriveComboBox = class(TbsSkinComboBox)
  private
    Drives: TStrings;
    DriveItemIndex: Integer;
    Images: TImagelist;
    FDrive: Char;
    FOnChange: TNotifyEvent;
  protected
    procedure CreateWnd; override;
    procedure DrawItem(Cnvs: TCanvas; Index: Integer;
      ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
    procedure BuildList; virtual;
    procedure SetDrive(Value: Char);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateDrives;
    procedure Change; override;
  published
    property Drive: Char read FDrive write SetDrive;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { Dialogs }

  TbsSelDirDlgForm = class(TForm)
  public
    BSF: TbsBusinessSkinForm;
    DirTreeViewPanel, BottomPanel: TbsSkinPanel;
    DirTreeView: TbsSkinDirTreeView;
    VScrollBar, HScrollBar: TbsSkinScrollBar;
    OkButton, CancelButton: TbsSkinButton;
    constructor Create(AOwner: TComponent); override;
  end;

  TbsSkinSelectDirectoryDialog = class(TComponent)
  private
    FSkinMessage: TbsSkinMessage;
    FSD: TbsSkinData;
    FCtrlFSD: TbsSkinData;
    FDefaultFont: TFont;
    FTitle: String;
    FDlgFrm: TbsSelDirDlgForm;
    FOnChange: TNotifyEvent;
    FDirectory: String;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetDefaultFont(Value: TFont);
  protected
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure Change;
  public
    DialogWidth, DialogHeight: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property SkinMessage: TbsSkinMessage
       read FSkinMessage write FSkinMessage;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property Title: string read GetTitle write SetTitle;
    property Directory: String read FDirectory write FDirectory;
  end;

  TbsOpenDlgForm = class(TForm)
  private
    FromFLV: Boolean;
    FromFTV: Boolean;
    FromDCB: Boolean;
    SaveMode: Boolean;
  public
    FileName: String;
    BSF: TbsBusinessSkinForm;
    DirTreeViewPanel: TbsSkinExPanel;
    FileListViewPanel,
    BottomPanel: TbsSkinPanel;
    Splitter: TbsSkinSplitter;
    DTVHScrollBar, DTVVScrollBar,
    FLVHScrollBar, FLVVScrollBar: TbsSkinScrollBar;
    DirTreeView: TbsSkinDirTreeView;
    FileListView: TbsSkinFileListView;
    FileNameEdit: TbsSkinEdit;
    FilterComboBox: TbsSkinFilterComboBox;
    OpenButton, CancelButton: TbsSkinButton;
    OpenFileLabel, FileTypeLabel: TbsSkinStdLabel;
    ToolPanel: TbsSkinPanel;
    ListToolButton, ReportToolButton,
    IconToolButton, SmallIconToolButton, BackToolButton: TbsSkinSpeedButton;
    Bevel1, Bevel2, Bevel3: TbsSkinBevel;
    DriveBox: TbsSkinShellDriveComboBox;
    SortNameToolButton, SortSizeToolButton, SortDateToolButton: TbsSkinSpeedButton;
    constructor CreateEx(AOwner: TComponent; ASaveMode: Boolean);
    procedure FLVChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure DTVChange(Sender: TObject; Node: TTreeNode);
    procedure FCBChange(Sender: TObject);
    procedure DCBChange(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
    procedure FLVDBLClick(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);

    procedure ReportToolButtonClick(Sender: TObject);
    procedure ListToolButtonClick(Sender: TObject);
    procedure SmallIconToolButtonClick(Sender: TObject);
    procedure IconToolButtonClick(Sender: TObject);
    procedure BackToolButtonClick(Sender: TObject);

    procedure SortNameToolButtonClick(Sender: TObject);
    procedure SortSizeToolButtonClick(Sender: TObject);
    procedure SortDateButtonClick(Sender: TObject);
  end;

  TbsSkinOpenDialog = class(TComponent)
  private
    FSkinMessage: TbsSkinMessage;
    FSD: TbsSkinData;
    FCtrlFSD: TbsSkinData;
    FLVHeaderSkinDataName: String;
    FDefaultFont: TFont;
    FTitle: String;
    FDlgFrm: TbsOpenDlgForm;
    FOnChange: TNotifyEvent;
    FInitialDir: String;
    FFilter: String;
    FFileName: String;
    FFilterIndex: Integer;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FAlphaBlendAnimation: Boolean;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetDefaultFont(Value: TFont);
  protected
    FSaveMode: Boolean;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
    procedure Change;
  public
    TreePanelWidth: Integer;
    TreePanelRollState: Boolean;
    ListViewStyle: TViewStyle;
    DialogWidth, DialogHeight: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
  published
    property SkinMessage: TbsSkinMessage
       read FSkinMessage write FSkinMessage;
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property LVHeaderSkinDataName: String
     read FLVHeaderSkinDataName write FLVHeaderSkinDataName;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property Title: string read GetTitle write SetTitle;
    property InitialDir: String read FInitialDir write FInitialDir;
    property Filter: String read FFilter write FFilter;
    property FilterIndex: Integer read FFilterIndex write FFilterIndex;
    property FileName: String read FFileName write FFileName;
  end;

  TbsSkinSaveDialog = class(TbsSkinOpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TbsSkinDirectoryEdit = class(TbsSkinEdit)
  protected