smartlistview.pas

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

unit SmartListView;
{* |<PRE>
================================================================================
* 单元名称：TSmartListView v1.01
* 单元作者：[e-mail]
* 备    注：
* 开发平台：PWin2003Standard + Delphi 7.1
* 修改记录：2006.9.12.
*             
================================================================================
|</PRE>}

interface

uses
  Windows, Messages, SysUtils, Classes, ComCtrls, CommCtrl, Graphics;

type
  TSmartListView = class(TListView)
  private
    FArrowUp: HBITMAP;
    FArrowDown: HBITMAP;
    FCurColumn: Integer;
    FHeaderHandle: HWND;
    FMsg1: string;
    FMsg2: string;
    FCop: string;
    FBackgroundPicture: TPicture;
    FSearchStr: string;
    FSearchTickCount: Double;
    FColumnSearch: boolean;
    function GetCop: string;
    procedure SetCop(const Value: string);
    procedure SetHeaderBitmap(Value: Integer);
    procedure SetBackgroundPicture(Value: TPicture);
    procedure BackgroundPictureChanged(Sender: TObject);
    procedure LVCustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
    procedure DrawBackgroundPicture;
  protected
    procedure WndProc(var Msg: TMessage); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateWnd; override;
    destructor Destroy; override;
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
    function SaveToHTMLFile(const FileName: string; Center: Boolean): Boolean;
    function SaveToExcelFile(const FileName: string): Boolean;
    function GetCheckedItem: TListItem;
    function MultiChecked: Boolean;
    function IsChecked: Boolean;
    procedure CheckAll(Checked: Boolean);
    procedure MoveItem(OriginalIndex, NewIndex: Integer);
    function StringSelect(const FindStr: string; ColumnIndex: Integer): boolean;
    function SubStringSelect(const FindStr: string; ColumnIndex: Integer): boolean;
  published
    property Msg1: string read FMsg1 write FMsg1;
    property Msg2: string read FMsg2 write FMsg2;
    property BackgroundPicture: TPicture read FBackgroundPicture write SetBackgroundPicture;
    property ColumnSearch: boolean read FColumnSearch write FColumnSearch default False;
    property Copyright: string read GetCop write SetCop;
  end;

procedure Register;

implementation

{$R SmartListView.res}

procedure Register;
begin
  RegisterComponents('FHTGPS', [TSmartListView]);
end;

//general Sort function

function CustomSortProc(Item1, Item2: TListItem; lParam: LongInt): Integer; stdcall;
begin
  Result := 0;
  if (Item1 = nil) or (Item2 = nil) then
    Exit;
  if lParam = 0 then
    Result := CompareText(Item1.Caption, Item2.Caption)
  else if lparam > 0 then
  begin
    if (LParam > Item1.SubItems.Count) or (LParam > Item2.SubItems.Count) then
      Exit;
    Result := CompareText(Item1.SubItems[Lparam - 1], Item2.SubItems[Lparam - 1]);
  end;
  Result := Result * Item1.ListView.Column[lParam].Tag;
end;

constructor TSmartListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackgroundPicture := TPicture.Create;
  FBackgroundPicture.OnChange := BackgroundPictureChanged;
  OnCustomDraw := LVCustomDraw;
  FArrowUp := LoadImage(hInstance, 'ArrowUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  FArrowDown := LoadImage(hInstance, 'ArrowDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  Msg1 := 'File "%s" does not exist!';
  Msg2 := '"%s" is not a ListView file!';
  FCop := 'Copyright(C) 2006 by [e-mail] ';
  FHeaderHandle := 0;
  FSearchStr := '';
  FSearchTickCount := 0;
  FCurColumn := 0;
end;

procedure TSmartListView.CreateWnd;
begin
  inherited CreateWnd;
  if HandleAllocated then
    HandleNeeded;
  FHeaderHandle := ListView_GetHeader(Handle);
end;

destructor TSmartListView.Destroy;
begin
  DeleteObject(FArrowUp);
  DeleteObject(FArrowDown);
  FBackgroundPicture.Free;
  inherited Destroy;
end;

procedure TSmartListView.SetHeaderBitmap(Value: Integer);
var
  HdItem: THdItem;
begin
  FillChar(HdItem, SizeOf(HdItem), #0);

  HdItem.Mask := HDI_FORMAT;
  Header_GetItem(FHeaderHandle, Value, HdItem);
  HdItem.Mask := HDI_BITMAP or HDI_FORMAT;

  if Column[Value].Tag = -1 then
  begin                                 //reverse arrow 反向
    HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
    HdItem.hbm := FArrowDown;
  end
  else if Column[Value].Tag = 1 then
  begin                                 //obverse arrow 正向
    HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
    HdItem.hbm := FArrowUp;
  end
  else if Column[Value].Tag = 0 then
  begin                                 // clear arrow 消除箭头
    HdItem.fmt := HdItem.fmt and not (HDF_BITMAP or HDF_BITMAP_ON_RIGHT);
    HdItem.hbm := 0;
  end;
  Header_SetItem(FHeaderHandle, Value, HdItem);
end;

procedure TSmartListView.WndProc(var Msg: TMessage);
var
  pHD: PHDNotify;
  I: Integer;
begin
  inherited WndProc(Msg);
  //如果截获的消息是WM_NOTIFY
  if Msg.Msg = WM_NOTIFY then
  begin
    pHD := PHDNotify(Msg.LParam);
    if (pHD.Hdr.hwndFrom = FHeaderHandle) and (FHeaderHandle <> 0) then
    begin
      case pHD.HDr.code of
        // 如果是点击Header
        HDN_ITEMCLICK, HDN_ITEMCLICKW:
          begin
            FCurColumn := Columns.Items[pHD.item].Index;
            // 做标记，正向或反向排序
            for I := 0 to Columns.Count - 1 do
            begin
              if I = FCurColumn then
              begin
                if Column[I].Tag = 0 then
                  Column[I].Tag := 1
                else
                  Column[I].Tag := -1 * Column[I].Tag;
                SetHeaderBitmap(I);
              end
              else
              begin
                if Column[I].Tag <> 0 then
                begin
                  Column[I].Tag := 0;
                  SetHeaderBitmap(I);
                end;
              end;
            end;                        {of for}
            //排序
            CustomSort(@CustomSortProc, FCurColumn);
          end;
        // 拖动改变宽度时，ColumnItem <> 原来排序的列
        HDN_ENDTRACK, HDN_ENDTRACKW:
          begin
            FCurColumn := Columns.Items[pHD.item].Index;
            if Columns[FCurColumn].Tag <> 0 then
              SetHeaderBitmap(FCurColumn);
          end;
      end;
    end;
  end;                                  // end if
end;

procedure TSmartListView.SaveToFile(const FileName: string);
var
  idxItem, idxSub, IdxImage: Integer;
  Stream: TFileStream;
  pText: pChar;
  sText: string;
  W, ItemCount, SubCount: word;
  MySignature: array[0..2] of char;
begin
  //Initialization
  ItemCount := 0;
  SubCount := 0;
  //****
  MySignature := 'LVF';                 //  ListViewFile
  Stream := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
  try
    Stream.Write(MySignature, sizeof(MySignature));
    if Items.Count = 0 then
      ItemCount := 0
    else
      ItemCount := Items.Count;
    Stream.Write(ItemCount, Sizeof(ItemCount));

    if Items.Count > 0 then
    begin
      for idxItem := 1 to ItemCount do
      begin
        with items[idxItem - 1] do
        begin
          //Save subitems count
          if SubItems.Count = 0 then
            SubCount := 0
          else
            SubCount := Subitems.Count;
          Stream.Write(SubCount, Sizeof(SubCount));
          //Save ImageIndex
          IdxImage := ImageIndex;
          Stream.Write(IdxImage, Sizeof(IdxImage));
          //Save Caption
          sText := Caption;
          w := length(sText);
          pText := StrAlloc(Length(sText) + 1);
          StrPLCopy(pText, sText, Length(sText));
          Stream.Write(w, sizeof(w));
          Stream.Write(pText^, w);
          StrDispose(pText);
          if SubCount > 0 then
          begin
            for idxSub := 0 to SubItems.Count - 1 do
            begin                       //Save Item's subitems
              sText := SubItems[idxSub];
              w := length(sText);
              pText := StrAlloc(Length(sText) + 1);
              StrPLCopy(pText, sText, Length(sText));
              Stream.Write(w, sizeof(w));
              Stream.Write(pText^, w);
              StrDispose(pText);
            end;
          end;
        end;
      end;
    end;
  finally
    FreeAndNil(Stream);
  end;
end;

procedure TSmartListView.LoadFromFile(const FileName: string);
var
  Stream: TStream;
  IdxItem, IdxSubItem, IdxImage: Integer;
  W, ItemCount, SubCount: Word;
  pText: pchar;
  PTemp: pChar;
  MySignature: array[0..2] of Char;
  sExeName: string;
begin
  ItemCount := 0;
  SubCount := 0;
  sExeName := ExtractFileName(FileName);
  if not FileExists(FileName) then
  begin
    MessageBox(Handle, pChar(format(Msg1, [sExeName])), 'I/O Error', MB_ICONERROR);
    Exit;
  end;
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    Stream.Read(MySignature, sizeof(MySignature));
    if MySignature <> 'LVF' then
    begin
      MessageBox(Handle, pChar(format(Msg2, [sExeName])), 'I/O Error', MB_ICONERROR);
      Exit;
    end;
    Stream.Read(ItemCount, sizeof(ItemCount));
    Items.Clear;
    Items.BeginUpdate;
    for idxItem := 1 to ItemCount do
    begin
      with Items.Add do
      begin
        //Read imageindex
        Stream.Read(SubCount, sizeof(SubCount));
        //Read imageindex
        Stream.Read(IdxImage, sizeof(IdxImage));
        ImageIndex := IdxImage;
        //Read the Caption
        Stream.Read(w, SizeOf(w));
        pText := StrAlloc(w + 1);
        pTemp := StrAlloc(w + 1);
        Stream.Read(pTemp^, W);
        StrLCopy(pText, pTemp, W);
        Caption := StrPas(pText);
        StrDispose(pTemp);
        StrDispose(pText);
        if SubCount > 0 then
        begin
          for idxSubItem := 1 to SubCount do
          begin
            Stream.Read(w, SizeOf(w));
            pText := StrAlloc(w + 1);
            pTemp := StrAlloc(w + 1);
            Stream.Read(pTemp^, W);
            StrLCopy(pText, pTemp, W);
            Items[idxItem - 1].SubItems.Add(StrPas(pText));
            StrDispose(pTemp);
            StrDispose(pText);
          end;
        end;
      end;
    end;
  finally