一个功能增强的Delphi TListView组件

转载 2007年09月30日 12:49:00
在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(网行)
 

相关文章推荐

一个功能增强的Delphi TListView组件

在Windoes编程中列表视图(ListView)是一个通用控件,当将其样式设为Report时,系统将自动为它加上一个表头控件(以下简称表头),但通常我们不能直接对这个表头控件进行操作。同样Delph...
  • my98800
  • my98800
  • 2016年05月20日 10:56
  • 610

Delphi列表视图组件(TListView)详解

·BoundingRect 返回一个能把列表视图中所有项包住的矩形 ·CheckBoxed 列表视图中项的旁边将显示复选框 ·Column 此属性可以访问列表视图中的每一栏 ·ColumnCli...

delphi取得文件图标并在TListView中显示

{delphi取得文件图标并在TListView中显示 技术要点:   一、使用SHGetFileInfo函数获取指定扩展名的文件图标。需要引用ShellAPI单元。   二、使用TStringLis...

Delphi 2010 TListView一些使用

Delphi 2010的TListView扩展了一些功能,其中就有项分组功能,在XP和Vista以上系统有效。但是扩展的更多一些功能只对Vista系统有效。下面在XP SP3下实现TListView的...

Delphi 常用控件之TlistView总结

TlistView组件功能: (1) TListView 控件可以用来显示各项带图标的列表,包括大图标和小图标的;也可以用来显示带有子项的列表,Windows操作系统的资源管理器中文件夹窗口就是...

请问TListView组件的使用.rar

  • 2008年11月27日 21:36
  • 5KB
  • 下载

一个简单组件的制作过程——delphi教程

接下来要动手来做一个组件了,我想了一个计数器组件,功能方面是比较简单的,但这不是本章的重点,这一章的重点是说明一个组件的制作全过程。在其中可以学到很多组件制作的技巧,当然这些也是我从书上学得的。好了,...

Delphi TListView的应用

  • 2012年07月25日 15:09
  • 227B
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一个功能增强的Delphi TListView组件
举报原因:
原因补充:

(最多只允许输入30个字)