目录：

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.

最后修改：2015 年 05 月 20 日
© 允许规范转载
一分也是爱