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 := AAlig
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 : [email protected] *) (******************************************************************************) 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 的列 _/_/ _/_/ _/_/_/_/_/ *) (* 参数说明:
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: TObje
2003-11-24 9:42:21 TstringGrid 的行列合并研究【这段代码来自wangxian11】 正好在帖子上看到了,功能能够实现。(wangxian11大哥可真是厉害~~)可惜的是,效果还不是很好,如果将来有更好的希望大家提供吧。 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(
2003-11-28 11:58:31 删除选定行【来自wyb_star】 Procedure DeleteRow(AGrid : TStringGrid); var i, cr : integer; begin If assigned(AGrid) then begin cr := AGrid.Selection.Top; for i := cr + 1 to AGrid.RowCount - 1 do AGrid.Rows[i-1].Assign(AGrid.Rows[i]); AGrid.RowCount := AGrid.RowCount - 1; end; end;
2003-11-28 11:59:58 保存StringGrid到html文件【来自wyb_star】 procedure SaveToHtml(StringGrid:TStringGrid;const FileName : string;const Title : string); var Txt : TextFile; i,ii: integer; Value:string; BgColor:TColor; function GetColor(Color: TColor): String; var s: String; begin if Color = clNone then s := '000000' else s := IntToHex(ColorToRGB(Color), 6); Result := Copy(s, 5, 2) + Copy(s, 3, 2) + Copy(s, 1, 2); end; begin BgColor := clWhite; AssignFile(Txt,FileName); Rewrite(Txt); WriteLn(Txt,'<Title>' + Title + '</Title>'); WriteLn(Txt,'<TABLE WIDTH=100% border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111">'); for i := 0 to StringGrid.RowCount - 1 do begin WriteLn(Txt,'<TR>'); for ii := 0 to StringGrid.ColCount - 1 do begin Value := StringGrid.Cells[ii,i]; if Value = '' then Value := ' '; if (ii < StringGrid.FixedCols) or (i < StringGrid.FixedRows) then BgColor := StringGrid.FixedColor else BgColor := StringGrid.Color; WriteLn(Txt,'<TD BGCOLOR="#' + GetColor(BgColor) + '"><font color="#' + GetColor(StringGrid.Font.Color) + '">' + Value + '</font></TD>') end; WriteLn(Txt,'</TR>'); end; WriteLn(Txt,'</TABLE>'); CloseFile(Txt); end; 使用示例: SaveToHtml(StringGrid1,'c:\1.html','标题');
2003-11-28 17:19:35 高速排序函数(在StringGrid里加上5000行试试就知道它的效率了)【来自wyb_star】 【这个东西很强劲的,感谢 wyb_Star 提供】 高速排序函数(在StringGrid里加上5000行试试就知道它的效率了) procedure Quicksort(Grid:TStringGrid; var List:array of integer; min, max,sortcol,datatype: Integer); {List is a list of rownumbers in the grid being sorted} var med_value : integer; hi, lo, i : Integer; function compare(val1,val2:string):integer; var int1,int2:integer; float1,float2:extended; errcode:integer; begin case datatype of 0: result:=ANSIComparetext(val1,val2); 1: begin int1:=strtointdef(val1,0); int2:=strtointdef(val2,0); if int1>int2 then result:=1 else if int1<int2 then result:=-1 else result:=0; end; 2: begin val(val1,float1,errcode); if errcode<>0 then float1:=0; val(val2,float2,errcode); if errcode<>0 then float2:=0; if float1>float2 then result:=1 else if float1<float2 then result:=-1 else result:=0; end; else result:=0; end; end; begin {If the list has <= 1 element, it's sorted} if (min >= max) then Exit; {Pick a dividing item randomly} i := min + Trunc(Random(max - min + 1)); med_value := List[i]; List[i] := List[min]; { Swap it to the front so we can find it easily} {Move the items smaller than this into the left half of the list. Move the others into the right} lo := min; hi := max; while (True) do begin // Look down from hi for a value < med_value. while compare(Grid.cells[sortcol,List[hi]] ,grid.cells[sortcol,med_value])>=0 do (*ANSIComparetext(Grid.cells[sortcol,List[hi]] ,grid.cells[sortcol,med_value])>=0 do*) begin hi := hi - 1; if (hi <= lo) then Break; end; if (hi <= lo) then begin {We're done separating the items} List[lo] := med_value; Break; end; // Swap the lo and hi values. List[lo] := List[hi]; inc(lo); {Look up from lo for a value >= med_value} while Compare(grid.cells[sortcol,List[lo]], grid.cells[sortcol,med_value])<0 do begin inc(lo); if (lo >= hi) then break; end; if (lo >= hi) then begin {We're done separating the items} lo := hi; List[hi] := med_value; break; end; List[hi] := List[lo]; end; {Sort the two sublists} Quicksort(Grid,List, min, lo - 1,sortcol,datatype); Quicksort(Grid,List, lo + 1, max,sortcol,datatype); end; //datatype 0:按字符排序 1:按整型排序 2:按浮点型排序 procedure Sortgrid(Grid : TStringGrid; sortcol,datatype:integer); var i : integer; tempgrid:tstringGrid; list:array of integer; begin screen.cursor:=crhourglass; tempgrid:=TStringgrid.create(nil); with tempgrid do begin rowcount:=grid.rowcount; colcount:=grid.colcount; fixedrows:=grid.fixedrows; end; with Grid do begin setlength(list,rowcount-fixedrows); for i:= fixedrows to rowcount-1 do begin list[i-fixedrows]:=i; tempgrid.rows[i].assign(grid.rows[i]); end; quicksort(Grid, list,0,rowcount-fixedrows-1,sortcol,datatype); for i:=0 to rowcount-fixedrows-1 do begin rows[i+fixedrows].assign(tempgrid.rows[list[i]]) end; row:=fixedrows; end; tempgrid.free; setlength(list,0); screen.cursor:=crdefault; end; 使用方法: procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var c:integer; w:integer; Grid:TStringGrid; begin Grid := Sender as TStringGrid; with Grid do if y<=rowheights[0] then begin c:=0; w:=colwidths[0]; while (c<colcount) and (w<=x) do begin inc(c); w:=w+colwidths[c]+gridlinewidth; end; sortgrid(Grid,c,0); end; end;
2003-11-28 17:21:51 将TStringGrid的3D界面改成Flat样式【来自wyb_star】 将TStringGrid的3D界面改成Flat样式 修改grids中TCustomGrid的paint函数 主要是下面两句 DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1); DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2); 具体的说明可以查msdn 修改如下: DrawEdge(Canvas.Handle, Ctl3DRect, BDR_RAISEDINNER, BF_FLAT); DrawEdge(Canvas.Handle, Ctl3DRect, BDR_RAISEDINNER, BF_FLAT);
2003-12-1 17:34:36 如何在写表格时改变STRINGGRID.cells[i,j]的颜色【dcsdcs编写】 我是通过继承下来,修改的 procedure WMPaint(var Message: TWMPaint); message wm_Paint; procedure TdcsStringGrid.WMPaint(var Message: TWMPaint); var rt:TRect; tmpc:DWORD; begin PaintHandler(Message); if not(focused) then begin tmpc:=Canvas.font.Color; rt:=CellRect(selection.Left,selection.Top); canvas.Lock; canvas.FillRect(rt); Canvas.font.Color:=font.Color; Canvas.TextRect(rt,rt.Left+2,rt.top+2,Cells[selection.Left,selection.Top]); //canvas.TextOut(rt.Left+2,rt.top+2,Cells[selection.Left,selection.Top]); Canvas.font.Color:=tmpc; canvas.UnLock; end; end; |