mylistview.pas

Delphi basic program. Basic programing guide for delphi language. Several samples are giving.

unit myListView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls,CommCtrl,ShellAPI;


type

TMyListView = class(TListView)

private

  FaToz :Boolean;

  FoldCol :Integer;

  FPicture :TPicture;

  FHeaderFont:TFont;

  procedure SetHeaderFont(Value:TFont);

  procedure SetHeaderStyle(phd:PHDNotify);

  procedure DrawHeaderItem(pDS:PDrawItemStruct);

  procedure SetPicture(Value: TPicture);

  procedure PictureChanged(Sender: TObject);

  procedure LVCustomDraw(Sender:TCustomListView;const ARect:TRect;var DefaultDraw:Boolean);

  procedure DrawBack;

protected

  procedure WndProc(var Message : TMessage); override;

public

  constructor Create(AOwner: TComponent); override;

  destructor Destroy; override;

  procedure SortColumn(Column: TListColumn);

published

  property BackPicture: TPicture read FPicture write SetPicture;

  property HeaderFont: TFont read FHeaderFont write SetHeaderFont;

end;

procedure Register;

implementation



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

//============== 构造函数 ===================================

constructor TMyListView.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);//继承

  FHeaderFont:=TFont.Create;

  FPicture:=TPicture.Create;

  FPicture.OnChange:=PictureChanged;

  OnCustomDraw:=LVCustomDraw;

end;

//============== 析构函数 ===================================

destructor TMyListView.Destroy;

begin

  FPicture.Free;

  FHeaderFont.Free;

  inherited Destroy;//继承

end;

//============== 设置表头字体 ===============================

procedure TMyListView.SetHeaderFont(Value:TFont);

begin

  //转换表头字体设置，将值给FHeaderFomt私有数据域，并重绘表头区域

  if FHeaderFont <> Value then begin

    FHeaderFont.Assign(Value);

    InvalidateRect(GetDlgItem(Handle, 0),nil,true);//调用Windows API（二个函数均是）

  end;

end;

//============== 设置背景图 =================================

procedure TMyListView.SetPicture(Value: TPicture);

begin

  //转换背景图设置，将值赋给FPicture私有数据域

  if FPicture <> Value then

    FPicture.Assign(Value);

end;

//============== TPicture的OnChange事件响应过程 ==============

procedure TMyListView.PictureChanged(Sender: TObject);

begin

  //重绘列表视图

  Invalidate;

end;

//============== TListView的OnCustomDraw事件响应过程==========

procedure TMyListView.LVCustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);

begin

  if (FPicture.Graphic<>nil)then begin

    DrawBack;//绘制背景图

    SetBkMode(Canvas.Handle,TRANSPARENT);//调用Windows API，将画布的背景设为透明模式

    ListView_SetTextBKColor(Handle,CLR_NONE);//调用Windows API，将Item的文本背景设为透明

  end;

end;

//============== 绘制背景图 ==================================

procedure TMyListView.DrawBack;

var x,y,dx: Integer;

begin

  x:=0;

  y:=0;

  if Items.Count>0 then begin

    if ViewStyle = vsReport then x:=TopItem.DisplayRect(drBounds).Left

    else x:=Items[0].DisplayRect(drBounds).Left;

    y:=Items[0].DisplayRect(drBounds).Top-2;

  end;

  dx:=x;

  while y<=ClientHeight do begin

    while x<=ClientWidth do begin

      Canvas.Draw(x,y,FPicture.Graphic);

      inc(x,FPicture.Graphic.Width);

    end;

    inc(y,FPicture.Graphic.Height);

    x:=dx;

  end;

end;

//====== Windows 消息应答 ====================================

procedure TMyListView.WndProc(var Message : TMessage);

var

    pDS :PDrawItemStruct;

    phd :PHDNotify;

begin

    inherited WndProc(Message);//继承

    with Message do

        case Msg of

            WM_DRAWITEM :

            begin //重绘列表项时

               pDS := PDrawItemStruct(Message.lParam);

               //在PDrawItemStruct数据结构中有我们需要的数据

               if pDS.CtlType<>ODT_MENU then begin

                   DrawHeaderItem(pDS);

                   Result := 1;

              end;

           end;

           WM_NOTIFY:

           begin

              phd := PHDNotify(Message.lParam);

              //在PHDNotify数据结构中有我们需要的数据

              if (phd.Hdr.hwndFrom = GetDlgItem(Handle, 0)) then

              Case phd.Hdr.code of

                //当单击表头时

                HDN_ITEMCLICK,HDN_ITEMCLICKW:

                begin

                    SortColumn(Columns.Items[phd.item]);

                    InvalidateRect(GetDlgItem(Handle, 0), nil, true);//调用Windows API

                end;

                //当拖动或改变表头时

                HDN_ENDTRACK,HDN_ENDTRACKW,HDN_ITEMCHANGED:

                begin

                    SetHeaderStyle(phd);

                    InvalidateRect(GetDlgItem(Handle, 0), nil, true);//调用Windows API

                end;

              end;

          end;

      end;

end;

//=====================================================================

var AtoZOrder: Boolean;

function CustomSortProc(Item1, Item2: TListItem; ParamSort: Integer): Integer; stdcall;

begin

//自定义TListView的排序函数类型TLVCompare

case ParamSort of

  0://主列排序

      if AtoZOrder then

         Result:=lstrcmp(PChar(TListItem(Item1).Caption), PChar(TListItem(Item2).Caption))

      else

         Result:=-lstrcmp(PChar(TListItem(Item1).Caption), PChar(TListItem(Item2).Caption));

  else //子列排序

      if(AtoZOrder) then

         Result:=lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort]),

                       PChar(TListItem(Item2).SubItems[ParamSort-1]))

      else

         Result:=-lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort-1]),

                       PChar(TListItem(Item2).SubItems[ParamSort-1]));

  end;

end;

//====== 可在外部调用的排序方法 ===================================

procedure TMyListView.SortColumn(Column: TListColumn);

begin

    //调用TListView的CustomSort函数，按列排序

    if FOldCol = Column.Index then

        FaToz:=not FAtoZ

     else

       FOldCol:=Column.Index;

    AtoZOrder:= FaToz;

    CustomSort(@CustomSortProc, Column.Index);

end;

//====== 绘制表头文本和图形 =======================================

procedure TMyListView.DrawHeaderItem(pDS :PDrawItemStruct);

var

   tmpCanvas :TCanvas;

   tmpLeft :Integer;

begin

   tmpCanvas := TCanvas.Create;

   tmpCanvas.Font := FHeaderFont;

   tmpCanvas.Brush.Color := clBtnFace;

   //重绘文字

   tmpCanvas.Handle:=pDS.hDC;

   tmpCanvas.Brush.Style:=bsClear;

   tmpCanvas.TextOut(pDS^.rcItem.Left+6,pDS^.rcItem.Top+2,Columns[pDS^.itemID].Caption);

   //绘制箭头

   if (abs(pDS^.itemID) <> FOldCol) then Exit;

     with tmpCanvas do

        with pDS^.rcItem do

        begin

          tmpLeft:=TextWidth(Columns[pDS^.itemID].Caption)+Left+15;

          if FAtoZ then begin //画箭头向上

          Pen.Color := clBtnHighlight;

          MoveTo(tmpLeft, Bottom - 5);

          LineTo(tmpLeft + 8, Bottom - 5);

          Pen.Color := clBtnHighlight;

          LineTo(tmpLeft + 4, Top + 5);

          Pen.Color := clBtnShadow;

          LineTo(tmpLeft, Bottom - 5);

        end else begin //画箭头向下

          Pen.Color := clBtnShadow;

          MoveTo(tmpLeft, Top + 5);

          LineTo(tmpLeft + 8, Top + 5);

          Pen.Color := clBtnHighlight;

          LineTo(tmpLeft + 4, Bottom - 5);

          Pen.Color := clBtnShadow;

          LineTo(tmpLeft, Top + 5);

        end;

      end;

   tmpCanvas.Free;

end;

//======== 设置表头样式 ===============================================

procedure TMyListView.SetHeaderStyle(phd:PHDNotify);

var

  i :integer;

  hdi :THDItem;

begin  

   for i := 0 to Columns.Count - 1 do

   begin

     hdi.Mask:= HDF_STRING or HDI_FORMAT;

     hdi.fmt := HDF_STRING or HDF_OWNERDRAW;//设置表头样式为自绘式

     Header_SetItem(phd.Hdr.hwndFrom ,i,hdi);//调用Windows API

   end;

//注意：如果不调用此过程，那么我们在前面绘制的图形将不能被清除掉

end;

//=====================================================================

end.