难道这里没有大侠了吗?没有人帮小妹了?就是ListView中的按栏目进行排序,在上面的标题栏中用上下箭头来表示进行的是什么样的排序。 (100分)

  • 主题发起人 主题发起人 nexthawks
  • 开始时间 开始时间
N

nexthawks

Unregistered / Unconfirmed
GUEST, unregistred user!
就是ListView中的按栏目进行排序,在上面的标题栏中用上下箭头来表示进行的是什么样的排序。
如同Windows的资源管理器中的排序时,右边的标题中有上下箭头,如有源码实现,立即送分。
 
listview太慢

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
ListView1: TListView;
procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
private
{ Private declarations }
FLastIndex: Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function CustSortAsc(Item1, Item2: TListItem;
ColIndex: Integer): Integer; stdcall;
var
Item1Str: string;
Item2Str: string;
TmpExt: Extended;
begin
Result := 0;
Item1Str := '';
Item2Str := '';

if ColIndex < 0 then
Exit;

if ColIndex = 0 then
begin
Item1Str := Item1.Caption;
Item2Str := Item2.Caption;
end
else
begin
if ColIndex <= Item1.SubItems.Count then
Item1Str := Item1.SubItems[ColIndex - 1];

if ColIndex <= Item2.SubItems.Count then
Item2Str := Item2.SubItems[ColIndex - 1];
end;

Result := CompareText(Item1Str, Item2Str);

// If one of the strings is empty, make the other string sort before it

if (Result > 0) and (Item2Str = '') then
Result := -1
else if (Result < 0) and (Item1Str = '') then
Result := 1;
end; {= CustSortAsc =}

function CustSortDesc(Item1, Item2: TListItem;
ColIndex: Integer): Integer; stdcall;
begin
Result := CustSortAsc(Item1, Item2, ColIndex);
Result := Result * -1;
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if FLastIndex = Column.Index then
begin
ListView1.CustomSort(@CustSortDesc, Column.Index);
FLastIndex := -1;
end
else
begin
ListView1.CustomSort(@CustSortAsc, Column.Index);
FLastIndex := Column.Index;
end;
end;

end.
 
排序我自己能写,我是要实现那种有箭头的效果
 
那就用第三方控件吧。Developer Express Inc
 
用第三方控件太麻烦,以前我看到有人做出来过的,难道就没有真正的大侠了吗?
 
use image,
function SubSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SubSortProc_Neg(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
function SubSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
if ParamSort=-1 then
Result := lstrcmp(PChar(TListItem(Item1).Caption),
PChar(TListItem(Item2).Caption))
else
Result := lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort]),
PChar(TListItem(Item2).SubItems[ParamSort]));
end;

function SubSortProc_Neg(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
if ParamSort=-1 then
Result := -lstrcmp(PChar(TListItem(Item1).Caption),
PChar(TListItem(Item2).Caption))
else
Result := -lstrcmp(PChar(TListItem(Item1).SubItems[ParamSort]),
PChar(TListItem(Item2).SubItems[ParamSort]));
end;
procedure TFm_ErrAction.LV_ErrActColumnClick(Sender: TObject;
Column: TListColumn);
var
i:integer;
begin
if Column.index>0 then
if (Column.ImageIndex=ICON_Up) or (Column.ImageIndex=-1) then
begin
TListView(Sender).CustomSort(@SubSortProc_Neg, Column.index-1);
Column.ImageIndex:=ICON_Down;
end
else if Column.ImageIndex=ICON_Down then
begin
TListView(Sender).CustomSort(@SubSortProc, Column.index-1);
Column.ImageIndex:=ICON_Up;
end;
for i:=1 to TListView(Sender).Columns.Count-1 do
if i<>Column.index then TListView(Sender).Columns.Imageindex:=-1;
end;
 
用第三方控件比较好的
 
干吗自己写,不过也不难。
把listview的smallimages设置成imagelist就可以了,至于图标自己画吧
procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
listview1.Column[1].ImageIndex:=1;
end;
 
//在楼上的基础上改为这样,然后根据ImageIndex的值改变所要排序的类型就行了(排序代码自己写)
procedure THW_RC.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if ListView1.Columns[Column.Index].ImageIndex=-1 then
begin
ListView1.Columns[Column.Index].ImageIndex:=0;
//排序代码自己写
exit;//升序
end;
if ListView1.Columns[Column.Index].ImageIndex=0 then
begin
ListView1.Columns[Column.Index].ImageIndex:=1;
//排序代码自己写
exit;//降序
end;
if ListView1.Columns[Column.Index].ImageIndex=1 then
begin
ListView1.Columns[Column.Index].ImageIndex:=-1;
exit;//不排序
end;
end;
 
在我的资料里找了半天,才找到。
在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结构的解释。



 
to 楼上那们大哥
你的那个程序,我是先建了一个form, 之后改成了你的代码,但总是说";"except but end found
 
to风云再起:
在UNIT中做,也是那个问题
 
倒,有这么复杂吗?连重载都用了,倒~
 
现在在D7中好象编译通过,但就是形成不了dcluser.bpl
 
nextthawks:
我十分理解你焦急的心情。我也遇到过。上次贴的代码没有问题。处了
publiced 的第二个属性后少了个‘。’号。你可以直接粘贴下面的代码。
unit ListViewEx;

interface

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

type
TListViewEx = 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;
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); override;
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SortColumn(Column: TListColumn);
{ Public declarations }
published
property BackPicture: TPicture read FPicture write SetPicture;
property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
{ Published declarations }
end;

procedure Register;

implementation
var AtoZOrder: Boolean;

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

{ TListViewEx }

constructor TListViewEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FHeaderFont := TFont.Create;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
OnCustomDraw := LVCustomDraw;
end;

destructor TListViewEx.Destroy;
begin
FPicture.Free;
FHeaderFont.Free;
inherited Destroy; //继承
end;

procedure TListViewEx.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;

procedure TListViewEx.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 TListViewEx.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 TListViewEx.PictureChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TListViewEx.SetHeaderFont(Value: TFont);
begin
if FHeaderFont <> Value then begin
FHeaderFont.Assign(Value);
InvalidateRect(GetDlgItem(Handle, 0), nil, true); //调用Windows API(二个函数均是)
end;
end;

procedure TListViewEx.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;

procedure TListViewEx.SetPicture(Value: TPicture);
begin
if FPicture <> Value then
FPicture.Assign(Value);
end;

procedure TListViewEx.SortColumn(Column: TListColumn);
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;
begin
if FOldCol = Column.Index then
FaToz := not FAtoZ
else
FOldCol := Column.Index;
AtoZOrder := FaToz;
CustomSort(@CustomSortProc, Column.Index);
end;

procedure TListViewEx.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;

end.
100%ok。我试了。
 
to风云再起:
谢谢你, 你的那个大部分是好的,但还是有点小问题。比如在两个标题间双击时,会乱掉的,不知道怎么
解决,在线等,如果解决,送分了。
 
而且排几次就不行了,会有错误
 
有现成的控件为什么不用,还花费时间在这上面
 
加我的QQ,我传个DEMO给你。
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
后退
顶部