TListView点击列头排序(100分)

TListView点击列头排序,求程序代码.谢谢

一个扩展的ListView组件
unit ListViewEx;
interface
uses
SysUtils, Classes, Controls, ComCtrls, StrUtils, Graphics;
type
TListViewEx = class(TListView)
private
FLastOrderIndex : Integer;
FAutoSort: Boolean;
FColumnOrderIndex : Integer;
FColumnOrderDesc : Boolean;
{FOddColor: TColor;
FEvenColor: TColor;
FOddFont: TFont;
FEvenFont: TFont;//}
procedure SetAutoSort(const Value: Boolean);
{procedure SetEvenFont(const Value: TFont);
procedure SetOddFont(const Value: TFont);//}
procedure UpdateColumnCaption;
protected
procedure ColClick(Column: TListColumn);
override;
proceduredo
Compare(Sender: TObject;
Item1, Item2: TListItem;
Data: Integer;
var Compare: Integer);
{function CustomDrawItem(Item: TListItem;
State: TCustomDrawState;
Stage: TCustomDrawStage): Boolean;
override;
function CustomDrawSubItem(Item: TListItem;
SubItem: Integer;
State: TCustomDrawState;
Stage: TCustomDrawStage): Boolean;
override;//}
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure ExportToFile(const AFileName : string);
procedure begin
Update;
procedure EndUpdate;
published
{property OddColor : TColor read FOddColor Write FOddColor default clWindow;
property OddFont : TFont read FOddFont Write SetOddFont;
property EvenColor : TColor read FEvenColor write FEvenColor default clWindow;
property EvenFont : TFont read FEvenFont Write SetEvenFont;//}
property AutoSort : Boolean read FAutoSort Write SetAutoSort default False;
end;

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

{ TListViewEx }
procedure TListViewEx.begin
Update;
begin
FLastOrderIndex := FColumnOrderIndex;
FColumnOrderIndex := -1;
UpdateColumnCaption;
AlphaSort;
end;

procedure TListViewEx.ColClick(Column: TListColumn);
var
i : Integer;
begin
inherited;
if FAutoSort then
begin
i := Column.Index;
if i = FColumnOrderIndex then
FColumnOrderDesc := not FColumnOrderDesc;
FColumnOrderIndex := i;
UpdateColumnCaption;
AlphaSort;
end;
end;

constructor TListViewEx.Create(AOwner: TComponent);
begin
inherited;
FColumnOrderIndex := -1;
OnCompare := do
Compare;
{FOddFont := TFont.Create;
FEvenFont := TFont.Create;//}
end;

{function TListViewEx.CustomDrawItem(Item: TListItem;
State: TCustomDrawState;
Stage: TCustomDrawStage): Boolean;
begin
if item.Index mod 2 = 1 then
begin
Canvas.Brush.Color := FOddColor;
Canvas.Font := FOddFont;
end
else
begin
Canvas.Brush.Color := FEvenColor;
Canvas.Font := FEvenFont;
end;
Result := inherited CustomDrawItem(Item, State, Stage);
end;

function TListViewEx.CustomDrawSubItem(Item: TListItem;
SubItem: Integer;
State: TCustomDrawState;
Stage: TCustomDrawStage): Boolean;
begin
if item.Index mod 2 = 1 then
begin
Canvas.Brush.Color := FOddColor;
Canvas.Font := FOddFont;
end
else
begin
Canvas.Brush.Color := FEvenColor;
Canvas.Font := FEvenFont;
end;
Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
end;
//}
destructor TListViewEx.Destroy;
begin
{ FOddFont.Free;
FEvenFont.Free;//}
inherited;
end;

procedure TListViewEx.DoCompare(Sender: TObject;
Item1, Item2: TListItem;
Data: Integer;
var Compare: Integer);
var
l_str1, l_str2: String;
begin
if not FAutoSort then
Exit;
if FColumnOrderIndex = -1 then
Exit;
case FColumnOrderIndex of
0:
begin
l_str1 := item1.Caption;
l_str2 := item2.Caption;
end;
else
begin
if Item1.SubItems.Count > FColumnOrderIndex then
l_str1 := Item1.SubItems[FColumnOrderIndex - 1]
else
l_str1 := '';
if Item2.SubItems.Count > FColumnOrderIndex then
l_str2 := Item2.SubItems[FColumnOrderIndex - 1]
else
l_str2 := '';
end;
end;

if FColumnOrderDesc then
Compare := CompareStr(UpperCase(l_str2), UpperCase(l_str1))
else
Compare := CompareStr(UpperCase(l_str1), UpperCase(l_str2));
end;

procedure TListViewEx.EndUpdate;
begin
FColumnOrderIndex := FLastOrderIndex;
UpdateColumnCaption;
AlphaSort;
end;

procedure TListViewEx.ExportToFile(const AFileName: string);
var
i : Integer;
j : Integer;
s : string;
l : TStrings;
begin
l := TStringList.Create;
try
s := '';
for i := 0 to Columns.Count - 1do
s := s + Columns.Caption + #9;
System.Delete(s, Length(s), 1);
l.Add(s);
for j := 0 to Items.Count - 1do
begin
s := Items[j].Caption;
for i := 1 to Columns.Count - 1do
if Items[j].SubItems.Count >= i then
s := s + #9 + Items[j].SubItems[i-1];
l.Add(s);
end;
l.SaveToFile(AFileName);
finally
l.Free;
end;
end;

procedure TListViewEx.SetAutoSort(const Value: Boolean);
begin
FAutoSort := Value;
end;

{procedure TListViewEx.SetEvenFont(const Value: TFont);
begin
FEvenFont.Assign(Value);
end;

procedure TListViewEx.SetOddFont(const Value: TFont);
begin
FOddFont.Assign(Value);
end;
//}
procedure TListViewEx.UpdateColumnCaption;
var
i: Integer;
const
S_Tags : array[0..1] of string = ('▲', '▼');
begin
for i := 0 to Columns.Count - 1do
begin
if (RightStr(Columns.Caption, 1) = S_Tags[0]) or
(RightStr(Columns.Caption, 1) = S_Tags[1]) then
Columns.Caption :=
LeftBStr(Columns.Caption, Length(Columns.Caption) -
Length(S_Tags[0]) - 1);
end;

if FColumnOrderIndex >= 0 then
if FColumnOrderDesc then
Columns[FColumnOrderIndex].Caption :=
Columns[FColumnOrderIndex].Caption
+ ' ' + S_Tags[1]
else
Columns[FColumnOrderIndex].Caption :=
Columns[FColumnOrderIndex].Caption
+ ' ' + S_Tags[0];
end;

end.

TO:轻舞肥羊
首先谢谢你的回答,不过我想要一个在TListView稍加改动就可实现排序的方法,我在cb里用,请指点一下.在网上查了下,没有找到太明确的说明.

unit UCReport;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls, Buttons, Math;
－－－
type
TFrmReport = class(TForm)
Panel1: TPanel;
LvReport: TListView;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure LvReportCompare(Sender: TObject;
Item1, Item2: TListItem;
Data: Integer;
var Compare: Integer);
procedure LvReportColumnClick(Sender: TObject;
Column: TListColumn);
private
{ Private declarations }
public
{ Public declarations }
columntosort :integer;
//选中列的索引号
isascsort :boolean;
//是否升序
end;

var
FrmReport: TFrmStatusReport;
implementation
{$R *.dfm}
procedure TFrmReport.BitBtn1Click(Sender: TObject);
begin
Close;
end;

procedure TFrmReport.LvReportCompare(Sender: TObject;
Item1,
Item2: TListItem;
Data: Integer;
var Compare: Integer);
var //自定义排序号方式；
xi:integer;
begin
if columntosort=0 then
if isascsort then
compare:=Comparetext(item1.Caption,item2.Caption)
else
compare:=Comparetext(item2.Caption,item1.Caption)
else
begin
xi := columntosort-1;
if isascsort then
compare:=CompareText(item1.SubItems[xi],item2.SubItems[xi])
else
compare:=CompareText(item2.SubItems[xi],item1.SubItems[xi]);
end;
end;

procedure TFrmStatusReport.LvReportColumnClick(Sender: TObject;
Column: TListColumn);
var
i : integer;
begin

isascsort:=not isascsort;//判断排序方式，每次按下总是反向排序；
//当列不是当前列时，去掉列标题中的箭头。去掉所有的箭头，防止重复添加
for i := 0 to LvReport.Columns.Count -1do
// if LvReport.Column.Index <> Column.Index then
begin
LvReport.Columns.Caption := StringReplace(LvReport.Columns.Caption,
'▲ ','',[rfReplaceAll]);
LvReport.Columns.Caption :=StringReplace(LvReport.Columns.Caption,
'▼ ' ,'',[rfReplaceAll]);
end;

//为列标题添加箭头
if isAscSort then
(Sender as TListView).Columns[Column.Index].Caption :=
'▲ ' + (Sender as TListView).Columns[Column.Index].DisplayName
else
(Sender as TListView).Columns[Column.Index].Caption :=
'▼ ' + (Sender as TListView).Columns[Column.Index].DisplayName ;
columntosort:=column.Index;
(sender as tcustomlistview).AlphaSort;
end;

end.

多人接受答案了。