Delphi StringGrid控件的用法

Delphi StringGrid控件

组件名称：StringGrid   

    

●固定行及固定列： 

StringGrid.FixedCols:=固定行之数; 

StringGrid.FixedRows:=固定列之数; 

StringGrid. FixedColor:=固定行列之颜色; 

StringGrid.Color:=资料区之颜色; 

●资料行列之宽高度： 

StringGrid.DefaultColWidth:=内定全部之宽度; 

StringGrid.DefaultRowHeight:=内定全部之高度; 

StringGrid.ColWidths[Index:Longint]:=某一行整行之宽度; 

StringGrid.RowHeights[Index:Longint]:=某一列整列之高度; 

●数据区(CELL)指定： 

将某一行列停在画面之资料区最左上角： 

StringGrid.LeftCol:=某一行号; 

StringGrid.TopRow:=某一列号; 

焦点移至某一格(CELL)内： 

StringGrid.Row:=?; 

StringGrid.Col:=?; 

设定数据行列数：(包含固定行、列亦算在内) 

StringGrid.RowCount:=?; 

StringGrid.ColCount:=?; 

写一字符串至某一格(CELL)内： 

StringGrid.Cells[Col值 , Row值]:=字符串; 

判断鼠标指针目前在哪一格(CELL)范围内： 

在StringGrid之Mouse事件中(UP,DOWN或MOVE)下： 

VAR C , R : Longint; 

Begin 

StringGrid.MouseToCell(X,Y,C,R); {X,Y由MOUSE事件传入} 

{取回 C , R 即为目前之Col , Row值 } 

...... 

●StringGrid之Options属性： 

若要于程序执行中开启或关闭Options某一功能如 ‘goTABS’ 

开: StringGrid.Options:= StringGrid.Options + [goTABS]; 

关: StringGrid.Options:= StringGrid.Options - [goTABS]; 

goFixedHorzLine 固定列间之水平线 

goFixedVertLine 固定行间之垂直线 

goHorzLine 资料格间水平线 

goVertLine 资料格间垂直线 

goRangeSelect 鼠标可多重选择 

goDrawFocusSelected 多重选择时,第一数据项反白 

goRowSizing 鼠标可改变列高 

goColSizing 鼠标可改变行宽 

goRowMoving 鼠标可搬数据列 

goColMoving 鼠标可搬数据行 

goEditing 可编辑(与鼠标可多重选择互斥) 

goAlwaysShowEditor 须有goEditing,不用按F4或ENTER即有等待输入光标 

goTabs 允许TAB及Shift-TAB移动光标 

goRowSelect 用鼠标点一下可选取整列(亦与鼠标可多重选择互斥) 

goThumbTracking 滚动条动时GRID跟着动,否则滚动条动完放开,GRID才动

StringGrid使用全书
StringGrid行列的增加和删除
如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样
StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中
在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中
stringgrid从文本读入的问题
StringGrid组件Cells内容对齐
StringGird的行列背景色设置
怎么改变StringGrid控件某一列的背景和某一列的只读属性
StringGrid控件标题栏的对齐
怎么改变StringGrid控件某一列的背景和某一列的只读属性
StringGrid控件标题栏的对齐
在stringGrid中使用回车键模拟TAB键切换单元格的功能实现
stringgrid如何清空
让记录在StringGrid中分页显示在
打印StringGrid
如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果
让stringgrid点列头进行排序
正确地设置StringGrid列宽而不截断任何一个文字方法
实现StringGrid的删除，插入，排序行操作
TstringGrid 的行列合并研究
StringGrid行列的增加和删除
type
 TExCell = class(TStringGrid)
public
 procedure DeleteRow(ARow: Longint);
 procedure DeleteColumn(ACol: Longint);
 procedure InsertRow(ARow: LongInt);
 procedure InsertColumn(ACol: LongInt);
end;
procedure TExCell.InsertColumn(ACol: Integer);
begin
 ColCount :=ColCount +1;
 MoveColumn(ColCount-1, ACol);
end;
procedure TExCell.InsertRow(ARow: Integer);
begin
 RowCount :=RowCount +1;
 MoveRow(RowCount-1, ARow);
end;
procedure TExCell.DeleteColumn(ACol: Longint);
begin
 MoveColumn(ACol, ColCount -1);
 ColCount := ColCount - 1;
end;
procedure TExCell.DeleteRow(ARow: Longint);
begin
 MoveRow(ARow, RowCount - 1);
 RowCount := RowCount - 1;
end;
 如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样
 unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;
type
 TForm1 = class(TForm)
 grid: TStringGrid;
 procedure FormCreate(Sender: TObject);
 procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
 procedure gridClick(Sender: TObject);
 private
{ Private declarations }
 public
{ Public declarations }
end;
var
 Form1: TForm1;
 fcheck,fnocheck:tbitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
 i:SmallInt;
 bmp:TBitmap;
begin
 FCheck:= TBitmap.Create;
 FNoCheck:= TBitmap.Create;
 bmp:= TBitmap.create;
 try
   bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
   With FNoCheck Do Begin
     width := bmp.width div 4;
     height := bmp.height div 3;
     canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
   End;
 With FCheck Do Begin
   width := bmp.width div 4;
   height := bmp.height div 3;
   canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height ));
 End;
 finally
   bmp.free
 end;
end;
procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
 if not (gdFixed in State) then
   with TStringGrid(Sender).Canvas do
 begin
   brush.Color:=clWindow;
   FillRect(Rect);
   if Grid.Cells[ACol,ARow]='yes' then
     Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FCheck )
   else
     Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FNoCheck );
 end;
end;
procedure TForm1.gridClick(Sender: TObject);
begin
 if grid.Cells[grid.col,grid.row]='yes' then
   grid.Cells[grid.col,grid.row]:='no'
 else
   grid.Cells[grid.col,grid.row]:='yes';
end;
end.

StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中：
 DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);
可以实现文字换行！
在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中,
加入: (所有的列均设成可修改的)
 if Col mod 2 = 0 then
   grd.Options := grd.Options + [goEditing]
 else
   grd.Options := grd.Options - [goEditing];

stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）
// Save a TStringGrid to a file
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
 f: TextFile;
 i, k: Integer;
begin
 AssignFile(f, FileName);
 Rewrite(f);
 with StringGrid do
 begin
   // Write number of Columns/Rows
   Writeln(f, ColCount);
   Writeln(f, RowCount);
   // loop through cells
   for i := 0 to ColCount - 1 do
     for k := 0 to RowCount - 1 do
       Writeln(F, Cells[i, k]);
 end;
 CloseFile(F);
end;
// Load a TStringGrid from a file
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
 f: TextFile;
 iTmp, i, k: Integer;
 strTemp: String;
begin
 AssignFile(f, FileName);
 Reset(f);
 with StringGrid do
 begin
   // Get number of columns
   Readln(f, iTmp);
   ColCount := iTmp;
   // Get number of rows
   Readln(f, iTmp);
   RowCount := iTmp;
   // loop through cells & fill in values
   for i := 0 to ColCount - 1 do
     for k := 0 to RowCount - 1 do
     begin
       Readln(f, strTemp);
       Cells[i, k] := strTemp;
     end;
   end;
 CloseFile(f);
end;
// Save StringGrid1 to 'c:.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
 SaveStringGrid(StringGrid1, 'c:.txt');
end;
// Load StringGrid1 from 'c:.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
 LoadStringGrid(StringGrid1, 'c:.txt');
end;
*******************************************
打开一个已有的文本文件,并将内容放到stringgrid中,文本行与stringgrid行一致;
在文本中遇到空格则放入下一cells.
搞定！注意，我只写了一个空格间隔的，你自己修改一下splitstring可以用多个空格分隔！
procedure TForm1.Button1Click(Sender: TObject);
var
 aa,bb:tstringlist;
 i:integer;
begin
 aa:=tstringlist.Create;
 bb:=tstringlist.Create;
 aa.LoadFromFile('c:.txt');
 for i:=0 to aa.Count-1 do
 begin
   bb:=SplitString(aa.Strings[i],' ');
   stringgrid1.Rows[i]:=bb;
 end;
 aa.Free;
 bb.Free;
end;
其中splitstring为：
function SplitString(const source,ch:string):tstringlist;
var
 temp:string;
 i:integer;
begin
 result:=tstringlist.Create;
 temp:=source;
 i:=pos(ch,source);
 while i<>0 do
 begin
   result.Add(copy(temp,0,i-1));
   delete(temp,1,i);
   i:=pos(ch,temp);
 end;
 result.Add(temp);
end;

StringGrid组件Cells内容对齐
在StringGrid的DrawCell事件中添加类似的代码就可以了：
VAR
 vCol, vRow : LongInt;
begin
 vCol := ACol; vRow := ARow;
 WITH Sender AS TStringGrid, Canvas DO
   IF vCol = 2 THEN BEGIN ///对于第2列设置为右对齐
     SetTextAlign(Handle, TA_RIGHT);
     FillRect(Rect);
     TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);
   END;
end;
当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
 With StringGrid1 do
 begin
   If  (ARow= Krow) and not (acol = 0) then
   begin
      Canvas.Brush.Color :=clYellow;// ClBlue;
      Canvas.FillRect(Rect);
      Canvas.font.color:=ClBlack;
      Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);
   end;
 end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
begin
 krow := Arow;  //*
 kcol := Acol;
end;
注意：必须把变量KROW的值初始为1或其他不为0的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

 怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.
请参考以下代码：
 在OnDrawCell事件中处理背景色。程序如下：
//将第二列背景变为红色。
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit;
 with stringgrid1 do
 begin
   canvas.Brush.color:=clRed;
   canvas.FillRect(Rect);
   canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow])
 end;
end;
//加入如下代码,那么StringGrid的第四列就只读了.其他列非只读
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
 with StringGrid1 do begin
   if ACol = 4 then
     Options := Options - [goEditing]
   else Options := Options + [goEditing];
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
 dx,dy:byte;
begin
 if (acol = 4) and not (arow = 0) then
   with stringgrid1 do
   begin
     canvas.Brush.color := clYellow;
     canvas.FillRect(Rect);
     canvas.font.color := clblue;
     dx:=2;//调整此值，控制字在网格中显示的水平位置
     dy:=2;//调整此值，控制字在网格中显示的垂直位置
     canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);
   end;
//控制标题栏的对齐
 if (arow = 0) then
   with stringgrid1 do
   begin
     canvas.Brush.color := clbtnface;
     canvas.FillRect(Rect);
     dx := 12; //调整此值，控制字在网格中显示的水平位置
     dy := 5; //调整此值，控制字在网格中显示的垂直位置
     canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);
   end;
end;

 2003-11-17 16:37:15    在stringGrid中使用回车键模拟TAB键切换单元格的功能实现......
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
 label
 nexttab;
begin
 if key=#13 then
 begin
   key:=#0;
   nexttab:
   if (stringgrid1.Col<stringgrid1.ColCount-1) then
     begin
       stringgrid1.Col:=stringgrid1.Col+1;
     end
   else
   begin
     if stringgrid1.Row>=stringgrid1.RowCount-1 then
       stringgrid1.RowCount:=stringgrid1.rowCount+1;
     stringgrid1.Row:=stringgrid1.Row+1;
     stringgrid1.Col:=0;
     goto nexttab;
   end;
 end;
end;
.........

stringgrid如何清空
with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;
选中某单元格,然后在该单元格中修改-> 选中某单元格,然后在该单元格中修改
设置属性:
   StringGrid1.Options:=StringGrid1.Options+[goEditing];
让记录在StringGrid中分页显示
在Uses中加入： ADOInt
//首先设定PageSize，取出PageCount
procedure TForm1.Button1Click(Sender: TObject);
begin
 ADoquery1.Recordset.PageSize :=spinedit1.Value;
 Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount);
 ShowData(spinedit2.Value);
end;
//然后将AbsolutePage的数据乾坤大挪移到StringGrid1中
procedure TForm1.ShowData(page:integer);
var
 iRow, iCol, iCount : Integer;
 rs : ADOInt.Recordset;
begin
 ADoquery1.Recordset.AbsolutePage:=Page;
 Currpage:=page;
 iRow := 0;
 iCol := 1;
 stringgrid1.Cells[iCol, iRow] := 'FixedCol1';
 Inc(iCol);
 stringgrid1.Cells[iCol, iRow] := 'FixedCol2';
 Inc(iRow);
 Dec(iCol);
 rs := adoquery1.Recordset;
 for iCount := 1 to SpinEdit1.Value do
 begin
   stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
   Inc(iCol);
   stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
   Inc(iRow);
   Dec(iCol);
   rs.MoveNext;
 end;
//上一页
procedure TForm1.Button2Click(Sender: TObject);
begin
 If (CurrPage)<>1 then
   ShowData(CurrPage-1);
end;
//下一页
procedure TForm1.Button3Click(Sender: TObject);
begin
 If CurrPage<>ADoquery1.Recordset.PageCount then
   ShowData(CurrPage+1);
end;
打印StringGrid的程序源码
这段代码没有看懂，但是可能有的朋友需要，所以共享一下子 ：）
procedure TForm1.SpeedButton11Click(Sender: TObject);
Var
 Index_R ,ALeft: Integer;
 Index : Integer;
begin
 StringGrid_File('D:\AAA.TXT');
 if Not LinkTextFile then
 begin
   ShowMessage('失败');
   Exit;
 end;
 //
 QuickRep1.DataSet := ADOTable1;
 Index_R := ReSize(StringGrid1.Width);
 ALeft := 13;
 Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,
    HeaderControl1.Sections[0].Text,taLeftJustify);
 with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,
        StringGrid1.Font,taLeftJustify) do
 begin
   DataSet := ADOTable1;
   DataField := ADOTable1.Fields[0].DisplayName;
 end;
 ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R;
 For Index := 1 to ADOTable1.FieldCount - 1 do
 begin
   Create_VLine(TitleBand1,ALeft - 13,16,1,40);
   Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,
     HeaderControl1.Sections[Index].Text,taLeftJustify);
   Create_VLine(DetailBand1,ALeft - 13,-1,1,31);
   with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,
        StringGrid1.Font,taLeftJustify) do
   begin
     DataSet := ADOTable1;
     DataField := ADOTable1.Fields[Index].DisplayName;
   end;
   ALeft := ALeft + StringGrid1.ColWidths[Index] *  Index_R + Index_R;
 end;
 QuickRep1.Preview;
end;
function TForm1.ReSize(AGridWidth: Integer): Integer;
begin
 Result := Trunc(718 / AGridWidth);
end;
function TForm1.StringGrid_File(AFileName: String): Boolean;
var
 StrValue : String;
 Index : Integer;
 ACol , ARow : Integer;
 AFileValue : System.TextFile;
begin
 StrValue := '';
 Try
   AssignFile(AFileValue , AFileName);
   ReWrite(AFileValue);
   StrValue := HeaderControl1.Sections[0].Text;
   For Index := 1 to HeaderControl1.Sections.Count - 1 do
     StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;
   Writeln(AFileValue,StrValue);
   StrValue := '';
   For  ARow := 0 To StringGrid1.RowCount - 1 do
   begin
     StrValue := '';
     StrValue := StringGrid1.Cells[0,ARow];
     For ACol := 1 To StringGrid1.ColCount - 1 do
     begin
       StrValue := StrValue + ', ' + StringGrid1.Cells[ACol,ARow];
     end;
     Writeln(AFileValue,StrValue);
   end;
 Finally
   CloseFile(AFileValue);
 end;
end;
function TForm1.LinkTextfile: Boolean;
begin
 Result := False;
 with ADOTable1 do
 begin
   {ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
                       'Data Source= D:\;Extended Properties=Text;' +
                       'Persist Security Info=False';
   TableName := 'AAA#TXT';
   Open;       }
   if Active then
     Result := True;
 end;
end;
function TForm1.Create_QRDBText(Sender: TWinControl; ALeft, ATop, AWidth,
 AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;
var
 AQRDBText : TQRDBText;
begin
 AQRDBText := TQRDBText.Create(Nil);
 with AQRDBText do
 begin
   Parent := Sender;
   Left := ALeft;
   Top := ATop;
   Width := AWidth;
   Height := AHight;
   AlignMent := AAlignMent;
   Font.Assign(AFont);
 end;
 Result := AQRDBText;
end;
function TForm1.Create_VLine(Sender: TWinControl; ALeft, ATop, AWidth,
 AHight: Integer): TQRShape;
var
 AQRShapeV : TQRShape;
begin
 AQRShapeV := TQRShape.Create(Nil);
 with AQRShapeV do
 begin
   Parent := Sender;
   Left := ALeft;
   Top := ATop;
   Width := AWidth;
   Height := AHight;
 end;
 Result := AQRShapeV;
end;
procedure TForm1.Create_Title(Sender: TWinControl; ALeft, ATop, AWidth,
 AHight: Integer; ACaption: String; AAlignMent: TAlignment);
var
 AQRLabel : TQRLabel;
begin
 AQRLabel := TQRLabel.Create(Nil);
 with AQRLabel do
 begin
   Parent := Sender;
   Left := ALeft;
   Top := ATop;
   Width := AWidth;
   AlignMent := AAlignMent;
   Caption := ACaption;
 end;
end;
-----------------------------

如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果？
procedure TForm1.Button1Click(Sender: TObject);
var
Sel : TGridRect;
begin
Sel := StringGrid1.Selection;
DeleteRow(Sel.Top);
end;
// delete row
procedure TForm1.DeleteRow(Row: Integer);
var
i : integer;
begin
if (Row < StringGrid1.RowCount) and (Row > Stringgrid1.FixedRows-1) then
  if Row < StringGrid1.RowCount - 1 then
  begin
    for i := Row to StringGrid1.RowCount-1 do
      StringGrid1.Rows[i] := StringGrid1.Rows[i+1];
    StringGrid1.RowCount := StringGrid1.RowCount - 1;
  end
  else stringGrid1.Rows[Row].Clear;
end;
让stringgrid点列头进行排序
procedure GridQuickSort(Grid: TStringGrid; ACol: Integer; Order: Boolean ; NumOrStr: Boolean);
(******************************************************************************)
(*  函数名称：GridQuickSort                                                   *)
(*  函数功能：给 StringGrid 的 ACol 列快速法排序    _/_/     _/_/  _/_/_/_/_/ *)
(*  参数说明:                                          _/   _/        _/      *)
(*            Order: True 从小到大                       _/          _/       *)
(*                 : False 从大到小                     _/          _/        *)
(*        NumOrStr : true 值的类型是Integer          _/_/        _/_/         *)
(*                 : False 值的类型是String                                   *)
(*  函数说明：对于日期，时间等类型数据均可按字符方式排序，                    *)
(*                                                                            *)
(*                                                                            *)
(*                                             Author: YuJie  2001-05-27      *)
(*                                             Email : yujie_bj@china.com     *)
(******************************************************************************)
procedure MoveStringGridData(Grid: TStringGrid; Sou,Des :Integer );
var
  TmpStrList: TStringList ;
  K : Integer ;
begin
  try
    TmpStrList :=TStringList.Create() ;
    TmpStrList.Clear ;
    for K := Grid.FixedCols to Grid.ColCount -1 do
      TmpStrList.Add(Grid.Cells[K,Sou]) ;
    Grid.Rows [Sou] := Grid.Rows [Des] ;
    for K := Grid.FixedCols to Grid.ColCount -1 do
      Grid.Cells [K,Des]:= TmpStrList.Strings[K] ;
  finally
    TmpStrList.Free ;
  end;
end;
procedure QuickSort(Grid: TStringGrid; iLo, iHi: Integer);
var
  Lo, Hi : Integer;
  Mid: String ;
begin
  Lo := iLo ;
  Hi := iHi ;
  Mid := Grid.Cells[ACol,(Lo + Hi) div 2];
  repeat
    if Order and not NumOrStr then //按正序、字符排
    begin
      while Grid.Cells[ACol,Lo] < Mid do Inc(Lo);
      while Grid.Cells[ACol,Hi] > Mid do Dec(Hi);
    end ;
    if not Order and not NumOrStr then //按反序、字符排
    begin
      while Grid.Cells[ACol,Lo] > Mid do Inc(Lo);
      while Grid.Cells[ACol,Hi] < Mid do Dec(Hi);
    end;
    if NumOrStr then
    begin
      if Grid.Cells[ACol,Lo] = '' then Grid.Cells[ACol,Lo] := '0' ;
      if Grid.Cells[ACol,Hi] = '' then Grid.Cells[ACol,Hi] := '0' ;
      if Mid = '' then Mid := '0' ;
      if Order then
      begin //按正序、数字排
        while StrToFloat(Grid.Cells[ACol,Lo]) < StrToFloat(Mid) do Inc(Lo);
        while StrToFloat(Grid.Cells[ACol,Hi]) > StrToFloat(Mid) do Dec(Hi);
      end else
      begin //按反序、数字排
        while StrToFloat(Grid.Cells[ACol,Lo]) > StrToFloat(Mid) do Inc(Lo);
        while StrToFloat(Grid.Cells[ACol,Hi]) < StrToFloat(Mid) do Dec(Hi);
      end;
    end ;
    if Lo <= Hi then
    begin
      MoveStringGridData(Grid, Lo, Hi) ;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then QuickSort(Grid, iLo, Hi);
  if Lo < iHi then QuickSort(Grid, Lo, iHi);
end;
begin
try
  QuickSort(Grid, Grid.FixedRows, Grid.RowCount - 1 ) ;
except
on E: Exception do
  Application.MessageBox(Pchar('系统在排序数据的时候遇到异常:'#13+E.message+#13'请重试，如果该问题依然存在请与程序供应商联系！'),'系统错误',MB_OK+MB_ICONERROR) ;
end;
end;
procedure StringGridTitleDown(Sender: TObject;
Button: TMouseButton;  X, Y: Integer);
(******************************************************************************)
(*  函数名称：StringGridTitleDown                                             *)
(*  函数功能：取鼠标点StringGrid 的列                _/_/     _/_/  _/_/_/_/_/ *)
(*  参数说明:                                          _/   _/        _/      *)
(*            Sender                                     _/          _/       *)
(*                                                      _/          _/        *)
(*                                                   _/_/        _/_/         *)
(*                                                                            *)
(*                                                                            *)
(*                                             Author: YuJie  2001-05-27      *)
(*                                             Email : yujie_bj@china.com     *)
(******************************************************************************)
var
I: Integer ;
begin
if (Y > 0 ) and (y < TStringGrid(Sender).DefaultRowHeight * TStringGrid(Sender).FixedRows ) then
begin
  if  Button = mbLeft then
  begin
    I := X div  TStringGrid(Sender).DefaultColWidth ;
    //这个i 就是要排序得行了
    // 下面调用上面的排序函数就可以了，
    GridQuickSort(TStringGrid(Sender), I, False, True) ;
  end;
end;
end;
   用上面的两个函数就能解决你的问题了。在TStringGrid 的MouseDown事件中调用StringGridTitleDown 函数就可以。你可能要修改一下StringGridTitleDown函数来修改排序得方式及其字符类型。
   提醒你一下对于日期、时间、布尔等类型数据均可按字符方式排序。
例如：
procedure TForm_Main.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
StringGridTitleDown(Sender,Button,X,Y);
end;
正确地设置StringGrid列宽而不截断任何一个文字方法
是在对StringGrid填充完文本串后调用SetOptimalGridCellWidth过程。
 -----------程序片断-------------------------------------------------
 (*
 $Header$
 Module Name : General\BSGrids.pas
 Main Program : Several.
 Description : StringGrid support functions.
 03/21/2000 enhanced by William Sorensen
 *)
 unit BSGrids;
 interface
 uses
   Grids;
 type
   TExcludeColumns = set of 0..255;
   procedure SetOptimalGridCellWidth(sg: TStringGrid;
   ExcludeColumns: TExcludeColumns);
   // Sets column widths of a StringGrid to avoid truncation of text.
   // Fill grid with desired text strings first.
   // If a column contains no text, DefaultColWidth will be used.
   // Pass [] for ExcludeColumns to process all columns, including Fixed.
   // Columns whose numbers (0-based) are specified in ExcludeColumns will not
   // have their widths adjusted.
 implementation
 uses
   Math; // we need the Max function
   procedure SetOptimalGridCellWidth(sg: TStringGrid;
   ExcludeColumns: TExcludeColumns);
 var
   i : Integer;
   j : Integer;
   max_width : Integer;
 begin
   with sg do
   begin
     // If the grid's Paint method hasn't been called yet,
     // the grid's canvas won't use the right font for TextWidth.
     // (TCustomGrid.Paint normally sets this, under DrawCells.)
     Canvas.Font.Assign(Font);
     for i := 0 to (ColCount - 1) do
     begin
       if i in ExcludeColumns then
         Continue;
       max_width := 0;
       // Search for the maximal Text width of the current column.
       for j := 0 to (RowCount - 1) do
         max_width := Math.Max(max_width,Canvas.TextWidth(Cells[i,j]));
       // The hardcode of 4 is based on twice the offset from the left
       // margin in TStringGrid.DrawCell. GridLineWidth is not relevant.
       if max_width > 0 then
         ColWidths[i] := max_width + 4
       else
         ColWidths[i] := DefaultColWidth;
     end; { for }
   end;
 end;
 end.
实现StringGrid的删除，插入，排序行操作（基本操作啦）
//实现删除操作
 Procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer);
 Var Column: Integer;
 begin
   If DelColumn <= StrGrid.ColCount then
   Begin
     For Column := DelColumn To StrGrid.ColCount-1 do
       StrGrid.Cols[Column-1].Assign(StrGrid.Cols[Column]);
     StrGrid.ColCount := StrGrid.ColCount-1;
   End;
 end;
//实现添加插入操作
 Procedure GridAddColumn(StrGrid: TStringGrid; NewColumn: Integer);
 Var Column: Integer;
 begin
   StrGrid.ColCount := StrGrid.ColCount+1;
   For Column := StrGrid.ColCount-1 downto NewColumn do
     StrGrid.Cols[Column].Assign(StrGrid.Cols[Column-1]);
   StrGrid.Cols[NewColumn-1].Text := '';
 end;
//实现排序操作
 Procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer);
 Var Line, PosActual: Integer;
     Row: TStrings;
 begin
   Renglon := TStringList.Create;
   For Line := 1 to StrGrid.RowCount-1 do
   Begin
     PosActual := Line;
     Row.Assign(TStringlist(StrGrid.Rows[PosActual]));
     While True do
     Begin
       If (PosActual = 0) Or (StrToInt(Row.Strings[NoColumn-1]) >= StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then
       Break;
       StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1];
       Dec(PosActual);
     End;
     If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then
       StrGrid.Rows[PosActual] := Row;
   End;
   Renglon.Free;
 end;

TstringGrid 的行列合并研究
unit Unit1;
//建立一工程，
//粘贴本单元代码即可看 STringGrid 行列合并效果
//但发现非固定行非固定列的合并效果不好
interface
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 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// 以下 StringGrid 为固定行，固定列的合并所必须进行的处理
// 非固定行，非固定列的合并效果不好
var
sg:TStringGrid;
procedure TForm1.FormCreate(Sender: TObject);
var
i,j:integer ;
begin
Sg:=TStringGrid.Create(self);
with SG do
begin
 parent:=self;
 align:=alclient;
 DefaultDrawing:=false;
 FixedColor:=clYellow;
 RowCount:=30;
 ColCount:=20;
 FixedCols:=1;
 FixedRows:=1;
 GridLineWidth:=0;
 Options:=Options+[goEditing]-[goVertLine,goHorzLine,goRangeSelect];
 OnDrawCell:=SGDrawCell;
 OnTopLeftChanged:=SGTopLeftChanged;
 Canvas.Font.name:='宋体';
 Canvas.Font.Size:=10;
 for i:=0 to colCount-1 do
 for j:=0 to RowCount-1 do
   cells[i,j]:=Format('%d行%d列',[j,i]);
 for i:=0 to colCount-1 do
   cells[i,0]:=Format('第%d列',[i]);
 for i:=0 to RowCount-1 do
   cells[0,i]:=Format('第%d行',[i]);
 Cells[0,0]:='   左上角';
 Cells[1,0]:='AA这是列合并BB';
 Cells[0,1]:='A这是行'#10'合并BB';
 Cells[1,1]:='1111111';
 Cells[1,2]:='1111222';
 Cells[2,1]:='2222111';
 Cells[2,2]:='2222222';
end;
end;
//重载 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 (Arow<d.FixedRows) or (ACol<d.Fixedcols) then
begin
 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.