dcfolderview.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

{*******************************************************************************

  Disk Controls pack v3.5
  FILE: dcFolderView.pas - dcFolderListView and dcFolderTreeView components

  Copyright (c) 1999-2002 UtilMind Solutions
  All rights reserved.
  E-Mail: [e-mail], [e-mail]
  WWW: http://www.appcontrols.com, http://www.utilmind.com

  The entire contents of this file is protected by International Copyright
Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
or any portion of the code contained in this file is strictly prohibited and
may result in severe civil and criminal penalties and will be prosecuted to
the maximum extent possible under the law.

*******************************************************************************}
{$I umDefines.inc}

unit dcFolderView;

interface

uses
  Windows, Messages, Classes, Controls, Graphics,
  ComCtrls, CommCtrl, dcInternal, dcComCtrls, dcDiskScanner,
  {$IFDEF D3}dcShellProperties, {$ENDIF} dcFileAssociation, dcFolderMonitor,
  dcFileOperations;

type
  TdcFolderListView = class;

  TdcListColumn = class(TPersistent)
  private
    FAlignment: TAlignment;
    FCaption: String;
    FWidth: TWidth;
    FVisible: Boolean;

    { for internal use }
    IsNameColumn: Boolean;
    FolderListView: TdcFolderListView;
    Column: TListColumn;

    procedure CreateColumn(Columns: TListColumns; Order: Byte);

    function  GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
    function  GetCaption: String;
    procedure SetCaption(const Value: String);
    function  GetWidth: TWidth;
    procedure SetWidth(Value: TWidth);
    procedure SetVisible(Value: Boolean);
  protected
  public
    constructor Create(aFolderListView: TdcFolderListView; aIsNameColumn: Boolean);
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    property Caption: String read GetCaption write SetCaption;
    property Width: TWidth read GetWidth write SetWidth;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

  TdcListColumns = class(TPersistent)
  private
    FName, FSize, FType, FModified, FAttributes: TdcListColumn;
  public
    constructor Create(aFolderListView: TdcFolderListView);
    destructor Destroy; override;
  published
    property Name: TdcListColumn read FName write FName;
    property Size: TdcListColumn read FSize write FSize;
    property FileType: TdcListColumn read FType write FType;
    property Modified: TdcListColumn read FModified write FModified;
    property Attributes: TdcListColumn read FAttributes write FAttributes; 
  end;

  TdcFolderChangedEvent = procedure(Sender: TObject; Folder: String) of object;
  TdcFolderListViewOptions = set of (floOpenFiles, floExploreFolders, floShowContextMenu, floAllowDelete);
  TdcFolderListView = class(TumCustomListView)
  private
    FFolderMonitor: TdcFolderMonitor;  
    FKBStr: String;
    FOptions: TdcFolderListViewOptions;
    FReportColumns: TdcListColumns;
    FShowFileExtensions: Boolean;

    { for internal use }
    ListUpdated, Busy: Boolean;
    OldControlCursor: TCursor;    
    FSmallImages, FLargeImages: THandle; { system images }
    CurrentOrder: Byte;
    ColumnOrders: Array[0..4] of Byte;

    FFiles: TList;

    FDiskScanner: TdcDiskScanner;
{$IFDEF D3}
    FShellProperties: TdcShellProperties;
{$ENDIF}    
    FFileAssociation: TdcFileAssociation;

    FOnFolderChanged: TdcFolderChangedEvent;
    FOnBeginUpdate, FOnEndUpdate: TNotifyEvent;

    function  GetFolder: String;
    procedure SetFolder(const Value: String);
    function  GetFileMask: String;
    procedure SetFileMask(const Value: String);
    procedure SetFolderMonitor(Value: TdcFolderMonitor);
    function  GetFileAttributes: TdcScanAttributes;
    procedure SetFileAttributes(Value: TdcScanAttributes);
    function  GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
    function  GetShowAllFolders: Boolean;
    procedure SetShowAllFolders(Value: Boolean);
    procedure SetShowFileExtensions(Value: Boolean);
    procedure SetKBStr(Value: String);

    procedure ScanDone(Sender: TObject; TotalFiles: Integer;
                       const TotalSize: Extended; ElapsedTimeInSeconds: Integer);
    procedure FileFound(Sender: TObject; const FileName, FileType: String;
                        const FileSize: Extended; const FileTime: TDateTime;
                        const FileAttributes: TdcScanAttributes;
                        const LargeIcon, SmallIcon: TIcon; SysImageIndex: Integer;
                        TotalFiles: Integer; const TotalSize: Extended);
    procedure FolderMonitorOnChange(Sender: TObject);
    procedure ContextMenuOnDelete(Sender: TObject; const FileName: String);
    procedure ContextMenuOnRename(Sender: TObject; const FileName: String);

    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;    
    procedure CreateWnd; override;
    procedure Edit(const Item: TLVItem); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure UpdateListItems; override;    
    procedure InitColumns; virtual;
    procedure ExecuteListItem(ListItem: TListItem); virtual;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    function  FileNameByListItem(ListItem: TListItem): String; virtual;
    function  FileSizeByListItem(ListItem: TListItem): Extended; virtual;
    function  FileTypeByListItem(ListItem: TListItem): String; virtual;
    function  FileTimeByListItem(ListItem: TListItem): TDateTime; virtual;
    function  FileAttributesByListItem(ListItem: TListItem): TdcScanAttributes; virtual;
    function  ListItemByFileName(FileName: String): TListItem; virtual;
    function  DeleteSelectedFiles: Boolean; virtual;

    procedure Refresh; virtual;
    function  IsBackPossible: Boolean; virtual;
    procedure Back; virtual;
    procedure SelectAll; {$IFNDEF D6} virtual; {$ELSE} override; {$ENDIF}
    procedure UnselectAll; virtual;
    procedure CreateFolder(FolderName: String; Edit: Boolean); virtual;
    procedure CreateShortcut; virtual;
{$IFDEF D3}
    procedure ShowFolderProperties; virtual;
    procedure ShowItemProperties; virtual;
{$ENDIF}    
  published
    property Items stored False;
    property ViewStyle default vsIcon;
    property ReadOnly read GetReadOnly write SetReadOnly;

    property KBStr: String read FKBStr write SetKBStr;
    property Options: TdcFolderListViewOptions read FOptions write FOptions default [floOpenFiles, floExploreFolders, floShowContextMenu, floAllowDelete];
    property ReportColumns: TdcListColumns read FReportColumns write FReportColumns;
    property Folder: String read GetFolder write SetFolder;
    property FileMask: String read GetFileMask write SetFileMask;
    property FolderMonitor: TdcFolderMonitor read FFolderMonitor write SetFolderMonitor;    
    property FileAttributes: TdcScanAttributes read GetFileAttributes write SetFileAttributes default [saNormal, saArchive, saReadOnly, saSystem, saHidden, saDirectory, saAny];
    property ShowAllFolders: Boolean read GetShowAllFolders write SetShowAllFolders default True;
    property ShowFileExtensions: Boolean read FShowFileExtensions write SetShowFileExtensions default False;

    property OnFolderChanged: TdcFolderChangedEvent read FOnFolderChanged write FOnFolderChanged;
    property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate;
    property OnEndUpdate: TNotifyEvent read FOnEndUpdate write FOnEndUpdate;
  end;

implementation

uses Forms, SysUtils, ShellAPI, dcUtils;

{ *** SHELLOBJECT STRUCTURE FOR STORING FOLDER CONTENTS ***}
type
  TdcShellObject = class(TObject)
    FileName, FileType: String;
    FileSize: Extended;
    FileTime: TDateTime;
    Attributes: TdcScanAttributes;
    SysImageIndex: Integer;
    ListItem: TListItem;

    constructor Create(aFileName, aFileType: String;
                       aFileSize: Extended; aFileTime: TDateTime;
                       aAttributes: TdcScanAttributes;
                       aSysImageIndex: Integer);

    function ApplyToListView(ListView: TdcFolderListView): TListItem;
  end;

constructor TdcShellObject.Create(aFileName, aFileType: String;
                       aFileSize: Extended; aFileTime: TDateTime;
                       aAttributes: TdcScanAttributes;
                       aSysImageIndex: Integer);
begin
  inherited Create;
  FileName := aFileName;
  FileType := aFileType;
  FileSize := aFileSize;
  FileTime := aFileTime;
  Attributes := aAttributes;
  SysImageIndex := aSysImageIndex;
end;

function TdcShellObject.ApplyToListView(ListView: TdcFolderListView): TListItem;
var
  St, Ext: String;
begin
  Result := ListView.Items.Add;
  with ListView, Result do
   begin
    Data := Self;

    { Name (always visible) }
    St := ExtractFileName(FileName);
    Ext := LowerCase(ExtractFileExt(St));
    if not FShowFileExtensions and not (saDirectory in Attributes) then
     if Ext = '.lnk' then
       SetLength(St, Length(St) - Length(Ext))
     else
      begin
       FFileAssociation.EXTENSION := Ext;
       if FFileAssociation.ExecutableFile <> '' then
         SetLength(St, Length(St) - Length(Ext));
      end;
    Caption := St;

    { Icon image/overlay }
    ImageIndex := SysImageIndex;
    if not (saDirectory in Attributes) and ((Ext = '.lnk') or (Ext = '.url')) then
      OverlayIndex := 1;
    { TODO: Overlay image for shared folders }
    if saHidden in Attributes then
      Cut := True;

    { Size }
    if FReportColumns.FSize.FVisible then
     begin
      if not (saDirectory in Attributes) then
        if FileSize <> 0 then
          St := FloatToStrF(Int(FileSize / 1024 + 1), ffNumber, 18, 0) + FKBStr
        else
          St := '0' + FKBStr
      else
        St := '';
      SubItems.Add(St);
     end;

    { Type }
    if FReportColumns.FType.FVisible then
      SubItems.Add(FileType);

    { Modified }
    if FReportColumns.FModified.FVisible then
      SubItems.Add(FormatDateTime(ShortDateFormat + ' ' + ShortTimeFormat, FileTime));

    { Attributes }
    if FReportColumns.FAttributes.FVisible then
     begin
      St := '';
      if (saReadOnly in Attributes) then St := St + 'R';
      if (saHidden in Attributes) then St := St + 'H';
      if (saSystem in Attributes) then St := St + 'S';
      if (saArchive in Attributes) then St := St + 'A';
      SubItems.Add(St);
     end;
   end;  
end;
{ ******************************************************* }


{ TdcListColumn }
constructor TdcListColumn.Create(aFolderListView: TdcFolderListView; aIsNameColumn: Boolean);
begin
  inherited Create;
  FolderListView := aFolderListView;
  IsNameColumn := aIsNameColumn; 
  FVisible := True;
end;

procedure TdcListColumn.CreateColumn(Columns: TListColumns; Order: Byte);
begin
  if FVisible then
   begin
    { this will used for sorting by correct order }
    with FolderListView do
     begin
      ColumnOrders[CurrentOrder] := Order;
      Inc(CurrentOrder);
     end; 

    Column := Columns.Add;
    with Column do
     begin
      Alignment := FAlignment;
      Caption := FCaption;
      Width := FWidth;
     end;
   end
  else
   Column := nil;   
end;

function  TdcListColumn.GetAlignment: TAlignment;
begin
  if Column <> nil then
    Result := Column.Alignment
  else
    Result := FAlignment;
end;

procedure TdcListColumn.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
   if Column <> nil then
    begin
     Column.Alignment := Value;
     FAlignment := Column.Alignment;
    end
   else
     FAlignment := Value;
end;

function  TdcListColumn.GetCaption: String;
begin
  if Column <> nil then
    Result := Column.Caption
  else
    Result := FCaption;
end;

procedure TdcListColumn.SetCaption(const Value: String);
begin
  if FCaption <> Value then
   if Column <> nil then
    begin
     Column.Caption := Value;
     FCaption := Column.Caption;
    end
   else
     FCaption := Value;
end;

function  TdcListColumn.GetWidth: TWidth;
begin
  if Column <> nil then
    Result := Column.Width
  else
    Result := FWidth;
end;

procedure TdcListColumn.SetWidth(Value: TWidth);
begin
  if FWidth <> Value then
   if Column <> nil then
    begin
     Column.Width := Value;
     FWidth := Column.Width;
    end
   else
     FWidth := Value;
end;

procedure TdcListColumn.SetVisible(Value: Boolean);
begin
  if (FVisible <> Value) and not IsNameColumn then
   begin
    FVisible := Value;
    FolderListView.InitColumns;
   end;
end;


{ TdcListColumns }
constructor TdcListColumns.Create(aFolderListView: TdcFolderListView);
begin
  inherited Create;
  FName := TdcListColumn.Create(aFolderListView, True);
  with FName do
   begin
    FCaption := 'Name';
    FWidth := 180;