StringGrid行列的增加和删除

来源:互联网 发布:arm-linux-gcc官网 编辑:程序博客网 时间:2024/06/03 05:08
导读:

  新一篇: 朝鲜中国论 | 旧一篇: 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.csdn.net/cureSHY/archive/2004/11/11/177502.aspx
原创粉丝点击
热门问题 老师的惩罚 人脸识别 我在镇武司摸鱼那些年 重生之率土为王 我在大康的咸鱼生活 盘龙之生命进化 天生仙种 凡人之先天五行 春回大明朝 姑娘不必设防,我是瞎子 支付宝没有学历怎么办 华为p9gps信号弱怎么办 小米手机wifi慢怎么办 小米wifi网速慢怎么办 华为mate9网络差怎么办 大王卡信号差怎么办 华为P9Plus忘记密码怎么办 华为手机音质差怎么办 三星c5手机发烫怎么办 华为手机老卡怎么办 小米手机慢卡怎么办 华为指纹识别不灵敏了怎么办 金立手机信号不好怎么办 手机边框坏了怎么办 手机保护膜划了怎么办 车膜贴的有气泡怎么办 手机膜进气泡怎么办 贴的手机膜翘角怎么办 全屏膜出现气泡怎么办 手机膜的气泡怎么办 透明手机壳气泡怎么办 钢化膜边缘有气泡怎么办 贴钢化膜边缘有气泡怎么办 钢化膜边上有泡泡怎么办 贴钢化膜周边有气泡怎么办 钢化膜里面有气泡怎么办 手机保护膜破了怎么办 手机触摸屏没反应怎么办 苹果手机触屏坏了怎么办 手机边缘有气泡怎么办 手机膜有空气怎么办 电脑膜有气泡怎么办 汽车贴膜起泡怎么办 汽车玻璃膜用久了起泡怎么办 车窗玻璃膜起泡怎么办 新车贴膜气泡怎么办 贴手机钢化膜有灰尘怎么办 戒指砖石掉了怎么办 寄手机没有包装怎么办 手机背面有划痕怎么办 oopo手机声音小怎么办