Chinaunix首页 | 论坛 | 博客
  • 博客访问: 537145
  • 博文数量: 252
  • 博客积分: 6057
  • 博客等级: 准将
  • 技术积分: 1635
  • 用 户 组: 普通用户
  • 注册时间: 2009-12-21 10:17
文章分类

全部博文(252)

文章存档

2013年(1)

2012年(1)

2011年(32)

2010年(212)

2009年(6)

分类:

2010-09-13 17:02:30

如果设置Column[I].ImageIndex = a,箭头会出现在文字左边,
需要修改ComCtrls.pas才能使图片出现在右边。
并且TListItem的Caption项会自动加上图标,
没有图标则留出一个空白,非常难看。
这个修改过的控件解决了这些问题。
这个控件需要从资源文件中装载两个箭头图片,你需要自己制作。
或者下载SJListview,里面有SJListview.res资源文件。
}

{*******************************************************}
{                                                       }
{  ComponentName : SJListView                           }
{  Version       : 2.2a                                 }
{  Author        : SJ(小笨苯)                           }
{  E_Mail        : taibenle@163.com                     }
{  Last Modified : 2002-5-15                            }
{  History       :                                      }
{  修改          : 2004-12-25 afan                      }
{                                                       }
{*******************************************************}

unit SJListView;

interface

uses
  Windows, Messages, SysUtils, Classes, ComCtrls, Commctrl, WinSock;

type
  TListView2 = class(TListView)
  private
    { Private declarations }
    ArrowUp : HBitMap;
    ArrowDown : HBitMap;
    CurColumn: integer;
    vHandle: HWND;

    procedure SetHeaderBitmap(Col: integer);//画Header
  protected
    { Protected declarations }
    //procedure WndProc(var Msg : TMessage); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure CreateWnd; override;
    destructor Destroy; override;
  published
    { Published declarations }
  end;

type
  TMainListview = class(TListview2)
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;


type
  TMyListview = class(TListview2)
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;

procedure Register;

implementation

{R SJListView.res}


{ 通用排序函数 }
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
      result := CompareText(Item1.SubItems[Lparam-1],Item2.SubItems[Lparam-1]);
   Result:= Result * Item1.ListView.Column[lParam].Tag ;
end;

//验证合法ip地址
function ValidateIP(const ip:string):boolean;
var
  i,dotnum: byte;
begin
  Result:=false;
  if ip = '' then
    exit;
  dotnum:= 0;
  for I:=1 to Length(ip) do
    if ip[I] = '.' then
      inc(dotnum);
  if dotnum <> 3 then
    exit;
  if (ip='255.255.255.255')or(inet_Addr(pchar(ip))<>Inaddr_none) then
    result:=true
  else
    result:=false;
end;

function CustomSortProcMain( Item1, Item2 : TListItem; lParam : LongInt  : Integer; stdcall;
var
  ip1,ip2:cardinal;
  s1,s2:String;
begin
   Result:=0;
   if (Item1=nil)or(Item2=nil)then
     exit;
   if lParam = 0 then
      result := CompareText(Item1.Caption,Item2.Caption 
   else if lparam =2 then begin 
     s1:=Item1.SubItems[1];
     s2:=Item2.SubItems[1];
     if ValidateIP(s1) and ValidateIP(s2) then begin
       ip1:=htonl(inet_addr(pchar(s1)));
       ip2:=htonl(inet_addr(pchar(s2)));
       if ip1 > Ip2 then
         Result:= 1 else
       if ip1 = ip2 then
         result:=0  else
         result:=-1;
     end
     else
       result:= CompareText(s1,s2);
   end
   else
      result := CompareText(Item1.SubItems[Lparam-1],Item2.SubItems[Lparam-1]) ;

   Result:= Result * Item1.ListView.Column[lParam].Tag ;
end;

constructor TListview2.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ArrowUp := LoadImage(hInstance, 'ArrowUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  ArrowDown := LoadImage(hInstance, 'ArrowDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  //SetHeaderBitmap;
end;

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

destructor TListview2.Destroy;
begin
  DeleteObject(ArrowUp);
  DeleteObject(ArrowDown);
  inherited Destroy;
end;


procedure TListview2.SetHeaderBitmap(Col: integer);
var
  HdItem : THdItem;
begin
  FillChar(HdItem, SizeOf(HdItem), #0);

  HdItem.Mask := HDI_FORMAT;
  Header_GetItem(vHandle, Col, HdItem);
  HdItem.Mask := HDI_BITMAP or HDI_FORMAT;

  if Column[Col].Tag = -1 then begin { 反向 }
    HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
    HdItem.hbm := LoadImage(hInstance, 'ArrowDown', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  end
  else if Column[Col].Tag = 1 then begin { 正向 }
    HdItem.fmt := HdItem.fmt or HDF_BITMAP or HDF_BITMAP_ON_RIGHT;
    HdItem.hbm := LoadImage(hInstance, 'ArrowUp', IMAGE_BITMAP, 0, 0, LR_LOADMAP3DCOLORS);
  end
  else if Column[Col].Tag = 0 then begin{ 消除箭头 }
    HdItem.fmt := HdItem.fmt and not (HDF_BITMAP or HDF_BITMAP_ON_RIGHT);
    HdItem.hbm := 0;
  end;

  Header_SetItem(vHandle, Col, HdItem);
end;

(*
procedure TListview2.WndProc(var Msg : TMessage);
var
  pHD : PHDNotify;
  i: integer;
begin
  inherited WndProc(Msg);

  if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
  begin
    pHD := PHDNotify(Msg.LParam);
    HwndFrom:= pHD.Hdr.hwndFrom ;
    if (hwndFrom = vHandle) and (vHandle <> 0) then begin
      wmCode:= 0;
      Case pHD.HDr.code of
        { 如果是点击Header }
        HDN_ITEMCLICK,HDN_ITEMCLICKW:
          begin
            CurColumn := Columns.Items[pHD.item].Index;
            wmCode:= pHD.Hdr.code ;
            { 做标记,正向或反向排序 }
              for i:= 0 to Columns.Count - 1 do begin
                if I = CurColumn 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, CurColumn);
          end;

        { 拖动改变宽度时,ColumnItem <> 原来排序的列 }
        HDN_ENDTRACK,HDN_ENDTRACKW:
          Begin
            CurColumn:= Columns.Items[pHD.item].Index;
            if Columns[CurColumn].Tag <> 0 then
              SetHeaderBitmap(CurColumn);
          end;
      end;
    end;
  end;
end;
*)

Procedure TMyListview.WndProc(var Msg: TMessage);
var
  pHD : PHDNotify;
  i: integer;
begin
  inherited WndProc(Msg);

  if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
  begin
    pHD := PHDNotify(Msg.LParam);
    if (pHD.Hdr.hwndFrom = vHandle) and (vHandle <> 0) then begin
      Case pHD.HDr.code of
        { 如果是点击Header }
        HDN_ITEMCLICK,HDN_ITEMCLICKW:
          begin
            CurColumn := Columns.Items[pHD.item].Index;
            { 做标记,正向或反向排序 }
              for i:= 0 to Columns.Count - 1 do begin
                if I = CurColumn 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, CurColumn);
          end;

        { 拖动改变宽度时,ColumnItem <> 原来排序的列 }
        HDN_ENDTRACK,HDN_ENDTRACKW:
          Begin
            CurColumn:= Columns.Items[pHD.item].Index;
            if Columns[CurColumn].Tag <> 0 then
              SetHeaderBitmap(CurColumn);
          end;
      end;
    end;
  end;
end;

procedure TMainListview.WndProc(var Msg: TMessage);
var
  pHD : PHDNotify;
  i: integer;
begin
  inherited WndProc(Msg);

  if Msg.Msg = WM_NOTIFY then //如果截获的消息是WM_NOTIFY
  begin
    pHD := PHDNotify(Msg.LParam);
    if (pHD.Hdr.hwndFrom = vHandle) and (vHandle <> 0) then begin
      Case pHD.HDr.code of
        { 如果是点击Header }
        HDN_ITEMCLICK,HDN_ITEMCLICKW:
          begin
            CurColumn := Columns.Items[pHD.item].Index;
            { 做标记,正向或反向排序 }
              for i:= 0 to Columns.Count - 1 do begin
                if I = CurColumn 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(@CustomSortProcMain, CurColumn);
          end;

        { 拖动改变宽度时,ColumnItem <> 原来排序的列 }
        HDN_ENDTRACK,HDN_ENDTRACKW:
          Begin
            CurColumn:= Columns.Items[pHD.item].Index;
            if Columns[CurColumn].Tag <> 0 then
              SetHeaderBitmap(CurColumn);
          end;
      end;
    end;
  end;
end;



procedure Register;
begin
  RegisterComponents('Win32', [TMainListView, TMyListview]);
end;


end.


第三方组件介绍:
   
  • 程序名称:VirtualTreeview v4.5.2 (完整源码)
  • 文件大小:9.57MB
  • 更新时间:2007-07-19 00:10:27
  • 开发工具:C++Builder,Delphi,BDS
  •  开发者:
  • 官方网站:
  • 详细介绍:一套免费的很好的Treeview控件,比标准Treeview控件更快更有效率;熟悉后还可以全面替代listview、各类grid控件。
    ccrun注:本组件依赖ThemeManager,安装时请先运行ThemeManagerSetup.exe安装,再运行 VirtualTreeviewSetup.exe,安装完毕后会自动进行编译。你要做的工作仅仅是打开BCB或 Delphi,Commponent-->Install Packages-->找到$(BCB)或$(Delphi)\Projects\bpl\VirtualTrees**D.bpl添加进来即可。

TMS Component Pack V3.1 With Full Source

TMS公司出品的上百个用于Delphi/C++Builder的组件包。
官方网址:

在线的源码下载网址:
%D0%9A%D0%BE%D0%BC%D0%BF%D0%BE%D0%BD%D0%B5%D0%BD%D1%82%D1%8B/TMS%20Component%20pack%20v4.4_2007-06-23%20w-sourses/

TMS Component Pack V4.4 中的treelist.pas源代码本地下载:
文件:treelist.pas.rar
大小:51KB
下载:下载


 



阅读(5015) | 评论(1) | 转发(0) |
给主人留下些什么吧!~~

chulia200020012010-09-14 00:56:37

Delphi组件开发教程指南(2)简单扩充TEdit http://www.cnblogs.com/DxSoft/archive/2010/04/27/1721711.html delphi组件开发 http://blog.chinaunix.net/u/28618/showart_376592.html 组件开发方式 http://www.moon-soft.com/doc/10693.htm VCL组件开发实例 http://www.delphifans.com/SoftView/SoftView_248.html Delphi组件开发指南中文版 http://www.52delphi.com/list.asp?ID=310