一个功能增强的Delphi TListView组件

在Windoes编程中列表视图(ListView)是一个通用控件，当将其样式设为Report时，系统将自动为它加上一个表头控件（以下简称表头），但通常我们不能直接对这个表头控件进行操作。同样Delphi的TListView组件也没有为我们提供可以直接对该表头进行控制的方法，这篇文章介绍一种通过自定义组件的方法，对Delphi的TListView组件进行功能增强，做一个通用的列表视图但是它增加了以下功能：

1)     增加一个可以从外部调用的排序方法，当视图的显示样式为Report时，点击各列的表头按钮可按其列值进行排序；

2)     点击各列的表头按钮进行排序的同时在视图的表头上按排序方向绘制一个箭头，其效果类似Outlook Express；

3)     增加视图表头的字体属性；

4)     增加一个背景图属性。

通过代码编写增强了Delphi通用列表视图的功能，但它仍是一个通用的列表视图控件，效果如下图。

 

自定义组件的基本步骤请参见有关文章，但是在此我们选择的基类是TListView，下面我们直接从Delphi自动生成的组件单元文件的数据类型定义部份开始（本文代码在Delphi 4.0下完成)。

一、将Delphi自动生成的单元文件的数据类型定义部份修改为：

 

type

TListView1 = 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;

 

说明：

a). 在published段我们定义了两个属性。背景图属性BackPicture，其数据类型是TPicture；表头字体属性HeaderFont，其数据类型是Tfont；

b). 为了读/写BackPicture属性的值，在private段分别定义了它的私有数据FPicture和属性的写方法SetPicture；同理，在private段为HeaderFontn属性分别定义了它的私有数据FHeaderFont和属性的写方法SetHeaderFont；

c). 在public段重载了TListView的构造函数和析构函数；

d). 在 protected段重载了TListView的WndProc过程；

e). 为了能在设计期间动态改变视图的背景图，我们自定义了二个事件响应过程，PictureChanged和LVCustomDraw。PictureChanged是背景图属性BackPicture的私有数据FPicture（TPicture）的OnChange事件响应过程，设计期间当我们通过Delphi的Object Inspector面板改变BackPicture的值时，将产生OnChang事件而执行该过程重绘列表视图（过程就是这样写的），这又将产生视图的OnCustomDraw事件而执行我们自定义的LVCustomDraw事件响应过程，也即LVCustomDraw是列表视图的OnCustomDraw事件响应过程；

f). 在protected段重载的WndProc过程用于捕获Windows消息，它是我们完成这个自定义列表视图的核心所在，所需捕获的消息和作用在下面的代码中以注释的形式给出。

g). 我们必须手工在单元文件的uses子句后加上CommCtrl。

 

二、编写控件的过程体

    Delphi自动生成的 procedure Register可以不理它。我们在它的过程体之后，在end.(注意符号“.”)之前手工加上以下代码，完成我们在上面定义的全部过程的过程体编写（这里我们没有定义有函数原型）：

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

constructor TListView1.Create(AOwner: TComponent);

begin

 inherited Create(AOwner);//继承

 FHeaderFont:=TFont.Create;

 FPicture:=TPicture.Create;

 FPicture.OnChange:=PictureChanged;

 OnCustomDraw:=LVCustomDraw;

end;

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

destructor TListView1.Destroy;

begin

 FPicture.Free;

 FHeaderFont.Free;

 inherited Destroy;//继承

end;

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

procedure TListView1.SetHeaderFont(Value:TFont);

begin

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

 if FHeaderFont <> Value then begin

    FHeaderFont.Assign(Value);

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

 end;

end;

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

procedure TListView1.SetPicture(Value: TPicture);

begin

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

 if FPicture <> Value then

    FPicture.Assign(Value);

end;

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

procedure TListView1.PictureChanged(Sender: TObject);

begin

 //重绘列表视图

 Invalidate;

end;

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

procedure TListView1.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 TListView1.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 TListView1.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 TListView1.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 TListView1.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 TListView1.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.

三、安装自定义组件

    再次提醒：一定要在uses子句后手工加上CommCtrl！

    检查确认无误后选择Delphi菜单的Component/Install Component选项，在Unite file name编辑框中确认你的文件路径和名称后按OK按钮，Delphi将编译安装该组件。

    如果你完全按本文步聚进行，对Delphi生成的默认值不进行修改的话，在编译安装无误后，你可以在Delphi组件标签页的Samples标签页中找到一个图标和TListView一样的列表视图。新建一个工程并将这个我们自义的列表视图放置在Form上，其默认的名称是ListView11，此时你看到这个列表视图的外观和Delphi提供的TListView放置在Form上时的外观一样，但是我们却可以在Delphi的Object Inspector面板上找到BackPicture属性和HeaderFont属性，二者的设置方法和Delphi通常的图形属性和字体属性的设置方法一样。当我们将它的ViewStyle属性设为vsReport、并设了列和列的Caption文本时，可以通过HeaderFont这个我们新增的属性单独改变表头的字体。当然你也可以进一步修改，给表头再增加一个背景色属性等等。

四、对PDrawItemStruct数据结构和PHDNotify数据结构的说明

    （仅为说明数据定义而列出，和Delphi的原定义略有出入）

    PDrawItemStruct在Delphi的Windows.pas文件中定义如下：

            PDrawItemStruct = ^TDrawItemStruct;

            tagDRAWITEMSTRUCT = packed record

               CtlType: UINT;

               CtlID: UINT;

               itemID: UINT;

               itemAction: UINT;

               itemState: UINT;

               hwndItem: HWND;

               hDC: HDC;

               rcItem: TRect;

               itemData: DWORD;

            end;

            TDrawItemStruct = tagDRAWITEMSTRUCT;

            DRAWITEMSTRUCT = tagDRAWITEMSTRUCT;

        而关于DRAWITEMSTRUCT的解释可参见Delphi帮助文件（或微软）的Win32 Programmer's Reference。

        PHDNotify在Delphi的CommCtrl.pas文件中定义如下：

        tagNMHEADERA = packed record

             Hdr: TNMHdr;

             Item: Integer;

             Button: Integer;

             PItem: PHDItemA;

        end;

        PHDNotifyA = ^THDNotifyA;

        PHDNotify = PHDNotifyA;

        THDNotifyA = tagNMHEADERA;

   可对应查看Delphi帮助文件（或微软）的Win32 Programmer's Reference中关于HD_NOTIFY结构的解释。

   另外文中所涉Windows API同样可在Win32 Programmer's Reference中直接按相应函数名查阅。

应csdn上的网友duducat(嘟嘟猫)要求，特别在此提供完整的示例源代码(在Delphi5中通过)，它和本文所述不同的是其箭头图形来自资源文件，效果如下图。




有何问题请来信或留言。
欢迎试用本站软件： NetGoCN(网行)