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                                     _/          _/       *)
(*                                                      _/          _/        *)
(*