StringGrid使用教程(Delphi)

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 := ' ';
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;

2006-8-29 15:05:38
发表评语»»»

2007-3-25 16:23:42 stringgrid中加入combobox控件.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ComboBox1: TComboBox;
procedure ComboBox1Exit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
private
{ Private declarations }
Procedure CMDialogKey( Var msg: TCMDialogKey );message CM_DIALOGKEY;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
If Activecontrol = Combobox1 Then Begin
If msg.CharCode = VK_TAB Then Begin
// set focus back to the grid and pass the tab key to it
stringgrid1.setfocus;
stringgrid1.perform( WM_KEYDOWN, msg.charcode, msg.keydata );
// swallow this message
msg.result := 1;
Exit;
End;
End;
inherited;
end;

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
with sender as TCombobox do begin
hide;
if itemindex >= 0 then
with stringgrid1 do
cells[col,row] := items[itemindex];
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
combobox1.visible := false;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
R: TRect;
org: TPoint;
begin
With Sender As TStringgrid Do
If (ACol = 2) and (ARow >= FixedRows) Then Begin
// entered the column associated to the combobox
// get grid out of selection mode
perform( WM_CANCELMODE, 0, 0 );
// position the control on top of the cell
R := CellRect( Acol, Arow );
org:= Self.ScreenToClient( ClientToScreen( R.topleft ));
With combobox1 do begin
setbounds( org.X, org.Y, r.right-r.left, height );
itemindex := Items.IndexOf( Cells[ acol, arow ] );
Show;
BringTofront;
// focus the combobox and drop down the list
SetFocus;
DroppedDown := true;
end;
End;
end;

end.

2007-3-28 14:16:54 stringgrid 保存到excel
1. With OLE Automation }

uses
ComObj;

function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:/MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;

{**************************************************************}
{2. Without OLE }

procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;

function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;

// Example:

procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveAsExcelFile(StringGrid1, 'c:/MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;

{**************************************************************}
{3. Code by Reinhard Schatzl }

uses
ComObj;

// Hilfsfunktion für StringGridToExcelSheet
// Helper function for StringGridToExcelSheet
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;

if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);

if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);

if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;

// StringGrid Inhalt in Excel exportieren
// Export StringGrid contents to Excel
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName: string;
begin
//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then
BookCount := BookCount - 1;

//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = False then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufügen
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256 then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536 then
SheetRowCount := Grid.RowCount
else
SheetRowCount := 65536;

//Sheets befüllen
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I + 256 * (N - 1)) <= Grid.ColCount) and
((J + 65536 * (M - 1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
//-------------------------
XLApp.Worksheets
.Select;
XLApp.Workbooks[M].Worksheets
.Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets
.Range[RefToCell(1, 1),
RefToCell(SheetRowCount, SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets
.Range['A1'].Select;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets
;
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value :=
Data;
end;
end;
//Save Excel Worksheet
try
for M := 1 to BookCount do
begin
SaveFileName := Copy(FileName, 1,Pos('.', FileName) - 1) + IntToStr(M) +
Copy(FileName, Pos('.', FileName),
Length(FileName) - Pos('.', FileName) + 1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error ?
end;
finally
//Excel Beenden
if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;

//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
//StringGrid inhalt in Excel exportieren
//Grid : stringGrid, SheetName : stringgrid Print, Pfad : c:/Test/ExcelFile.xls, Excelsheet anzeigen
StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:/Test/ExcelFile.xls', True);
end;

StringGrid使用全书之补充版
关键字:
分类: 个人专区
密级: 公开
(评分: , 回复: 0, 阅读: 81) »»
删除选定行
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 10:01:00
发表评语»»»

2003-11-28 10:56:22 保存StringGrid到html文件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 := ' ';
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 13:51:20 高速排序函数（在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 13:58:36 将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 11:09:34 行列的移动发现archonwang已经做了插入列、插入行，删除列和删除行的工作，但没有写移动列和移动行的工作，这这里就画蛇添足给补上了！呵呵
type
TExCell = class(TStringGrid)
public
procedure MoveColumn(FromIndex, ToIndex: Longint);
procedure MoveRow(FromIndex, ToIndex: Longint);
end;

procedure TExCell.MoveColumn(FromIndex, ToIndex: Integer);
begin
inherited;
end;

procedure TExCell.MoveRow(FromIndex, ToIndex: Integer);
begin
inherited;
end;

示例：
procedure TForm1.Button1Click(Sender: TObject);
begin
TExCell(StringGrid1).MoveColumn(1, 3);
end

2003-12-1 11:40:47 打印TStringGridtype
TrecPrintStrGrid = Record
PrCanvas : TCanvas; //Printer or PaintBox Canvas
sGrid: TStringGrid; //StringGrid containing data
sTitle: String; //Title of document
bPrintFlag : Boolean; //Print if True
ptXYOffset : TPoint; //Left and Top margins
ftTitleFont : TFont; //Font for Title
ftHeadingFont : TFont; //Font for Heading row
ftDataFont : TFont; //Font for Data
bBorderFlag : Boolean //Print border if True
end;

var
recPrintStrGrid : TrecPrintStrGrid;

procedure PrintGrid(ArecPrintStrGrid : TrecPrintStrGrid);
var
iX1, iX2, iY1, iY2, iY3, iTmp , iLoop, iWd : Integer;
trTextRect : TRect;

begin
iWd := 0;
with ArecPrintStrGrid, PrCanvas do
begin
//Calculate Total Width of String Grid
Font := ftHeadingFont;
for iLoop := 0 to sGrid.ColCount-1 do
begin
if (TextWidth(sGrid.Cells[iLoop, 0])+5) < sGrid.ColWidths[iLoop] then
iWd := iWd + sGrid.ColWidths[iLoop]
else
iWd := iWd + TextWidth(sGrid.Cells[iLoop, 0])+5;
end; // for sGrid.ColCount

//Initialize Printer
if bPrintFlag then
begin
Printer.Title := sTitle;
Printer.BeginDoc;
end;

//Output Title
Pen.Color := clBlack;
Font := ftTitleFont;
TextOut(((iWd Div 2) - (TextWidth(sTitle) Div 2)), ptXYOffset.Y, sTitle);

//Output Column Data
for iLoop := 0 to sGrid.ColCount-1 do
begin
Font := ftHeadingFont;
iX1 := ptXYOffset.X;
for iTmp := 0 to (iLoop-1) do
if (TextWidth(sGrid.Cells[iTmp, 0])+5) < (sGrid.ColWidths[iTmp]) then
iX1 := iX1 + (sGrid.ColWidths[iTmp])
else
iX1 := iX1 + TextWidth(sGrid.Cells[iTmp, 0])+5;

iY1 := ptXYOffset.Y + ((TextHeight('Ag')+5) * 2);
iX2 := ptXYOffset.X;
for iTmp := 0 to iLoop do
if (TextWidth(sGrid.Cells[iTmp, 0])+5) < (sGrid.ColWidths[iTmp]) then
iX2 := iX2 + (sGrid.ColWidths[iTmp])
else
iX2 := iX2 + TextWidth(sGrid.Cells[iTmp, 0])+5;

iY2 := iY1 + TextHeight('Ag');
trTextRect := Rect(iX1, iY1, iX2, iY2);
TextRect(trTextRect, trTextRect.Left+5, trTextRect.Top+3, sGrid.Cells[iLoop, 0]);
Brush.Color := clWhite;
if bBorderFlag then FrameRect(trTextRect);
Brush.Style := bsClear;

//Output Row Data
Font := ftDataFont;
iY1 := iY2;
iY3 := TextHeight('Ag')+5;
for iTmp := 1 to sGrid.RowCount-1 do
begin
iY2 := iY1 + iY3;
trTextRect := Rect(iX1, iY1, iX2, iY2);
TextRect(trTextRect, trTextRect.Left+5, trTextRect.Top+3, sGrid.Cells[iLoop, iTmp]);
Brush.Color := clBlack;
if bBorderFlag then FrameRect(trTextRect);
Brush.Style := bsClear;
iY1 := iY1 + iY3;
end; // for sGrid.RowCount-1 do
end; // for sGrid.ColCount-1
if bPrintFlag then Printer.EndDoc;
end; // with ArecPrintStrGrid, prCanvas
end; { PrintGrid }

示例：
procedure TForm1.buPrintClick(Sender: TObject);
begin
with recPrintStrGrid do
begin
PrCanvas := pbPreview.Canvas;
sGrid := stgData;
sTitle := 'Print of String Grid';
bPrintFlag := False;
ptXYOffset.X := 10;
ptXYOffset.Y := 100;
ftTitleFont := TFont.Create;
with ftTitleFont do
begin
Name := 'Arial';
Style := [fsBold, fsItalic, fsUnderLine];
Size := 14;
end;
ftHeadingFont := TFont.Create;
with ftHeadingFont do
begin
Name := 'Arial';
Style := [fsBold];
Size := 12;
end;
ftDataFont := TFont.Create;
with ftDataFont do
begin
Name := 'Arial';
Style := [];
Size := 10;
end;
bBorderFlag := True;
end; //with recPrintStrGrid do
PrintGrid(recPrintStrGrid);
end;

2003-12-1 11:46:14 导出TStringGrid到Word表格var
WordApp, NewDoc, WordTable: OLEVariant;
iRows, iCols, iGridRows, jGridCols: Integer;
begin
try
WordApp := CreateOleObject('Word.Application');
except
Exit;
end;

WordApp.Visible := True;

NewDoc := WordApp.Documents.Add;

iCols := StringGrid1.ColCount;
iRows := StringGrid1.RowCount;

WordTable := NewDoc.Tables.Add(WordApp.Selection.Range, iCols, iRows);

for iGridRows := 1 to iRows do
for jGridCols := 1 to iCols do
WordTable.Cell(iGridRows, jGridCols).Range.Text :=
StringGrid1.Cells[jGridCols - 1, iGridRows - 1];

WordApp := Unassigned;
NewDoc := Unassigned;
WordTable := Unassigned;
end;

2003-12-1 11:54:12 导入Excel文件到TStringGrid中function ExcelToStringGrid(AGrid: TStringGrid;const FileName: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(FileName);
Sheet := XLApp.Workbooks[ExtractFileName(FileName)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;
AGrid.RowCount := x;
AGrid.ColCount := y;
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
RangeMatrix := Unassigned;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;

2003-12-1 11:56:22 复制、粘贴TStringGrid内容到剪切版uses
Clipbrd;

//Copy
procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
GRect: TGridRect;
C, R: Integer;
begin
GRect := StringGrid1.Selection;
S := '';
for R := GRect.Top to GRect.Bottom do
begin
for C := GRect.Left to GRect.Right do
begin
if C = GRect.Right then S := S + (StringGrid1.Cells[C, R])
else
S := S + StringGrid1.Cells[C, R] + #9;
end;
S := S + #13#10;
end;
ClipBoard.AsText := S;
end;

// Paste
procedure TForm1.Button2Click(Sender: TObject);
var
Grect: TGridRect;
S, CS, F: string;
L, R, C: Byte;
begin
GRect := StringGrid1.Selection;
L := GRect.Left;
R := GRect.Top;
S := ClipBoard.AsText;
R := R - 1;
while Pos(#13, S) > 0 do
begin
R := R + 1;
C := L - 1;
CS := Copy(S, 1,Pos(#13, S));
while Pos(#9, CS) > 0 do
begin
C := C + 1;
if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then
StringGrid1.Cells[C, R] := Copy(CS, 1,Pos(#9, CS) - 1);
F := Copy(CS, 1,Pos(#9, CS) - 1);
Delete(CS, 1,Pos(#9, CS));
end;
if (C <= StringGrid1.ColCount - 1) and (R <= StringGrid1.RowCount - 1) then
StringGrid1.Cells[C + 1,R] := Copy(CS, 1,Pos(#13, CS) - 1);
Delete(S, 1,Pos(#13, S));
if Copy(S, 1,1) = #10 then
Delete(S, 1,1);
end;
end;

2003-12-1 11:59:08 将TStringGrid中的文本旋转90度type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
end;

implementation

procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;
Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);
var
lf: TLogFont;
tf: TFont;
begin
if (Size > Grid.ColWidths[ACol] div 2) then
Size := Grid.ColWidths[ACol] div 2;
with Grid.Canvas do
begin
Font.Name := Schriftart;
Font.Size := Size;
Font.Color := Color;
tf := TFont.Create;
try
tf.Assign(Font);
GetObject(tf.Handle, SizeOf(lf), @lf);
lf.lfEscapement := 900;
lf.lfOrientation := 0;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
finally
tf.Free;
end;
FillRect(Rect);
if Alignment = taLeftJustify then
TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
if Alignment = taCenter then
TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +
Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);
if Alignment = taRightJustify then
TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -
2,Grid.Cells[ACol, ARow]);
end;
end;

procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;
Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);
var
NewFont, OldFont : Integer;
FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;
begin
If (Size > Grid.ColWidths[ACol] DIV 2) Then
Size := Grid.ColWidths[ACol] DIV 2;
with Grid.Canvas do
begin
If (fsBold IN Font.Style) Then
FontStyle := FW_BOLD
Else
FontStyle := FW_NORMAL;

If (fsItalic IN Font.Style) Then
FontItalic := 1
Else
FontItalic := 0;

If (fsUnderline IN Font.Style) Then
FontUnderline := 1
Else
FontUnderline := 0;

If (fsStrikeOut IN Font.Style) Then
FontStrikeout:=1
Else
FontStrikeout:=0;

Font.Color := Color;

NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,
FontUnderline, FontStrikeout, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH, PChar(Schriftart));

OldFont := SelectObject(Handle, NewFont);
FillRect(Rect);
If Alignment = taLeftJustify Then
TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taCenter Then
TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,
Rect.Bottom-2,Grid.Cells[ACol,ARow]);
If Alignment = taRightJustify Then
TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

SelectObject(Handle, OldFont);
DeleteObject(NewFont);
end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if ACol = 1 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',
12,clRed, taLeftJustify);
if ACol = 2 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

if ACol > 2 then
StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,
taRightJustify);
end;

end.

2003-12-1 12:01:35 synchronize the Scrolling of two TStringgridsunit SyncStringGrid;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Grids;

type
TSyncKind = (skBoth, skVScroll, skHScroll);
TSyncStringGrid = class(TStringGrid)
private
FInSync: Boolean;
FsyncGrid: TSyncStringGrid;
FSyncKind: TSyncKind;
{ Private declarations }
procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;
procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;
protected
{ Protected declarations }
public
{ Public declarations }
procedure DoSync(Msg, wParam: Integer; lParam: Longint); virtual;
published
{ Published declarations }
property SyncGrid: TSyncStringGrid read FSyncGrid write FSyncGrid;
property SyncKind: TSyncKind read FSyncKind write FSyncKind default skBoth;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TSyncStringGrid]);
end;

procedure TSyncStringGrid.WMVScroll(var Msg: TMessage);
begin
if not FInSync and
Assigned(FSyncGrid) and
(FSyncKind in [skBoth, skVScroll]) then
FSyncGrid.DoSync(WM_VSCROLL, Msg.wParam, Msg.lParam);
inherited;
end;

procedure TSyncStringGrid.WMHScroll(var Msg: TMessage);
begin
if not FInSync and
Assigned(FSyncGrid) and
(FSyncKind in [skBoth, skHScroll]) then
FSyncGrid.DoSync(WM_HSCROLL, Msg.wParam, Msg.lParam);
inherited;
end;

procedure TSyncStringGrid.DoSync(Msg, wParam: Integer; lParam: Longint);
begin
FInSync := True;
Perform(Msg, wParam, lParam);
FinSync := False;
end;

end.

{****************************************}
{2.}

private
OldGridProc1, OldGridProc2: TWndMethod;
procedure Grid1WindowProc(var Message: TMessage);
procedure Grid2WindowProc(var Message: TMessage);
public

{...}

procedure TForm1.Grid1WindowProc(var Message: TMessage);
begin
OldGridProc1(Message);
if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or
Message.msg = WM_Mousewheel)) then
begin
OldGridProc2(Message);
end;
end;

procedure TForm1.Grid2WindowProc(var Message: TMessage);
begin
OldGridProc2(Message);
if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or
(Message.msg = WM_Mousewheel)) then
begin
OldGridProc1(Message);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
OldGridProc1 := StringGrid1.WindowProc;
OldGridProc2 := StringGrid2.WindowProc;
StringGrid1.WindowProc := Grid1WindowProc;
StringGrid2.WindowProc := Grid2WindowProc;
end;

2003-12-1 12:04:58 从Word文件中导入内容到TStringGrid中procedure WordToExcel(StringGrid:TStringGrid;const FileName:string);
var
MSWord, Table: OLEVariant;
iRows, iCols, iGridRows, jGridCols, iNumTables, iTableChosen: Integer;
CellText: string;
InputString: string;
begin
try
MSWord := CreateOleObject('Word.Application');
except
Exit;
end;

try
MSWord.Visible := False;
MSWord.Documents.Open(FileName);
iNumTables := MSWord.ActiveDocument.Tables.Count;
InputString := InputBox(IntToStr(iNumTables) +
' Tables in Word Document', 'Please Enter Table Number', '1');
iTableChosen := StrToInt(InputString);
Table := MSWord.ActiveDocument.Tables.Item(iTableChosen);
iCols := Table.Rows.Count;
iRows := Table.Columns.Count;
StringGrid.RowCount := iCols;
StringGrid.ColCount := iRows + 1;
for iGridRows := 1 to iRows do
for jGridCols := 1 to iCols do
begin
CellText := Table.Cell(jGridCols, iGridRows).Range.FormattedText;
if not VarisEmpty(CellText) then
begin
CellText := StringReplace(CellText,
#$D, '', [rfReplaceAll]);
CellText := StringReplace(CellText, #$7, '', [rfReplaceAll]);
Stringgrid.Cells[iGridRows, jGridCols] := CellText;
end;
end;
finally
MSWord.Quit;
end;
end;

2003-12-1 12:32:32 第二种打印uses
printers;

//StringGrid Inhalt ausdrucken
procedure PrintStringGrid(Grid: TStringGrid; Title: string;
Orientation: TPrinterOrientation);
var
P, I, J, YPos, XPos, HorzSize, VertSize: Integer;
AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer;
mmx, mmy: Extended;
Footer: string;
begin
//Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
HeaderSize := 100;
FooterSize := 200;
ZeilenSize := 36;
FontHeight := 36;
//Printer initializieren
Printer.Orientation := Orientation;
Printer.Title := Title;
Printer.BeginDoc;
//Druck auf mm einstellen
mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;

VertSize := Trunc(mmy) * 10;
HorzSize := Trunc(mmx) * 10;
SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

//Zeilenanzahl festlegen
Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize;
//Seitenanzahl ermitteln
if Grid.RowCount mod Zeilen <> 0 then
AnzSeiten := Grid.RowCount div Zeilen + 1
else
AnzSeiten := Grid.RowCount div Zeilen;

Seite := 1;
//Grid Drucken
for P := 1 to AnzSeiten do
begin
//Kopfzeile
Printer.Canvas.Font.Height := 48;
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Title) div 2)),
- 20,Title);
Printer.Canvas.Pen.Width := 5;
Printer.Canvas.MoveTo(0, - HeaderSize);
Printer.Canvas.LineTo(HorzSize, - HeaderSize);
//Fußzeile
Printer.Canvas.MoveTo(0, - VertSize + FooterSize);
Printer.Canvas.LineTo(HorzSize, - VertSize + FooterSize);
Printer.Canvas.Font.Height := 36;
Footer := 'Seite: ' + IntToStr(Seite) + ' von ' + IntToStr(AnzSeiten);
Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Footer) div 2)),
- VertSize + 150,Footer);
//Zeilen drucken
Printer.Canvas.Font.Height := FontHeight;
YPos := HeaderSize + 10;
for I := 1 to Zeilen do
begin
if Grid.RowCount >= I + (Seite - 1) * Zeilen then
begin
XPos := 0;
for J := 0 to Grid.ColCount - 1 do
begin
Printer.Canvas.TextOut(XPos, - YPos,
Grid.Cells[J, I + (Seite - 1) * Zeilen - 1]);
XPos := XPos + Grid.ColWidths[J] * 3;
end;
YPos := YPos + ZeilenSize;
end;
end;
//Seite hinzufügen
Inc(Seite);
if Seite <= AnzSeiten then Printer.NewPage;
end;
Printer.EndDoc;
end;

//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
//Drucken im Querformat
PrintStringGrid(Grid, 'StringGrid Print Landscape', poLandscape);
//Drucken im Hochformat
PrintStringGrid(Grid, 'StringGrid Print Portrait', poPortrait);
end;

2003-12-1 12:43:27 清空TStringGrid的所有单元格//第一种法
procedure TForm1.Button1Click(Sender: TObject);
var
i, k: Integer;
begin
with StringGrid1 do
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
Cells[i, k] := '';
end;

//第二种方法(这个快一些)
procedure TForm1.Button2Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to StringGrid1.RowCount - 1 do
StringGrid1.Rows[I].Clear();
end;

2003-12-1 12:47:02 把StringGrid内容保存到Excel文件(OLE方式)function StringGridToExcel(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;

function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;

begin
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,AGrid.ColCount)].Value := Data;
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
end;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;

2003-12-1 12:52:13 把StringGrid内容保存到Excel文件(文件流方式)procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;

function StringGridToExcel(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;

2003-12-1 12:53:25 更改单元格默认选择颜色！procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
const
SelectedColor = Clblue;
begin
if (state = [gdSelected]) then
with TStringGrid(Sender), Canvas do
begin
Brush.Color := SelectedColor;
FillRect(Rect);
TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]);
end;
end;

2003-12-1 13:09:26 从一个表格文本文件中读取数据到TStringGrid中//FileName:文件名称 FieldSeparator：分隔符
procedure ReadTabFile(FileName: TFileName; FieldSeparator: Char; AGrid: TStringGrid);
var
i: Integer;
S: string;
T: string;
Colonne, ligne: Integer;
Les_Strings: TStringList;
CountCols: Integer;
CountLines: Integer;
TabPos: Integer;
StartPos: Integer;
InitialCol: Integer;
begin
Les_Strings := TStringList.Create;
try
// Load the file, Datei laden
Les_Strings.LoadFromFile(FileName);

// Get the number of rows, Anzahl der Zeilen ermitteln
CountLines := Les_Strings.Count + AGrid.FixedRows;

// Get the number of columns, Anzahl der Spalten ermitteln
T := Les_Strings[0];
for i := 0 to Length(T) - 1 do Inc(CountCols, Ord(IsDelimiter(FieldSeparator, T, i)));
Inc(CountCols, 1 + AGrid.FixedCols);

// Adjust Grid dimensions, Anpassung der Grid-Größe
if CountLines > AGrid.RowCount then AGrid.RowCount := CountLines;
if CountCols > AGrid.ColCount then AGrid.ColCount := CountCols;

// Initialisierung
InitialCol := AGrid.FixedCols - 1;
Ligne := AGrid.FixedRows - 1;

// Iterate through all rows of the table
// Schleife durch allen Zeilen der Tabelle
for i := 0 to Les_Strings.Count - 1 do
begin
Colonne := InitialCol;
Inc(Ligne);
StartPos := 1;
S := Les_Strings[i];
TabPos := Pos(FieldSeparator, S);
repeat
Inc(Colonne);
AGrid.Cells[Colonne, Ligne] := Copy(S, StartPos, TabPos - 1);
S := Copy(S, TabPos + 1, 999);
TabPos := Pos(FieldSeparator, S);
until TabPos = 0;
end;
finally
Les_Strings.Free;
end;
end;

//示例
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
ReadTabFile('C:/TEST.TXT', #9, StringGrid1);
Screen.Cursor := crDefault;
end;

2003-12-1 13:12:00 删除一列另一种实现！type
TStringGridHack = class(TStringGrid)
public
procedure DeleteCol(ACol: Longint);
end;
implementation

procedure TStringGridHack.DeleteCol(ACol: Longint);
begin
if ACol = FixedCols then if ACol = (ColCount - 1) then
begin
Cols[ACol].Clear;
if ColCount(FixedCols + 1) then ColCount := (ColCount - 1);
end
else
begin
Cols[ACol] := Cols[ACol + 1];
DeleteCol(ACol + 1);
end;
end;

2003-12-1 13:15:26 查看TStringGrid的scrollbars是否可见！if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then
ShowMessage('Vertical scrollbar 可见!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then
ShowMessage('Horizontal scrollbar 可见!'

2003-12-1 13:19:50 implement the OnColumnClick Event from TListview for a TStringGrid? {
There are two routines to implement the OnColumnClick Methods for a TStringGrid.
Set the first row as fixed and the Defaultdrawing to True.

Mit folgenden zwei Routinen kann man in einem TStringgrid
die Methode OnColumnClick eines TListView erzeugen (visuell).
Reihe 0 muß fixiert sein undDefaultDrawing = True
}

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
zelle: TRect; // cell
acol, arow: Integer;
public
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Text: string;
begin
with stringgrid1 do
begin
MouseRoCell(x, y, acol, arow);
if (arow = 0) and (button = mbleft) then
case acol of
0..2:
begin
// Draws a 3D Effect (Push)
// Zeichnet 3D-Effekt (Push)
zelle := CellRect(acol, arow);
Text := Cells[acol, arow];
Canvas.Font := Font;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(zelle);
Canvas.TextRect(zelle, zelle.Left + 2, zelle.Top + 2, Text);
DrawEdge(Canvas.Handle, zelle, 10, 2 or 4 or 8);
DrawEdge(Canvas.Handle, zelle, 2 or 4, 1);
end;
end;
end;
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Text: string;
begin
with StringGrid1 do
begin
// Draws a 3D-Effect (Up)
// Zeichnet 3D-Effekt (Up)
Text := Cells[acol, arow];
if arow = 0 then
begin
Canvas.Font := Font;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(zelle);
Canvas.TextRect(zelle, zelle.Left + 2, zelle.Top + 2, Text);
DrawEdge(Canvas.Handle, zelle, 4, 4 or 8);
DrawEdge(Canvas.Handle, zelle, 4, 1 or 2);
MouseToCell(zelle.Left, zelle.Top, acol, arow);
end;
end;
if (arow = 0) and (Button = mbleft) then
case acol of
0..2:
begin
// Code to be executed...
// Programmcode der ausgeführt werden soll
ShowMessage('Column ' + IntToStr(acol));
zelle := stringgrid1.CellRect(1, 1);
end;
end;
end;

end.

2003-12-1 13:20:29 autosize a StringGrid-Column to fit its content? {1.}

procedure SetGridColumnWidths(Grid: TStringGrid;
const Columns: array of Integer);
{
When you double-Click on a Column-Header the Column
autosizes to fit its content

Bei Doppelklick auf eine fixierte Spalte passt sich
die Spaltenbreite der Textgrösse an
}

procedure AutoSizeGridColumn(Grid: TStringGrid; column, min, max: Integer);
{ Set for max and min some minimal/maximial Values}
{ Bei max and min kann eine Minimal- resp. Maximalbreite angegeben werden}
var
i: Integer;
temp: Integer;
tempmax: Integer;
begin
tempmax := 0;
for i := 0 to (Grid.RowCount - 1) do
begin
temp := Grid.Canvas.TextWidth(Grid.cells[column, i]);
if temp > tempmax then tempmax := temp;
if tempmax > max then
begin
tempmax := max;
break;
end;
end;
if tempmax < min then tempmax := min;
Grid.ColWidths[column] := tempmax + Grid.GridLineWidth + 3;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
P: TPoint;
iColumn, iRow: Longint;
begin
GetCursorPos(P);
with StringGrid1 do
begin
P := ScreenToClient(P);
MouseToCell(P.X, P.Y, iColumn, iRow);
if P.Y < DefaultRowHeight then
AutoSizeGridColumn(StringGrid1, iColumn, 40, 100);
end;
end;

{************************************************}

{2.}

procedure TForm1.Button1Click(Sender: TObject);
{ by P. Below }
const
DEFBORDER = 8;
var
max, temp, i, n: Integer;
begin
with Grid do
begin
Canvas.Font := Font;
for n := Low(Columns) to High(Columns) do
begin
max := 0;
for i := 0 to RowCount - 1 do
begin
temp := Canvas.TextWidth(Cells[Columns
, i]) + DEFBORDER;
if temp > max then
max := temp;
end; { For }
if max > 0 then
ColWidths[Columns
] := max;
end; { For }
end; { With }
end; {SetGridColumnWidths }

2003-12-1 13:21:16 export a TStringGrid to a TListView? procedure StringGrid2ListView(StringGrid: TStringGrid; Listview: TListView);
var
i, j, k: Integer;
ListItem: TListItem;
begin
ListView.Items.BeginUpdate;
try
with StringGrid, ListView do
begin
for j := 1 to ColCount - 1 do
Columns.Add;
for j := 1 to RowCount - 1 do
begin
{Get Item of First Column}
ListItem := Listview.Items.Add;
ListItem.Caption := Cells[1, j];
for k := 1 to ColCount - 1 do
ListItem.Subitems.Add(Cells[k + 1, j]);
end;
end;
finally
ListView.Items.EndUpdate;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
// Clear the ListView if necessary
// Falls nötig, zuerst die ListView löschen
with ListView1 do
begin
Items.BeginUpdate;
try
ViewStyle := vsReport;
Items.Clear;
for i := Columns.Count - 1 downto 0 do
listView_DeleteColumn(Handle, i);
finally
Items.EndUpdate;
end;
end;
// Copy StringGrid1 to ListView1
StringGrid2ListView(StringGrid1, ListView1);
end;

2003-12-1 13:22:00 export a TListView to a TStringGrid? procedure ListView2StringGrid(Listview: TListView; StringGrid: TStringGrid);
const
MAX_SUBITEMS = 5;
var
i, j: Integer;
begin
with ListView do
for i := 0 to Items.Count - 1 do
begin
{Get Item of First Column}
StringGrid.Cells[1, i + 1] := Items[i].Caption;
{loop through SubItems}
for j := 0 to MAX_SUBITEMS do
begin
if Items[i].SubItems.Count > j then
StringGrid.Cells[j + 2, i + 1] := Items[i].SubItems.Strings[j]
else
break;
end;
end;
end;

//example
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
// Clear the StringGrid if necessary
// Falls nötig, zuerst das StringGrid löschen
i := 0;
while i < StringGrid1.RowCount do
begin
StringGrid1.Rows[i].Clear;
Inc(i);
end;
// Copy ListView1 to StringGrid1
ListView2StringGrid(ListView1, StringGrid1);
end;

2003-12-1 13:23:02 resize the columns of a TStringGrid / TDrawGrid to fit the text?{ This will resize the columns of a TStringGrid / TDrawGrid (text
only!) so the text is completely visble. To save some time,
it uses the first 10 rows only, but that should be easy to fix,
if you need more. }

// we need this to access protected methods
type
TGridHack = class(TCustomGrid);

procedure ResizeStringGrid(_Grid: TCustomGrid);
var
Col, Row: integer;
Grid: TGridHack;
MaxWidth: integer;
ColWidth: integer;
ColText: string;
MaxRow: integer;
ColWidths: array of integer;
begin
Grid := TGridHack(_Grid);
SetLength(ColWidths, Grid.ColCount);
MaxRow := 10;
if MaxRow > Grid.RowCount then
MaxRow := Grid.RowCount;
for Col := 0 to Grid.ColCount - 1 do
begin
MaxWidth := 0;
for Row := 0 to MaxRow - 1 do
begin
ColText := Grid.GetEditText(Col, Row);
ColWidth := Grid.Canvas.TextWidth(ColText);
if ColWidth > MaxWidth then
MaxWidth := ColWidth;
end;
if goVertLine in Grid.Options then
Inc(MaxWidth, Grid.GridLineWidth);
ColWidths[Col] := MaxWidth + 4;
Grid.ColWidths[Col] := ColWidths[Col];
end;
end;

2003-12-1 13:25:32 get the content of a TStringgrid/ TDrawGrid as a string? { we need this Cracker Class because the Col/RowCount property
is not public in TCustomGrid }
type
TGridHack = class(TCustomGrid);

function GetstringGridText(_Grid: TCustomGrid): string;
var
Grid: TGridHack;
Row, Col: Integer;
s: string;
begin
// Cast the paramter to a TGridHack, so we can access protected properties
Grid := TGridHack(_Grid);
Result := '';
// for all rows, then for all columns
for Row := 0 to Grid.RowCount - 1 do
begin
for Col := 0 to Grid.ColCount - 1 do
begin
// the first column does not need the tab
if Col > 0 then
Result := Result + #9;
Result := Result + Grid.GetEditText(Col, Row);
end;
Result := Result + #13#10;
end;
end;

2003-12-1 13:27:09 Sort a TStringGrid by Columns? type
TMoveSG = class(TCustomGrid); // reveals protected MoveRow procedure

{...}

procedure SortGridByCols(Grid: TStringGrid; ColOrder: array of Integer);
var
i, j: Integer;
Sorted: Boolean;

function Sort(Row1, Row2: Integer): Integer;
var
C: Integer;
begin
C := 0;
Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1], Grid.Cols[ColOrder[C]][Row2]);
if Result = 0 then
begin
Inc(C);
while (C <= High(ColOrder)) and (Result = 0) do
begin
Result := AnsiCompareStr(Grid.Cols[ColOrder[C]][Row1],
Grid.Cols[ColOrder[C]][Row2]);
Inc(C);
end;
end;
end;

begin
if SizeOf(ColOrder) div SizeOf(i) <> Grid.ColCount then Exit;

for i := 0 to High(ColOrder) do
if (ColOrder[i] < 0) or (ColOrder[i] >= Grid.ColCount) then Exit;

j := 0;
Sorted := False;
repeat
Inc(j);
with Grid do
for i := 0 to RowCount - 2 do
if Sort(i, i + 1) > 0 then
begin
TMoveSG(Grid).MoveRow(i + 1, i);
Sorted := False;
end;
until Sorted or (j = 1000);
Grid.Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{ Sort rows based on the contents of two or more columns.
Sorts first by column 1. If there are duplicate values
in column 1, the next sort column is column 2 and so on...}
SortGridByCols(StringGrid1, [1, 2, 0, 3, 4]);
end;

2003-12-1 13:33:13 make Return like Tabulator in a Stringgrid? procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
with StringGrid1 do
if Col then {next column}
Col := Col + 1
else if Row then
begin {next Row}
Row := Row + 1;
Col := 1;
end
else
begin {End of Grid- Go to Top again}
Row := 1;
Col := 1;
end;
end;

2003-12-1 13:34:31 align Cells in StringGrid? procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);

procedure WriteText(StringGrid: TStringGrid; ACanvas: TCanvas; const ARect: TRect;
const Text: string; Format: Word);
const
DX = 2;
DY = 2;
var
S: array[0..255] of Char;
B, R: TRect;
begin
with Stringgrid, ACanvas, ARect do
begin
case Format of
DT_LEFT: ExtTextOut(Handle, Left + DX, Top + DY,
ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text), Length(Text), nil);

DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
Length(Text), nil);

DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2,
Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
StrPCopy(S, Text), Length(Text), nil);
end;
end;
end;

procedure Display(StringGrid: TStringGrid; const S: string; Alignment: TAlignment);
const
Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
WriteText(StringGrid, StringGrid.Canvas, Rect, S, Formats[Alignment]);
end;
begin
// Right-justify columns 0-2
// Spalten 0-2 rechts ausrichten.
if ACol in [0..2] then
Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taRightJustify)

// Center the first row
// Erste zeile zentrieren
if ARow = 0 then
Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taCenter)
end;

2003-12-1 13:35:26 use a Combobox as a Custom InPlace Editor in StringGrid?type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox1Exit(Sender: TObject);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
with Combobox1 do
begin
StringGrid1.DefaultRowHeight := Height;
Visible := False;
Items.Add('Item1');
Items.Add('Item2');
Text := 'Select an item';
end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=
ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=
ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
R: TRect;
begin
if (ACol = 1) and (ARow <> 0) then
begin
R := StringGrid1.CellRect(ACol, ARow);
R.Left := R.Left + StringGrid1.Left;
R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;
R.Bottom := R.Bottom + StringGrid1.Top;
with Combobox1 do
begin
Left := R.Left + 1;
Top := R.Top + 1;
Width := (R.Right + 1) - R.Left;
Height := (R.Bottom + 1) - R.Top;
Visible := True;
SetFocus;
end;
end;
CanSelect := True;
end;

2003-12-1 13:36:19 position the caret in a Stringgrid? {
The following code allows you to position the caret
in a cell (InplaceEditor) of a StringGrid.
We need a Cracker class to access the InplaceEditor.

Mit folgendem Code kann man den Cursor in einer Zelle
(InplaceEditor) eines StringGrids positionieren.
Hierfür brauchen wir eine "Cracker" Klasse, weil der
InplaceEditor "protected" ist.
}

type
TGridCracker = class(TStringGrid);

{...}

implementation

{...}

procedure SetCaretPosition(Grid: TStringGrid; col, row, x_pos: Integer);
begin
Grid.Col := Col;
Grid.Row := Row;
with TGridCracker(Grid) do
InplaceEditor.SelStart := x_pos;
end;

// Get the Caret position from the focussed cell
// Ermittelt die Caret-Position der aktuellen Zelle
function GetCaretPosition(Grid: TStringGrid): Integer;
begin
with TGridCracker(Grid) do
Result := InplaceEditor.SelStart;
end;

// Example / Beispiel:

// Set the focus on col 1, row 3 and position the caret at position 5
// Fokusiert die Zelle(1,3) und setzt den Cursor auf Position 5

procedure TForm1.Button1Click(Sender: TObject);
begin
StringGrid1.SetFocus;
SetCaretPosition(StringGrid1, 1, 3, 5);
end;

2003-12-1 13:37:24 check if a Stringgrid cell is selected? function IsCellSelected(StringGrid: TStringGrid; X, Y: Longint): Boolean;
begin
Result := False;
try
if (X >= StringGrid.Selection.Left) and (X <= StringGrid.Selection.Right) and
(Y >= StringGrid.Selection.Top) and (Y <= StringGrid.Selection.Bottom) then
Result := True;
except
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsCellSelected(stringgrid1, 2, 2) then
ShowMessage('Cell (2,2) is selected.');
end;