收集的stringgrid的技巧

 stringgrid

作者:jxp  日期:2005-12-30

StringGrid行列的增加和删除
如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样
StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中
在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中
stringgrid从文本读入的问题
StringGrid组件Cells内容对齐
StringGird的行列背景色设置
怎么改变StringGrid控件某一列的背景和某一列的只读属性
StringGrid控件标题栏的对齐
怎么改变StringGrid控件某一列的背景和某一列的只读属性
StringGrid控件标题栏的对齐
在stringGrid中使用回车键模拟TAB键切换单元格的功能实现
stringgrid如何清空
让记录在StringGrid中分页显示在
打印StringGrid
如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果
让stringgrid点列头进行排序
正确地设置StringGrid列宽而不截断任何一个文字方法
实现StringGrid的删除，插入，排序行操作
TstringGrid 的行列合并研究



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.  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.