使用StringGrid的步骤

KeyLife富翁笔记
作者: archonwang
标题: StringGrid使用全书
关键字: StringGrid
分类: 开发经验
密级: 公开
(评分:★★★★ , 回复: 11, 阅读: 9839) »»
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;

2003-11-17 16:21:00 查看评语»»»

2003-11-17 16:22:50 如何编写使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.

2003-11-17 16:23:23 StringGrid组件Cells内容分行显示
在Tstringgrid.ondrawcell事件中：

DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);

可以实现文字换行！

2003-11-17 16:24:04 在StringGrid怎样制作只读的列
在 OnSelectCell事件处理程序中,加入: (所有的列均设成可修改的)

if Col mod 2 = 0 then
grd.Options := grd.Options + [goEditing]
else
grd.Options := grd.Options - [goEditing];

2003-11-17 16:25:07 stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）
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;

2003-11-17 16:28:41 当我将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的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

2003-11-17 16:32:44 怎么改变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;
.........

2003-11-17 16:42:17 stringgrid如何清空
with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;

2003-11-17 16:44:00 选中某单元格,然后在该单元格中修改
-> 选中某单元格,然后在该单元格中修改

设置属性:
StringGrid1.Options:=StringGrid1.Options+[goEditing];

2003-11-17 16:46:14 让记录在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;

2003-11-17 16:48:51 打印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;
-----------------------------

2003-11-17 17:00:09 如何实现在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;

2003-11-17 17:10:56 让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;

2003-11-19 9:16:01 正确地设置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.

2003-11-19 9:22:09 实现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;

2003-11-20 11:28:56 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.

2003-11-24 9:42:21 TstringGrid 的行列合并研究【这段代码来自wangxian11】
正好在帖子上看到了，功能能够实现。（wangxian11大哥可真是厉害～～）可惜的是，效果还不是很好，如果将来有更好的希望大家提供吧。

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.

2003-11-28 11:58:31 删除选定行【来自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;

2003-11-28 11:59:58 保存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,'<Title>' + Title + '</Title>');
WriteLn(Txt,'<TABLE WIDTH=100% border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111">');

for i := 0 to StringGrid.RowCount - 1 do
begin
WriteLn(Txt,'<TR>');
for ii := 0 to StringGrid.ColCount - 1 do
begin
Value := StringGrid.Cells[ii,i];
if Value = '' then Value := '&nbsp;';
if (ii < StringGrid.FixedCols) or (i < StringGrid.FixedRows) then
BgColor := StringGrid.FixedColor
else
BgColor := StringGrid.Color;
WriteLn(Txt,'<TD BGCOLOR="#' + GetColor(BgColor) + '"><font color="#' +
GetColor(StringGrid.Font.Color) + '">' + Value + '</font></TD>')
end;
WriteLn(Txt,'</TR>');
end;
WriteLn(Txt,'</TABLE>');
CloseFile(Txt);
end;

使用示例：
SaveToHtml(StringGrid1,'c:/1.html','标题');

2003-11-28 17:19:35 高速排序函数（在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<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.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<colcount) and (w<=x) do
begin
inc(c);
w:=w+colwidths[c]+gridlinewidth;
end;
sortgrid(Grid,c,0);
end;

end;

2003-11-28 17:21:51 将TStringGrid的3D界面改成Flat样式【来自wyb_star】
将TStringGrid的3D界面改成Flat样式
修改grids中TCustomGrid的paint函数
主要是下面两句
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
具体的说明可以查msdn
修改如下：
DrawEdge(Canvas.Handle, Ctl3DRect, BDR_RAISEDINNER, BF_FLAT);
DrawEdge(Canvas.Handle, Ctl3DRect, BDR_RAISEDINNER, BF_FLAT);

2003-12-1 17:34:36 如何在写表格时改变STRINGGRID.cells[i,j]的颜色【dcsdcs编写】
我是通过继承下来，修改的
procedure WMPaint(var Message: TWMPaint); message wm_Paint;

procedure TdcsStringGrid.WMPaint(var Message: TWMPaint);
var
rt:TRect;
tmpc:DWORD;
begin
PaintHandler(Message);
if not(focused) then
begin
tmpc:=Canvas.font.Color;
rt:=CellRect(selection.Left,selection.Top);
canvas.Lock;
canvas.FillRect(rt);
Canvas.font.Color:=font.Color;
Canvas.TextRect(rt,rt.Left+2,rt.top+2,Cells[selection.Left,selection.Top]);
//canvas.TextOut(rt.Left+2,rt.top+2,Cells[selection.Left,selection.Top]);
Canvas.font.Color:=tmpc;
canvas.UnLock;
end;
end;