StringGrid

最新推荐文章于 2021-12-16 14:42:07 发布

百炼成钢百忍成佛

最新推荐文章于 2021-12-16 14:42:07 发布

阅读量1k

点赞数

文章标签： integer list float string forms button

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;

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;

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;

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;

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;

// 加入如下代码 , 那么 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;

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;

.........

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;

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;

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;

-----------------------------

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;

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;

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;

用上面的两个函数就能解决你的问题了。在 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.

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;

// 重载 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;

// 重载 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.

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;

// 重载 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;

// 重载 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.

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;

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;

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;

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);

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;

百炼成钢百忍成佛

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
复制链接

分享到 QQ

分享到新浪微博

扫一扫