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;//注意这里要引用

var

Form1: TForm1;

implementation

{$R *.DFM}

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]);

d.Canvas.brush.color:=d.color;

d.canvas.Font.color:=$ff0000;

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.

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[N].Select;

XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);

//Zellen als String Formatieren

XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),

RefToCell(SheetRowCount, SheetColCount)].Select;

XLApp.Selection.NumberFormat :=

‘@’

;

XLApp.Workbooks[M].Worksheets[N].Range[‘A1’].Select;

//Daten dem Excelsheet übergeben

Sheet := XLApp.Workbooks[M].WorkSheets[N];

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″>’);

使用示例：

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;

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[n], i]) + DEFBORDER;

if temp > max then

max := temp;

end; { For }

if max > 0 then

ColWidths[Columns[n]] := 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;

原文链接：https://blog.csdn.net/formiss/article/details/1628367

你可能也喜欢