Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue32/listview/LISTVIEW.ZIP/VMFileListView.pas

Pascal/Delphi Source File | 1998-01-12 | 7.0 KB | 282 lines

unit VMFileListView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommCtrl, ComCtrls, EnhListView, ExtListView, SHellAPI, fileHolder;

type
  TVMFileListView = class(TExtListView)
  private
    { Private declarations }
    FFolder: string;
    FOnFolderChange: TNotifyEvent;
    FCurrentSortType: TFileSortType;
    FCurrentSortAscend: Boolean;
    FFoldersToo: Boolean;
    FSmallIcons, FLargeIcons: TImageList;
    fh: TFileHolder;
    procedure setFolder(value: string);
    procedure setFoldersToo(value: Boolean);
    procedure ColumnClick(Sender: TObject; Column: TListColumn);
    procedure VMGetItemInfo(Sender: TObject; Item,
      SubItem: Integer; Mask: TLVVMMaskItems; var Image, Param, State,
      Indent: Integer; var Text: String);
    function  GetParentFolder( fldr: string ): string;
    procedure DoubleClick(Sender: TObject);
  protected
    { Protected declarations }
    procedure CreateWnd; override;
    procedure Loaded; override;
  public
    { Public declarations }
    function    ItemIndex: integer;
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function    ClimbDown: Boolean;
    property    Folder: string read FFolder write setFolder;
    property    FoldersToo: Boolean read FFoldersToo write setFoldersToo;
  published
    { Published declarations }
    property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TVMFileListView]);
end;

//---------------------------------------------------------------------

constructor TVMFileListView.Create(AOwner: TComponent);
var
  fi: TSHFileInfo;
begin

  inherited Create(AOwner);

  FSmallIcons := TImageList.Create( Self );
  with FSmallIcons do begin
    Handle := ShGetFileInfo('',0,fi, SizeOf(TShFileInfo),
                            SHGFI_SYSICONINDEX or SHGFI_SMALLICON );
    ShareImages:= True;
  end;
  SmallImages := FSmallIcons;

  FLargeIcons := TImageList.Create( Self );
  with FLargeIcons do begin
    Handle := ShGetFileInfo('',0,fi, SizeOf(TShFileInfo),
                            SHGFI_SYSICONINDEX or SHGFI_LARGEICON );
    ShareImages:= True;
  end;
  LargeImages := FLargeIcons;
  ViewStyle := vsReport;
  FFolder := '';
  fh := TFileHolder.Create;
  fh.FoldersToo := True;
  FCurrentSortType := sbName;
  FCurrentSortAscend := True;

end;

//---------------------------------------------------------------------

destructor TVMFileListView.Destroy;
begin

  FSmallIcons.Free;
  FLargeIcons.Free;
  fh.Free;
  inherited Destroy;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.Loaded;
begin
  VirtualMode := True;
  OnColumnClick := ColumnClick;
  OnVMGetItemInfo := VMGetItemInfo;
  OnDblClick := DoubleClick;
end;

//---------------------------------------------------------------------

procedure TVMFileListView.CreateWnd;
begin

  inherited CreateWnd;

  Columns.Clear;
  with Columns.Add do begin
    Caption := 'Name';
    Width := Trunc(0.30*Self.Width);
  end;
  with Columns.Add do begin
    Caption := 'Size';
    Alignment := taRightJustify;
    Width := Trunc(0.15*Self.Width);
  end;
  with Columns.Add do begin
    Caption := 'Modified';
    Width := Trunc(0.25*Self.Width)
  end;
  with Columns.Add do begin
    Caption := 'Type';
    Width := Trunc(0.25*Self.Width);
  end;
  with Columns.Add do begin
    Caption := 'Attr';
    Width := 0; //Trunc(0.25*Self.Width);
  end;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.setFolder(value: string);
begin

  if fh.Folder <> value then begin
    fh.Folder := value;
    FFolder := LowerCase(fh.Folder);
    FFolder[1] := chr(ord(FFolder[1]) and $DF);
    if Assigned(FOnFolderChange) then
      FOnFolderChange(Self);
    fh.readFiles;
    fh.sortFiles( FCurrentSortType, FCurrentSortAscend );
    SetItemCountEx( fh.Count, [lvsicfNoScroll] );
  end;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.setFoldersToo(value: Boolean);
begin

  if fh.FoldersToo <> value then begin
    fh.FoldersToo := value;
    FFoldersToo := value;
  end;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.ColumnClick(Sender: TObject; Column: TListColumn);
const
  LastColumnClicked: integer = 0;
begin

  if Column.Index = LastColumnClicked then
    FCurrentSortAscend := not FCurrentSortAscend
  else
    FCurrentSortAscend := True;

  with fh do begin
    Case Column.index of
      0: sortFiles(sbName,FCurrentSortAscend);
      1: sortFiles(sbSize,FCurrentSortAscend);
      2: sortFiles(sbDate,FCurrentSortAscend);
      3: sortFiles(sbType,FCurrentSortAscend);
      4: sortFiles(sbAttr,FCurrentSortAscend);
    end;
    SetItemCountEx(Count, [lvsicfNoScroll]);
  end;

  LastColumnClicked := Column.Index;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.VMGetItemInfo(Sender: TObject; Item,
  SubItem: Integer; Mask: TLVVMMaskItems; var Image, Param, State,
  Indent: Integer; var Text: String);
begin

  with fh do begin
    if item < Count then begin
      if lvifImage in Mask then begin
        image := Files[item].Icon;
      end;

      if lvifText in Mask then begin
        case SubItem of
          0: Text := Files[item].Name;
          1: Text := Files[item].Size;
          2: Text := DateTimeToStr(Files[item].Date);
          3: Text := Files[item].Hint;
          4: Text := Files[item].Attr;
        else
          Text := '';
        end;
      end;
    end;
  end;

end;

//---------------------------------------------------------------------

procedure TVMFileListView.DoubleClick(Sender: TObject);
begin

  with fh do
    if (ItemIndex > -1) and (ItemIndex < Count) then
      if fh.Files[ItemIndex].Fldr then begin
        setFolder( FFolder + fh.Files[ItemIndex].Name );
      end;

  inherited;

end;

//---------------------------------------------------------------------

function TVMFileListView.ItemIndex: integer;
begin

  Result := ListView_GetNextItem(Handle, -1, LVNI_FOCUSED);

end;

//---------------------------------------------------------------------

function TVMFileListView.GetParentFolder( fldr: string ): string;
var
  i: integer;
begin

  Result := fldr;
  i := Length( fldr )-1;
  while i > 0 do begin
    if fldr[i] = '\' then begin
      Result := Copy( fldr, 1, i );
      break;
    end;
    Dec(i);
  end;

end;

//---------------------------------------------------------------------

function TVMFileListView.ClimbDown: Boolean;
begin

  Result := not (GetParentFolder( FFolder ) = FFolder );
  if Result then
    setFolder( GetParentFolder( FFolder ) );

end;

end.