fileslistview.pas

一套非常好用的delphi控件,方便程序员工作

{******************************************************************}
{*                   FilesListView.PAS - TFileListview            *}
{*                      根据文件名称显示文件列表                  *}
{*                           版本 1.00                            *}
{*                         版权属于alicsoft                       *}
{*                     http://www.alicsoft.com                    *}
{*                         [e-mail]                      *}
{*                              方法                              *}
{*function Add(id: Integer; sname, aname: String; size: integer):TListItem;*}
{*                 procedure Move(const Item: TListItem);         *}
{******************************************************************}
unit FilesListView;

interface

uses
  Windows, Classes, ComCtrls, Controls, ShellApi, Graphics;

type

  TFileListview = class(TCustomListView)
  protected
    SmallImageList: TImageList;
    LargeImageList: TImageList;
    extStringList: TStringList;

    procedure DrawIcon(Item: TListItem);
  published
    property Action;
    property Align;
    property AllocBy;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind default bkNone;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property BorderWidth;
    property Checkboxes;
    property Color;
    property Columns;
    property ColumnClick;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property FlatScrollBars;
    property FullDrag;
    property GridLines;
    property HideSelection;
    property HotTrack;
    property HotTrackStyles;
    property HoverTime;
    property IconOptions;
    property Items;
    property LargeImages;
    property MultiSelect;
    property OwnerData;
    property OwnerDraw;
    property ReadOnly default False;
    property RowSelect;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowColumnHeaders;
    property ShowWorkAreas;
    property ShowHint;
    property SmallImages;
    property SortType;
    property StateImages;
    property TabOrder;
    property TabStop default True;
    property ViewStyle;
    property Visible;
    property OnAdvancedCustomDraw;
    property OnAdvancedCustomDrawItem;
    property OnAdvancedCustomDrawSubItem;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnColumnClick;
    property OnColumnDragged;
    property OnColumnRightClick;
    property OnCompare;
    property OnContextPopup;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnCustomDrawSubItem;
    property OnData;
    property OnDataFind;
    property OnDataHint;
    property OnDataStateChange;
    property OnDblClick;
    property OnDeletion;
    property OnDrawItem;
    property OnEdited;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSubItemImage;
    property OnDragDrop;
    property OnDragOver;
    property OnInfoTip;
    property OnInsert;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnSelectItem;
    property OnStartDock;
    property OnStartDrag;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add(id: Integer;    //指针
                 sname,          //显示文件名
                 aname: String;  //实际文件名
                 size: integer   //文件大小
                 ):TListItem;

    procedure Move(const Item: TListItem);
    {从其他filelistview移入Item}
  end;

const
  mlvsizefield  :Integer = 0;
  mlvactualname :Integer = 1;
  mlvsimplename :Integer = 2;
  mlvrawname    :Integer = 3;

procedure Register;

implementation

uses SysUtils, winicon_lib;

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

function FileSizeString(n: Integer):String;
begin
  if n < 1024 then
    Result := Format('%d', [n])
  else
  if n < 102400 then
    Result := Format('%d.%dKb', [n div 1024, ((n mod 1024) div 100)])
  else
    Result := Format('%dKb', [n div 1024]);
end;

function GetAssociatedIcon(const AExtension: string; ASmall: Boolean): HIcon;
var
  Info : TSHFileInfo;
  Flags : Cardinal;
begin
  if ASmall then
    Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES
  else
    Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES;
  SHGetFileInfo(PChar(AExtension), FILE_ATTRIBUTE_NORMAL, Info, SizeOf(TSHFileInfo), Flags);
  Result := Info.hIcon;
end;

constructor TFileListview.Create(AOwner: TComponent);
begin
  inherited;
  SmallImageList := TImageList.Create(Self);
  SmallImageList.Height := 16;
  SmallImageList.Width := 16;
  LargeImageList := TImageList.Create(Self);
  LargeImageList.Height := 32;
  LargeImageList.Width := 32;
  extStringList := TStringList.Create;
  SmallImages := SmallImageList;
  LargeImages := LargeImageList;
end;

destructor TFileListview.Destroy;
begin
  extStringList.Free;
  LargeImageList.Free;
  SmallImageList.Free;
  inherited;
end;

procedure TFileListview.DrawIcon(Item: TListItem);
var
  s: string;
  n: integer;
  icon: TIcon;
  b: boolean;
begin
  inherited;
  b := False;
  icon := TIcon.Create;
  if (Item.SubItems.Count > 1) and (FileExists(Item.SubItems[mlvactualname])) then
  begin
    with TWinIcon.Create(nil) do
    begin
      FileName := Item.SubItems[mlvactualname];
      if IconHandle <> 0 then
      begin
        icon.Handle := IconHandle;
        LargeImageList.AddIcon(icon);
        n := SmallImageList.AddIcon(icon);
        Item.ImageIndex := n;
        b := true;
      end;
      Free;
    end;
  end;
  if not b then
  begin
    s := ExtractFileExt(Item.SubItems[mlvsimplename]);
    if not extStringList.Find(s, n) then
    begin
      icon.Handle := GetAssociatedIcon(s, false);
      LargeImageList.AddIcon(icon);
      icon.Handle := GetAssociatedIcon(s, true);
      n := SmallImageList.AddIcon(icon);
      extStringList.Add(s);
    end;
    Item.ImageIndex := n;
  end;
  icon.Free;
end;

function TFileListview.Add(id: Integer; sname, aname: String; size: integer):TListItem;
begin
  Result := Items.Add;
  Result.Indent := id;
  Result.Caption := Format('%s(%s)', [sname, FileSizeString(size)]);
  Result.SubItems.Add(IntToStr(size));
  Result.SubItems.Add(aname);
  Result.SubItems.Add(sname);
  DrawIcon(Result);
end;

procedure TFileListview.Move(const Item: TListItem);
begin
  Add(Item.Indent, Item.SubItems[mlvsimplename], Item.SubItems[mlvactualname], StrToInt(Item.SubItems[mlvsizefield]));
  Item.Delete;
end;

end.