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;
|
请发表评论