main.pas

一个功能增强的Delphi TListView组件TSmartListView + 增加排序功能,带小箭头的那种：） + 增加SaveToExcelFile、SaveToHTMLFile方法

{*******************************************************}
{                                                       }
{       SmartListView Demo                              }
{                                                       }
{       Copyright (C) 2006 Blue Digital                 }
{                                                       }
{      Created by Hsu Chong  2006-12-11                 }
{*******************************************************}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls,
  ComCtrls, SmartListView, jpeg, ExtDlgs, DB, DBClient, MConnect, SConnect;

type
  TMainFrm = class(TForm)
    lvDemo: TSmartListView;
    btnSave: TButton;
    btnClose: TButton;
    SaveDialog: TSaveDialog;
    btnGetDirFiles: TButton;
    btnLoadFromFile: TButton;
    btnSaveToFile: TButton;
    btnClear: TButton;
    btnBackground: TButton;
    dlgOpenPic: TOpenPictureDialog;
    btnAbout: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnGetDirFilesClick(Sender: TObject);
    procedure btnLoadFromFileClick(Sender: TObject);
    procedure btnSaveToFileClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnBackgroundClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
  private
    { Private declarations }

  public
    procedure setBtnState(b: Boolean);
  end;

var
  MainFrm: TMainFrm;

implementation

{$R *.dfm}

procedure GetDirFiles(InPath: string; OutList: TListView);
var
  lt: TFileTime;
  st: SystemTime;
  sr: TSearchRec;
  lvItem: TListItem;
  sFile, sPath, cTime, wTime: string;
  iSize: Integer;
begin
  if (not DirectoryExists(InPath)) then
    Exit;
  OutList.Clear;
  if (InPath[Length(InPath)] <> '\') then
    InPath := InPath + '\';
  InPath := InPath + '*.*';
  if FindFirst(InPath, faAnyFile, sr) = 0 then
  begin
    if (sr.Name <> '.') and (sr.Name <> '..') then
    begin
      lvItem := OutList.Items.Add;
      lvItem.Caption := ExtractFilePath(InPath) + sr.Name;
      if (sr.Attr and faDirectory) = 0 then
      begin
        iSize := sr.Size div 1024;
        lvItem.SubItems.Append(IntToStr(iSize) + ' KB');
      end
      else
        lvItem.SubItems.Append('');
      FileTimeToLocalFileTime(sr.FindData.ftCreationTime, lt);
      FileTimeToSystemTime(lt, st);
      cTime := Format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
      FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime, lt);
      FileTimeToSystemTime(lt, st);
      wTime := Format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
      lvItem.SubItems.Append(cTime);
      lvItem.SubItems.Append(wTime);
    end;
    while FindNext(sr) = 0 do
    begin
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        lvItem := OutList.Items.Add;
        lvItem.Caption := ExtractFilePath(InPath) + sr.Name;
        if (sr.Attr and faDirectory) = 0 then
        begin
          iSize := sr.Size div 1024;
          lvItem.SubItems.Append(IntToStr(iSize) + ' KB');
        end
        else
          lvItem.SubItems.Append('');
        FileTimeToLocalFileTime(sr.FindData.ftCreationTime, lt);
        FileTimeToSystemTime(lt, st);
        cTime := Format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
        FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime, lt);
        FileTimeToSystemTime(lt, st);
        wTime := Format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
        lvItem.SubItems.Append(cTime);
        lvItem.SubItems.Append(wTime);
      end;
    end;
  end;
  FindClose(sr);
end;

procedure TMainFrm.btnSaveClick(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    case SaveDialog.FilterIndex of
      1: lvDemo.SaveToExcelFile(SaveDialog.FileName);
      2: lvDemo.SaveToHTMLFile(SaveDialog.FileName, True);
    end;
  end;
end;

procedure TMainFrm.btnGetDirFilesClick(Sender: TObject);
begin
  GetDirFiles('C:\WINDOWS', lvDemo);
  setBtnState(True);
end;

procedure TMainFrm.btnLoadFromFileClick(Sender: TObject);
begin
  lvDemo.LoadFromFile('lvDemo.dat');
  setBtnState(True);
end;

procedure TMainFrm.btnSaveToFileClick(Sender: TObject);
begin
  lvDemo.SaveToFile('lvDemo.dat');
  btnLoadFromFile.Enabled := True;
end;

procedure TMainFrm.btnClearClick(Sender: TObject);
begin
  lvDemo.Clear;
  setBtnState(False);
end;

procedure TMainFrm.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TMainFrm.setBtnState(b: Boolean);
begin
  btnSave.Enabled := b;
  btnClear.Enabled := b;
  btnLoadFromFile.Enabled := not b;
  btnSaveToFile.Enabled := b;
end;

procedure TMainFrm.btnBackgroundClick(Sender: TObject);
begin
  if dlgOpenPic.Execute then
  begin
    lvDemo.BackgroundPicture.LoadFromFile(dlgOpenPic.FileName);
  end;
end;

procedure TMainFrm.btnAboutClick(Sender: TObject);
var
  AboutTitle,
    AboutDesc: string;
begin
  AboutTitle := 'About SmartListView Demo';
  AboutDesc := 'SmartListView Demo' +
    ^M^M+ 'Copyright (C)2006 by HsuChong' +
    ^M + '[e-mail]';
  Application.MessageBox(PChar(AboutDesc), PChar(AboutTitle), MB_OK + MB_ICONINFORMATION);
end;

end.