Delphi xe FireMonkey FMX StingGrid 点击表头排序

http://download.csdn.net/detail/sxf_zero/9560397

最近在尝试使用 delphi xe 的 FireMonkey 类库写东西，用到FMX 的 TStringGrid 控件，数据是运行时程序填充的，需要实现点击标题排序的功能，网上搜索了下，都是VLC TStringGrid 相关的代码，看来 FMX 还是很小众的东东。依葫芦画瓢，网上找了使用比较多的VCL StringGrid 的排序算法，自己改了下用在 FMX 下的StringGrid OK了，代码贴出来备忘。

VCL下的实现StingGrid 点击表头排序


unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids;

type
TForm1 = class(TForm)
strngrd1: TStringGrid;
btn1: TButton;
lbl1: TLabel;
procedure btn1Click(Sender: TObject);
procedure strngrd1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure Quicksort(Grid: TStringGrid; var List: array of integer; min, max, sortcol, datatype: Integer);
{List is a list of rownumbers in the grid being sorted}
var
med_value: integer;
hi, lo, i: Integer;

function compare(val1, val2: string): integer;
var
int1, int2: integer;
float1, float2: extended;
errcode: integer;
begin
case datatype of
0:
result := ANSIComparetext(val1, val2);
1:
begin
int1 := strtointdef(val1, 0);
int2 := strtointdef(val2, 0);
if int1 > int2 then
result := 1
else if int1 < int2 then
result := -1
else
result := 0;
end;

2:
begin
val(val1, float1, errcode);
if errcode <> 0 then
float1 := 0;
val(val2, float2, errcode);
if errcode <> 0 then
float2 := 0;
if float1 > float2 then
result := 1
else if float1 < float2 then
result := -1
else
result := 0;
end;
else
result := 0;
end;
end;

begin
{If the list has <= 1 element, it's sorted}
if (min >= max) then
Exit;
{Pick a dividing item randomly}
i := min +
Trunc(Random(max - min + 1));
med_value := List[i];
List[i] := List[min]; { Swap it to the front so we can find it easily}
{Move the items smaller than this into the left
half of the list. Move the others into the right}
lo := min;
hi := max;
while (True) do
begin
// Look down from hi for a value < med_value.
while compare(Grid.cells[sortcol, List[hi]], grid.cells[sortcol, med_value]) >= 0 do
(*ANSIComparetext(Grid.cells[sortcol,List[hi]]
,grid.cells[sortcol,med_value])>=0 do*)
begin
hi := hi - 1;
if (hi <= lo) then
Break;
end;
if (hi <= lo) then
begin {We're done separating the items}
List[lo] := med_value;
Break;
end;

// Swap the lo and hi values.
List[lo] := List[hi];
inc(lo); {Look up from lo for a value >= med_value}
while Compare(grid.cells[sortcol, List[lo]], grid.cells[sortcol, med_value]) < 0 do
begin
inc(lo);
if (lo >= hi) then
break;
end;
if (lo >= hi) then
begin {We're done separating the items}
lo := hi;
List[hi] := med_value;
break;
end;
List[hi] := List[lo];
end;
{Sort the two sublists}
Quicksort(Grid, List, min, lo - 1, sortcol, datatype);
Quicksort(Grid, List, lo + 1, max, sortcol, datatype);
end;

//datatype 0：按字符排序 1：按整型排序 2：按浮点型排序
procedure Sortgrid(Grid: TStringGrid; sortcol, datatype: integer);
var
i: integer;
tempgrid: tstringGrid;
list: array of integer;
begin
screen.cursor := crhourglass;
tempgrid := TStringgrid.create(nil);
with tempgrid do
begin
rowcount := grid.rowcount;
colcount := grid.colcount;
fixedrows := grid.fixedrows;
end;
with Grid do
begin
setlength(list, rowcount - fixedrows);
for i := fixedrows to rowcount - 1 do
begin
list[i - fixedrows] := i;
tempgrid.rows[i].assign(grid.rows[i]);
end;
quicksort(Grid, list, 0, rowcount - fixedrows - 1, sortcol, datatype);
for i := 0 to rowcount - fixedrows - 1 do
begin
rows[i + fixedrows].assign(tempgrid.rows[list[i]])

end;
row := fixedrows;
end;
tempgrid.free;
setlength(list, 0);
screen.cursor := crdefault;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
i, j: Integer;
begin
strngrd1.ColCount := 5;
strngrd1.RowCount := 10000;
for I := 0 to 9999 do
begin
for j := 0 to 4 do
begin
strngrd1.Cells[j, i] := IntToStr(Random(100000));
end;
end;
end;

procedure TForm1.strngrd1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
c: integer;
w: integer;
Grid: TStringGrid;
b, e: Cardinal;
begin

b := TThread.GetTickCount;
Grid := Sender as TStringGrid;
with Grid do
if y <= rowheights[0] then
begin
c := 0;
w := colwidths[0];
while (c < colcount) and (w <= x) do
begin
inc(c);
w := w + colwidths[c] + gridlinewidth;
end;
sortgrid(Grid, c, 1);
end;

e := TThread.GetTickCount;
lbl1.Caption := '用时：' + IntToStr(e - b) + ' 毫秒';
end;

end.

FireMonkey FMX 下实现StingGrid 点击表头排序

unit sort_stringgrid;

interface

uses
FMX.grid, SysUtils;

procedure Sortgrid(Grid: TStringGrid; sortcol, datatype: integer);

implementation

procedure Quicksort(Grid: TStringGrid; var List: array of integer; min, max, sortcol, datatype: Integer);
{List is a list of rownumbers in the grid being sorted}
var
med_value: integer;
hi, lo, i: Integer;

function compare(val1, val2: string): integer;
var
int1, int2: integer;
float1, float2: extended;
errcode: integer;
begin
case datatype of
0:
result := ANSIComparetext(val1, val2);
1:
begin
int1 := strtointdef(val1, 0);
int2 := strtointdef(val2, 0);
if int1 > int2 then
result := 1
else if int1 < int2 then
result := -1
else
result := 0;
end;

2:
begin
val(val1, float1, errcode);
if errcode <> 0 then
float1 := 0;
val(val2, float2, errcode);
if errcode <> 0 then
float2 := 0;

if float1 > float2 then
result := 1
else if float1 < float2 then
result := -1
else
result := 0;
end;
else
result := 0;
end;
end;

begin
{If the list has <= 1 element, it's sorted}
if (min >= max) then
Exit;
{Pick a dividing item randomly}
i := min + Trunc(Random(max - min + 1));
med_value := List[i];
List[i] := List[min]; { Swap it to the front so we can find it easily}
{Move the items smaller than this into the left
half of the list. Move the others into the right}
lo := min;
hi := max;
while (True) do
begin
// Look down from hi for a value < med_value.
while compare(Grid.cells[sortcol, List[hi]], grid.cells[sortcol, med_value]) >= 0 do
(*ANSIComparetext(Grid.cells[sortcol,List[hi]]
,grid.cells[sortcol,med_value])>=0 do*)
begin
hi := hi - 1;
if (hi <= lo) then
Break;
end;
if (hi <= lo) then
begin {We're done separating the items}
List[lo] := med_value;
Break;
end;

// Swap the lo and hi values.
List[lo] := List[hi];
inc(lo); {Look up from lo for a value >= med_value}
while Compare(grid.cells[sortcol, List[lo]], grid.cells[sortcol, med_value]) < 0 do
begin
inc(lo);
if (lo >= hi) then
break;
end;
if (lo >= hi) then
begin {We're done separating the items}
lo := hi;
List[hi] := med_value;
break;
end;
List[hi] := List[lo];
end;
{Sort the two sublists}
Quicksort(Grid, List, min, lo - 1, sortcol, datatype);
Quicksort(Grid, List, lo + 1, max, sortcol, datatype);
end;

//datatype 0：按字符排序 1：按整型排序 2：按浮点型排序
procedure Sortgrid(Grid: TStringGrid; sortcol, datatype: integer);
var
i: integer;
tempgrid: tstringGrid;
list: array of integer;
j: Integer; //zero 添加，2016-3-17
begin
//screen.cursor:=crhourglass; //zero注释掉 2016-3-17
tempgrid := TStringgrid.create(nil);
tempgrid.BeginUpdate;
with tempgrid do
begin

//colcount:=grid.colcount; //zero 改，设定列数
2016-3-17
for I := 0 to grid.ColumnCount - 1 do
begin
TStringColumn.Create(tempgrid).Parent := tempgrid;
end;
rowcount := grid.rowcount;
//colcount:=grid.colcount; //
//fixedrows:=grid.fixedrows;
//zero注释掉,FMX 的stringgrid没有fixedrows,所以直接从0行开始就好了 2016-3-17

end;
with Grid do
begin
//setlength(list,rowcount-fixedrows);
setlength(list, rowcount);
//for i:= fixedrows to rowcount-1 do
for i := 0 to rowcount - 1 do
begin
//list[i-fixedrows]:=i;
list[i] := i;
//tempgrid.rows[i].assign(grid.rows[i]);
for j := 0 to grid.ColumnCount - 1 do
tempgrid.Cells[j, i] := grid.Cells[j, i];
//tempgrid.rows[i].assign(grid.rows[i]);
end;
//quicksort(Grid, list,0,rowcount-fixedrows-1,sortcol,datatype);
quicksort(Grid, list, 0, rowcount - 1, sortcol, datatype);
//for i:=0 to rowcount-fixedrows-1 do


for i := 0 to rowcount - 1 do
begin
//rows[i+fixedrows].assign(tempgrid.rows[list[i]])
for j := 0 to tempgrid.ColumnCount - 1 do
grid.Cells[j, i] := tempgrid.Cells[j, list[i]];
//rows[i+fixedrows].assign(tempgrid.rows[list[i]])
end;


//row:=fixedrows;
//row:=fixedrows;
end;
//tempgrid.EndUpdate;
tempgrid.free;
tempgrid := nil;
setlength(list, 0);
//screen.cursor:=crdefault;
end;

end.


unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, System.Rtti,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.Grid;

type
TForm1 = class(TForm)
strngrd1: TStringGrid;
btn1: TButton;
StringColumn1: TStringColumn;
strngclmn1: TStringColumn;
strngclmn2: TStringColumn;
strngclmn3: TStringColumn;
strngclmn4: TStringColumn;
lbl1: TLabel;
procedure btn1Click(Sender: TObject);
procedure strngrd1HeaderClick(Column: TColumn);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses
sort_stringgrid;
{$R *.fmx}

procedure TForm1.btn1Click(Sender: TObject);
var
i, j: Integer;
begin
strngrd1.RowCount := 10000;
for I := 0 to 9999 do
begin
for j := 0 to 4 do
begin
strngrd1.Cells[j, i] := IntToStr(Random(100000));
end;
end;

end;

procedure TForm1.strngrd1HeaderClick(Column: TColumn);
var
c: integer;
w: integer;
Grid: TStringGrid;
b, e: Cardinal;
begin
b := TThread.GetTickCount;
Grid := strngrd1 as TStringGrid;
with Grid do
begin
c := Column.Index;
Grid.BeginUpdate;
sortgrid(Grid, c, 1);
Grid.EndUpdate;
end;
e := TThread.GetTickCount;

lbl1.Text := '用时：' + IntToStr(e - b) + ' 毫秒';
end;

end.

总体来说，FMX和VCL还是有很多相似之处，改起来也挺简单的，不过总感觉没有VCL用起来方便，也许是不习惯的原因吧。

简单对比了下执行效率, 同样的电脑，10000行随机数， FMX 耗时比VCL 下 多了 3-4倍，也许是代码问题，也许是FMX是套跨平台的年轻类库，效率上仍有待提高，毕竟VCL已经多年了。下面是效果图，顺便提下，在我的华为4c上跑 大概要9000-10000毫秒了。

代码大家在我的下载资源里面找 http://download.csdn.net/detail/sxf_zero/9560397