• 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. 
    
    
    
    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<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;
    .........  
    
    
    
    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;
  • 相关阅读:
    shell进行mysql统计
    java I/O总结
    Hbase源码分析:Hbase UI中Requests Per Second的具体含义
    ASP.NET Session State Overview
    What is an ISAPI Extension?
    innerxml and outerxml
    postman
    FileZilla文件下载的目录
    how to use webpart container in kentico
    Consider using EXISTS instead of IN
  • 原文地址:https://www.cnblogs.com/leonkin/p/2558970.html
Copyright © 2020-2023  润新知