StringGrid好贴共亨

Question

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, ADODB, DBTables, Grids;//注意这里要引用type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure SGDrawCell(Sender: TObject; ACol, ARow: Integer;
　 Rect: TRect; State: TGridDrawState);
procedure SGTopLeftChanged(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//重载 OnDrawCell 事件
procedure TForm1.SGDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
r:TRect;
d:TStringGrid;
s:string;
ts:TStrings;
i,n:integer;
fixed:Boolean;
begin
d:=TStringGrid(sender);
if (Acol=2) and (ARow=0) then
begin
r.left:=Rect.left-1-d.colwidths[ACol-1];
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol-1,ARow];
end else
if (Acol=1) and (ARow=0) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right+d.colwidths[ACol+1];
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow];
end　 //////////以上列合并
else
if (Acol=0) and (ARow=2) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1-d.RowHeights[ARow-1];
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow-1];
end else
if (Acol=1) and (ARow=0) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom+d.RowHeights[ARow+1];
s:=d.cells[ACol,ARow];
end　////////以上为行合并
else
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow];
end;d.Canvas.brush.color:=d.color;
d.canvas.Font.color:=$ff0000;Fixed:=false;
if (Arowbegin
d.Canvas.brush.color:=d.FixedColor;
d.Canvas.Font.color:=$ff00ff;
Fixed:=True;
//d.Canvas.Font.style:=d.Canvas.Font.style+[fsBold];
end;
if gdfocused in state then
begin
d.canvas.Brush.color:=$00ff00;
end;
if fixed then
begin
d.Canvas.Pen.color:=$0;
d.canvas.Rectangle(r);
d.Canvas.Pen.color:=$f0f0f0;
d.Canvas.Pen.Width:=2;
d.canvas.Moveto(r.left+1,r.top+2);
d.canvas.Lineto(r.left+r.right,r.top+2);
d.Canvas.Pen.color:=$808080;
d.Canvas.Pen.Width:=1;
d.canvas.Moveto(r.Left+1,r.bottom-1);
d.canvas.Lineto(r.left+r.right,r.bottom-1);
end else
begin
d.Canvas.Pen.color:=$0;
d.Canvas.Pen.Width:=1;
d.canvas.Rectangle(r);
end;
n:=r.top+4;
ts:=TStringList.Create;
ts.CommaText:=s;
for i:=0 to ts.Count-1 do
begin
d.canvas.Textout(r.left+4,n,ts[i]);
inc(n,d.RowHeights[ARow]);
end;
end;
//重载 OnTopLeftChange事件,特别是行的合并
procedure TForm1.SGTopLeftChanged(Sender: TObject);
var
d:TStringGrid;
begin
d:=TStringGrid(Sender);
d.Cells[0,1]:=d.Cells[0,1];
d.Cells[0,2]:=d.Cells[0,2];
end;
end. 
删除选定行【来自wyb_star】Procedure DeleteRow(AGrid : TStringGrid);
var i, cr : integer;
begin
If assigned(AGrid) then
begin
　cr := AGrid.Selection.Top;
　for i := cr + 1 to AGrid.RowCount - 1 do
　　AGrid.Rows[i-1].Assign(AGrid.Rows[i]);
　AGrid.RowCount := AGrid.RowCount - 1;
end;
end;　
保存StringGrid到html文件【来自wyb_star】procedure SaveToHtml(StringGrid:TStringGrid;const FileName : string;const Title : string);
var
Txt : TextFile;
i,ii: integer;
Value:string;
BgColor:TColor;
function GetColor(Color: TColor): String;
var s: String;
begin
　if Color = clNone then
　　s := '000000'
　else
　　s := IntToHex(ColorToRGB(Color), 6);
　Result := Copy(s, 5, 2) + Copy(s, 3, 2) + Copy(s, 1, 2);
end;
begin
BgColor := clWhite;
AssignFile(Txt,FileName);
Rewrite(Txt);
WriteLn(Txt,'');
WriteLn(Txt,' ' + Value + '');
CloseFile(Txt);
end;使用示例：
SaveToHtml(StringGrid1,'c:\1.html','标题');　高速排序函数（在StringGrid里加上5000行试试就知道它的效率了）【来自wyb_star】【这个东西很强劲的，感谢 wyb_Star 提供】
高速排序函数（在StringGrid里加上5000行试试就知道它的效率了） 
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　　　　 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　　　　 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.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
c:integer;
w:integer;
Grid:TStringGrid;
begin
Grid := Sender as TStringGrid;
with Grid do
if y<=rowheights[0] then
begin
　c:=0;
　w:=colwidths[0];
　while (c　begin
　　inc(c);
　　w:=w+colwidths[c]+gridlinewidth;
　end;
　sortgrid(Grid,c,0);
end;end; 

Answer 1

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, ADODB, DBTables, Grids;//注意这里要引用type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure SGDrawCell(Sender: TObject; ACol, ARow: Integer;
　 Rect: TRect; State: TGridDrawState);
procedure SGTopLeftChanged(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//重载 OnDrawCell 事件
procedure TForm1.SGDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
r:TRect;
d:TStringGrid;
s:string;
ts:TStrings;
i,n:integer;
fixed:Boolean;
begin
d:=TStringGrid(sender);
if (Acol=2) and (ARow=0) then
begin
r.left:=Rect.left-1-d.colwidths[ACol-1];
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol-1,ARow];
end else
if (Acol=1) and (ARow=0) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right+d.colwidths[ACol+1];
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow];
end　 //////////以上列合并
else
if (Acol=0) and (ARow=2) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1-d.RowHeights[ARow-1];
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow-1];
end else
if (Acol=1) and (ARow=0) then
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom+d.RowHeights[ARow+1];
s:=d.cells[ACol,ARow];
end　////////以上为行合并
else
begin
r.left:=Rect.left-1;
r.top:=rect.top-1;
r.right:=rect.right;
r.bottom:=rect.bottom;
s:=d.cells[ACol,ARow];
end;d.Canvas.brush.color:=d.color;
d.canvas.Font.color:=$ff0000;Fixed:=false;
if (Arowbegin
d.Canvas.brush.color:=d.FixedColor;
d.Canvas.Font.color:=$ff00ff;
Fixed:=True;
//d.Canvas.Font.style:=d.Canvas.Font.style+[fsBold];
end;
if gdfocused in state then
begin
d.canvas.Brush.color:=$00ff00;
end;
if fixed then
begin
d.Canvas.Pen.color:=$0;
d.canvas.Rectangle(r);
d.Canvas.Pen.color:=$f0f0f0;
d.Canvas.Pen.Width:=2;
d.canvas.Moveto(r.left+1,r.top+2);
d.canvas.Lineto(r.left+r.right,r.top+2);
d.Canvas.Pen.color:=$808080;
d.Canvas.Pen.Width:=1;
d.canvas.Moveto(r.Left+1,r.bottom-1);
d.canvas.Lineto(r.left+r.right,r.bottom-1);
end else
begin
d.Canvas.Pen.color:=$0;
d.Canvas.Pen.Width:=1;
d.canvas.Rectangle(r);
end;
n:=r.top+4;
ts:=TStringList.Create;
ts.CommaText:=s;
for i:=0 to ts.Count-1 do
begin
d.canvas.Textout(r.left+4,n,ts[i]);
inc(n,d.RowHeights[ARow]);
end;
end;
//重载 OnTopLeftChange事件,特别是行的合并
procedure TForm1.SGTopLeftChanged(Sender: TObject);
var
d:TStringGrid;
begin
d:=TStringGrid(Sender);
d.Cells[0,1]:=d.Cells[0,1];
d.Cells[0,2]:=d.Cells[0,2];
end;
end. 
删除选定行【来自wyb_star】Procedure DeleteRow(AGrid : TStringGrid);
var i, cr : integer;
begin
If assigned(AGrid) then
begin
　cr := AGrid.Selection.Top;
　for i := cr + 1 to AGrid.RowCount - 1 do
　　AGrid.Rows[i-1].Assign(AGrid.Rows[i]);
　AGrid.RowCount := AGrid.RowCount - 1;
end;
end;　
保存StringGrid到html文件【来自wyb_star】procedure SaveToHtml(StringGrid:TStringGrid;const FileName : string;const Title : string);
var
Txt : TextFile;
i,ii: integer;
Value:string;
BgColor:TColor;
function GetColor(Color: TColor): String;
var s: String;
begin
　if Color = clNone then
　　s := '000000'
　else
　　s := IntToHex(ColorToRGB(Color), 6);
　Result := Copy(s, 5, 2) + Copy(s, 3, 2) + Copy(s, 1, 2);
end;
begin
BgColor := clWhite;
AssignFile(Txt,FileName);
Rewrite(Txt);
WriteLn(Txt,'');
WriteLn(Txt,' ' + Value + '');
CloseFile(Txt);
end;使用示例：
SaveToHtml(StringGrid1,'c:\1.html','标题');　高速排序函数（在StringGrid里加上5000行试试就知道它的效率了）【来自wyb_star】【这个东西很强劲的，感谢 wyb_Star 提供】
高速排序函数（在StringGrid里加上5000行试试就知道它的效率了） 
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　　　　 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　　　　 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.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
c:integer;
w:integer;
Grid:TStringGrid;
begin
Grid := Sender as TStringGrid;
with Grid do
if y<=rowheights[0] then
begin
　c:=0;
　w:=colwidths[0];
　while (c　begin
　　inc(c);
　　w:=w+colwidths[c]+gridlinewidth;
　end;
　sortgrid(Grid,c,0);
end;end; 这是我从网摘抄的，自己也有一定研究，请各位参考。