StringGrid行列的增加和删除

导读：

　　新一篇: 朝鲜中国论 | 旧一篇: DELPHI中的拖动开发（2）

　　 StringGrid行列的增加和删除

　　 type

　　 TExCell = class(TStringGrid)

　　 public

　　 procedure DeleteRow(ARow: Longint);

　　 procedure DeleteColumn(ACol: Longint);

　　 procedure InsertRow(ARow: LongInt);

　　 procedure InsertColumn(ACol: LongInt);

　　 end;

　　 procedure TExCell.InsertColumn(ACol: Integer);

　　 begin

　　 ColCount :=ColCount +1;

　　 MoveColumn(ColCount-1, ACol);

　　 end;

　　 procedure TExCell.InsertRow(ARow: Integer);

　　 begin

　　 RowCount :=RowCount +1;

　　 MoveRow(RowCount-1, ARow);

　　 end;

　　 procedure TExCell.DeleteColumn(ACol: Longint);

　　 begin

　　 MoveColumn(ACol, ColCount -1);

　　 ColCount := ColCount - 1;

　　 end;

　　 procedure TExCell.DeleteRow(ARow: Longint);

　　 begin

　　 MoveRow(ARow, RowCount - 1);

　　 RowCount := RowCount - 1;

　　 end;

　　 如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样

　　 unit Unit1;

　　 interface

　　 uses

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

　　 type

　　 TForm1 = class(TForm)

　　 grid: TStringGrid;

　　 procedure FormCreate(Sender: TObject);

　　 procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;

　　 Rect: TRect; State: TGridDrawState);

　　 procedure gridClick(Sender: TObject);

　　 private

　　 { Private declarations }

　　 public

　　 { Public declarations }

　　 end;

　　 var

　　 Form1: TForm1;

　　 fcheck,fnocheck:tbitmap;

　　 implementation

　　 {$R *.DFM}

　　 procedure TForm1.FormCreate(Sender: TObject);

　　 var

　　 i:SmallInt;

　　 bmp:TBitmap;

　　 begin

　　 FCheck:= TBitmap.Create;

　　 FNoCheck:= TBitmap.Create;

　　 bmp:= TBitmap.create;

　　 try

　　 bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));

　　 With FNoCheck Do Begin

　　 width := bmp.width div 4;

　　 height := bmp.height div 3;

　　 canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );

　　 End;

　　 With FCheck Do Begin

　　 width := bmp.width div 4;

　　 height := bmp.height div 3;

　　 canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height ));

　　 End;

　　 finally

　　 bmp.free

　　 end;

　　 end;

　　 procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

　　 begin

　　 if not (gdFixed in State) then

　　 with TStringGrid(Sender).Canvas do

　　 begin

　　 brush.Color:=clWindow;

　　 FillRect(Rect);

　　 if Grid.Cells[ACol,ARow]='yes' then

　　 Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FCheck )

　　 else

　　 Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FNoCheck );

　　 end;

　　 end;

　　 procedure TForm1.gridClick(Sender: TObject);

　　 begin

　　 if grid.Cells[grid.col,grid.row]='yes' then

　　 grid.Cells[grid.col,grid.row]:='no'

　　 else

　　 grid.Cells[grid.col,grid.row]:='yes';

　　 end;

　　 end.

　　 StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中

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

　　 可以实现文字换行！

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

　　if Col mod 2 = 0 then

　　grd.Options := grd.Options + [goEditing]

　　else

　　grd.Options := grd.Options - [goEditing];

　　 stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）stringgrid从文本读入的问题

　　// Save a TStringGrid to a file

　　procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);

　　var

　　f: TextFile;

　　i, k: Integer;

　　begin

　　AssignFile(f, FileName);

　　Rewrite(f);

　　with StringGrid do

　　begin

　　// Write number of Columns/Rows

　　Writeln(f, ColCount);

　　Writeln(f, RowCount);

　　// loop through cells

　　for i := 0 to ColCount - 1 do

　　for k := 0 to RowCount - 1 do

　　Writeln(F, Cells[i, k]);

　　end;

　　CloseFile(F);

　　end;

　　// Load a TStringGrid from a file

　　procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);

　　var

　　f: TextFile;

　　iTmp, i, k: Integer;

　　strTemp: String;

　　begin

　　AssignFile(f, FileName);

　　Reset(f);

　　with StringGrid do

　　begin

　　// Get number of columns

　　Readln(f, iTmp);

　　ColCount := iTmp;

　　// Get number of rows

　　Readln(f, iTmp);

　　RowCount := iTmp;

　　// loop through cells &fill in values

　　for i := 0 to ColCount - 1 do

　　for k := 0 to RowCount - 1 do

　　begin

　　Readln(f, strTemp);

　　Cells[i, k] := strTemp;

　　end;

　　end;

　　CloseFile(f);

　　end;

　　// Save StringGrid1 to 'c:.txt':

　　procedure TForm1.Button1Click(Sender: TObject);

　　begin

　　SaveStringGrid(StringGrid1, 'c:.txt');

　　end;

　　// Load StringGrid1 from 'c:.txt':

　　procedure TForm1.Button2Click(Sender: TObject);

　　begin

　　LoadStringGrid(StringGrid1, 'c:.txt');

　　end;

　　*******************************************

　　打开一个已有的文本文件,并将内容放到stringgrid中,文本行与stringgrid行一致;

　　在文本中遇到空格则放入下一cells.

　　搞定！注意，我只写了一个空格间隔的，你自己修改一下splitstring可以用多个空格分隔！

　　procedure TForm1.Button1Click(Sender: TObject);

　　var

　　aa,bb:tstringlist;

　　i:integer;

　　begin

　　aa:=tstringlist.Create;

　　bb:=tstringlist.Create;

　　aa.LoadFromFile('c:.txt');

　　for i:=0 to aa.Count-1 do

　　begin

　　bb:=SplitString(aa.Strings[i],' ');

　　stringgrid1.Rows[i]:=bb;

　　end;

　　aa.Free;

　　bb.Free;

　　end;

　　其中splitstring为：

　　function SplitString(const source,ch:string):tstringlist;

　　var

　　temp:string;

　　i:integer;

　　begin

　　result:=tstringlist.Create;

　　temp:=source;

　　i:=pos(ch,source);

　　while i<>0 do

　　begin

　　result.Add(copy(temp,0,i-1));

　　delete(temp,1,i);

　　i:=pos(ch,temp);

　　end;

　　result.Add(temp);

　　end;

　　StringGrid组件Cells内容对齐

　　在StringGrid的DrawCell事件中添加类似的代码就可以了：

　　VAR

　　vCol, vRow : LongInt;

　　begin

　　vCol := ACol; vRow := ARow;

　　WITH Sender AS TStringGrid, Canvas DO

　　IF vCol = 2 THEN BEGIN ///对于第2列设置为右对齐

　　SetTextAlign(Handle, TA_RIGHT);

　　FillRect(Rect);

　　TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);

　　END;

　　end;

　　 当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？

　　 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

　　 Rect: TRect; State: TGridDrawState);

　　 begin

　　 With StringGrid1 do

　　 begin

　　 If　(ARow= Krow) and not (acol = 0) then

　　 begin

　　 Canvas.Brush.Color :=clYellow;// ClBlue;

　　 Canvas.FillRect(Rect);

　　 Canvas.font.color:=ClBlack;

　　 Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);

　　 end;

　　 end;

　　 end;

　　 procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

　　 ARow: Integer; var CanSelect: Boolean);

　　 begin

　　 krow := Arow;　//*

　　 kcol := Acol;

　　 end;　

　　 注意：必须把变量KROW的值初始为1或其他不为0的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

　　 怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.

　　 请参考以下代码：

　　 在OnDrawCell事件中处理背景色。程序如下：

　　 //将第二列背景变为红色。

　　 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

　　 Rect: TRect; State: TGridDrawState);

　　 begin

　　 if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit;

　　 with stringgrid1 do

　　 begin

　　 canvas.Brush.color:=clRed;

　　 canvas.FillRect(Rect);

　　 canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow])

　　 end;

　　 end;

　　 //加入如下代码,那么StringGrid的第四列就只读了.其他列非只读

　　 procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);

　　 begin

　　 with StringGrid1 do begin

　　 if ACol = 4 then

　　 Options := Options - [goEditing]

　　 else Options := Options + [goEditing];

　　 end;

　　 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

　　 var

　　 dx,dy:byte;

　　 begin

　　 if (acol = 4) and not (arow = 0) then

　　 with stringgrid1 do

　　 begin

　　 canvas.Brush.color := clYellow;

　　 canvas.FillRect(Rect);

　　 canvas.font.color := clblue;

　　 dx:=2;//调整此值，控制字在网格中显示的水平位置

　　 dy:=2;//调整此值，控制字在网格中显示的垂直位置

　　 canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);

　　 end;

　　 //控制标题栏的对齐

　　 if (arow = 0) then

　　 with stringgrid1 do

　　 begin

　　 canvas.Brush.color := clbtnface;

　　 canvas.FillRect(Rect);

　　 dx := 12; //调整此值，控制字在网格中显示的水平位置

　　 dy := 5; //调整此值，控制字在网格中显示的垂直位置

　　 canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);

　　 end;

　　 end;　

　　 在stringGrid中使用回车键模拟TAB键切换单元格的功能实现......procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

　　 label

　　 nexttab;

　　 begin

　　 if key=#13 then

　　 begin

　　 key:=#0;

　　 nexttab:

　　 if (stringgrid1.Col 　　 begin

　　 stringgrid1.Col:=stringgrid1.Col+1;

　　 end

　　 else

　　 begin

　　 if stringgrid1.Row>=stringgrid1.RowCount-1 then

　　 stringgrid1.RowCount:=stringgrid1.rowCount+1;

　　 stringgrid1.Row:=stringgrid1.Row+1;

　　 stringgrid1.Col:=0;

　　 goto nexttab;

　　 end;

　　 end;

　　 end;

　　 .........　

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

　　 选中某单元格,然后在该单元格中修改-> 选中某单元格,然后在该单元格中修改设置属性:

　　 StringGrid1.Options:=StringGrid1.Options+[goEditing];

　　 让记录在StringGrid中分页显示在Uses中加入： ADOInt

　　 //首先设定PageSize，取出PageCount

　　 procedure TForm1.Button1Click(Sender: TObject);

　　 begin

　　 ADoquery1.Recordset.PageSize :=spinedit1.Value;

　　 Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount);

　　 ShowData(spinedit2.Value);

　　 end;

　　 //然后将AbsolutePage的数据乾坤大挪移到StringGrid1中

　　 procedure TForm1.ShowData(page:integer);

　　 var

　　 iRow, iCol, iCount : Integer;

　　 rs : ADOInt.Recordset;

　　 begin

　　 ADoquery1.Recordset.AbsolutePage:=Page;

　　 Currpage:=page;　

　　 iRow := 0;

　　 iCol := 1;

　　 stringgrid1.Cells[iCol, iRow] := 'FixedCol1';

　　 Inc(iCol);

　　 stringgrid1.Cells[iCol, iRow] := 'FixedCol2';

　　 Inc(iRow);

　　 Dec(iCol);

　　 rs := adoquery1.Recordset;

　　 for iCount := 1 to SpinEdit1.Value do

　　 begin

　　 stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;

　　 Inc(iCol);

　　 stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;

　　 Inc(iRow);

　　 Dec(iCol);

　　 rs.MoveNext;

　　 end;

　　

　　 //上一页

　　 procedure TForm1.Button2Click(Sender: TObject);

　　 begin

　　 If (CurrPage)<>1 then

　　 ShowData(CurrPage-1);

　　 end;

　　 //下一页

　　 procedure TForm1.Button3Click(Sender: TObject);

　　 begin

　　 If CurrPage<>ADoquery1.Recordset.PageCount then

　　 ShowData(CurrPage+1);

　　 end;

　　 打印StringGrid的程序源码这段代码没有看懂，但是可能有的朋友需要，所以共享一下子 ：）

　　 procedure TForm1.SpeedButton11Click(Sender: TObject);

　　 Var

　　 Index_R ,ALeft: Integer;

　　 Index : Integer;

　　 begin

　　 StringGrid_File('D:/AAA.TXT');

　　 if Not LinkTextFile then

　　 begin

　　 ShowMessage('失败');

　　 Exit;

　　 end;

　　 //

　　 QuickRep1.DataSet := ADOTable1;

　　 Index_R := ReSize(StringGrid1.Width);

　　 ALeft := 13;

　　 Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,

　　 HeaderControl1.Sections[0].Text,taLeftJustify);

　　 with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,

　　 StringGrid1.Font,taLeftJustify) do

　　 begin

　　 DataSet := ADOTable1;

　　 DataField := ADOTable1.Fields[0].DisplayName;

　　 end;

　　 ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R;

　　 For Index := 1 to ADOTable1.FieldCount - 1 do

　　 begin

　　 Create_VLine(TitleBand1,ALeft - 13,16,1,40);

　　 Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,

　　 HeaderControl1.Sections[Index].Text,taLeftJustify);

　　 Create_VLine(DetailBand1,ALeft - 13,-1,1,31);

　　 with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,

　　 StringGrid1.Font,taLeftJustify) do

　　 begin

　　 DataSet := ADOTable1;

　　 DataField := ADOTable1.Fields[Index].DisplayName;

　　 end;

　　 ALeft := ALeft + StringGrid1.ColWidths[Index] *　Index_R + Index_R;

　　 end;

　　 QuickRep1.Preview;

　　 end;

　　 function TForm1.ReSize(AGridWidth: Integer): Integer;

　　 begin

　　 Result := Trunc(718 / AGridWidth);

　　 end;

　　 function TForm1.StringGrid_File(AFileName: String): Boolean;

　　 var

　　 StrValue : String;

　　 Index : Integer;

　　 ACol , ARow : Integer;

　　 AFileValue : System.TextFile;

　　 begin

　　 StrValue := ';

　　 Try

　　 AssignFile(AFileValue , AFileName);

　　 ReWrite(AFileValue);

　　 StrValue := HeaderControl1.Sections[0].Text;

　　 For Index := 1 to HeaderControl1.Sections.Count - 1 do

　　 StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;

　　 Writeln(AFileValue,StrValue);

　　 StrValue := ';

　　 For　ARow := 0 To StringGrid1.RowCount - 1 do

　　 begin

　　 StrValue := ';

　　 StrValue := StringGrid1.Cells[0,ARow];

　　 For ACol := 1 To StringGrid1.ColCount - 1 do

　　 begin

　　 StrValue := StrValue + ', ' + StringGrid1.Cells[ACol,ARow];

　　 end;

　　 Writeln(AFileValue,StrValue);

　　 end;

　　 Finally

　　 CloseFile(AFileValue);

　　 end;

　　 end;

　　 function TForm1.LinkTextfile: Boolean;

　　 begin

　　 Result := False;

　　 with ADOTable1 do

　　 begin

　　 {ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +

　　 'Data Source= D:/;Extended Properties=Text;' +

　　 'Persist Security Info=False';

　　 TableName := 'AAA#TXT';

　　 Open;　　　 }

　　 if Active then

　　 Result := True;

　　 end;

　　 end;

　　 function TForm1.Create_QRDBText(Sender: TWinControl; ALeft, ATop, AWidth,

　　 AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;

　　 var

　　 AQRDBText : TQRDBText;

　　 begin

　　 AQRDBText := TQRDBText.Create(Nil);

　　 with AQRDBText do

　　 begin

　　 Parent := Sender;

　　 Left := ALeft;

　　 Top := ATop;

　　 Width := AWidth;

　　 Height := AHight;

　　 AlignMent := AAlignMent;

　　 Font.Assign(AFont);

　　 end;

　　 Result := AQRDBText;

　　 end;

　　 function TForm1.Create_VLine(Sender: TWinControl; ALeft, ATop, AWidth,

　　 AHight: Integer): TQRShape;

　　 var

　　 AQRShapeV : TQRShape;

　　 begin

　　 AQRShapeV := TQRShape.Create(Nil);

　　 with AQRShapeV do

　　 begin

　　 Parent := Sender;

　　 Left := ALeft;

　　 Top := ATop;

　　 Width := AWidth;

　　 Height := AHight;

　　 end;

　　 Result := AQRShapeV;

　　 end;

　　 procedure TForm1.Create_Title(Sender: TWinControl; ALeft, ATop, AWidth,

　　 AHight: Integer; ACaption: String; AAlignMent: TAlignment);

　　 var

　　 AQRLabel : TQRLabel;

　　 begin

　　 AQRLabel := TQRLabel.Create(Nil);

　　 with AQRLabel do

　　 begin

　　 Parent := Sender;

　　 Left := ALeft;

　　 Top := ATop;

　　 Width := AWidth;

　　 AlignMent := AAlignMent;

　　 Caption := ACaption;

　　 end;

　　 end;



本文转自

http://blog.youkuaiyun.com/cureSHY/archive/2004/11/11/177502.aspx