Delphi StringGrid控件的用法

最新推荐文章于 2024-06-07 01:05:52 发布

fangyuan621

最新推荐文章于 2024-06-07 01:05:52 发布

阅读量3.1k

点赞数

分类专栏： Delphi 文章标签： delphi

原文链接：http://www.delphitop.com/html/kongjian/3771.html

版权

Delphi 专栏收录该内容

99 篇文章 11 订阅

订阅专栏

Delphi StringGrid控件

组件名称：StringGrid

●固定行及固定列：

StringGrid.FixedCols:=固定行之数;

StringGrid.FixedRows:=固定列之数;

StringGrid. FixedColor:=固定行列之颜色;

StringGrid.Color:=资料区之颜色;

●资料行列之宽高度：

StringGrid.DefaultColWidth:=内定全部之宽度;

StringGrid.DefaultRowHeight:=内定全部之高度;

StringGrid.ColWidths[Index:Longint]:=某一行整行之宽度;

StringGrid.RowHeights[Index:Longint]:=某一列整列之高度;

●数据区(CELL)指定：

将某一行列停在画面之资料区最左上角：

StringGrid.LeftCol:=某一行号;

StringGrid.TopRow:=某一列号;

焦点移至某一格(CELL)内：

StringGrid.Row:=?;

StringGrid.Col:=?;

设定数据行列数：(包含固定行、列亦算在内)

StringGrid.RowCount:=?;

StringGrid.ColCount:=?;

写一字符串至某一格(CELL)内：

StringGrid.Cells[Col值 , Row值]:=字符串;

判断鼠标指针目前在哪一格(CELL)范围内：

在StringGrid之Mouse事件中(UP,DOWN或MOVE)下：

VAR C , R : Longint;

Begin

StringGrid.MouseToCell(X,Y,C,R); {X,Y由MOUSE事件传入}

{取回 C , R 即为目前之Col , Row值 }

......

●StringGrid之Options属性：

若要于程序执行中开启或关闭Options某一功能如 ‘goTABS’

开: StringGrid.Options:= StringGrid.Options + [goTABS];

关: StringGrid.Options:= StringGrid.Options - [goTABS];

goFixedHorzLine 固定列间之水平线

goFixedVertLine 固定行间之垂直线

goHorzLine 资料格间水平线

goVertLine 资料格间垂直线

goRangeSelect 鼠标可多重选择

goDrawFocusSelected 多重选择时,第一数据项反白

goRowSizing 鼠标可改变列高

goColSizing 鼠标可改变行宽

goRowMoving 鼠标可搬数据列

goColMoving 鼠标可搬数据行

goEditing 可编辑(与鼠标可多重选择互斥)

goAlwaysShowEditor 须有goEditing,不用按F4或ENTER即有等待输入光标

goTabs 允许TAB及Shift-TAB移动光标

goRowSelect 用鼠标点一下可选取整列(亦与鼠标可多重选择互斥)

goThumbTracking 滚动条动时GRID跟着动,否则滚动条动完放开,GRID才动

StringGrid使用全书

StringGrid行列的增加和删除

如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样

StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中

在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中

stringgrid从文本读入的问题

StringGrid组件Cells内容对齐

StringGird的行列背景色设置

怎么改变StringGrid控件某一列的背景和某一列的只读属性

StringGrid控件标题栏的对齐

怎么改变StringGrid控件某一列的背景和某一列的只读属性

StringGrid控件标题栏的对齐

在stringGrid中使用回车键模拟TAB键切换单元格的功能实现

stringgrid如何清空

让记录在StringGrid中分页显示在

打印StringGrid

如何实现在stringgrid中删除鼠标点中的那一行，下一行再顶上的效果

让stringgrid点列头进行排序

正确地设置StringGrid列宽而不截断任何一个文字方法

实现StringGrid的删除，插入，排序行操作

TstringGrid 的行列合并研究

StringGrid行列的增加和删除

type

TExCell = class(TStringGrid)

public

procedure DeleteRow(ARow: Longint);

procedure DeleteColumn(ACol: Longint);

procedure InsertRow(ARow: LongInt);

procedure InsertColumn(ACol: LongInt);

end;

procedure TExCell.InsertColumn(ACol: Integer);

begin

ColCount :=ColCount +1;

MoveColumn(ColCount-1, ACol);

end;

procedure TExCell.InsertRow(ARow: Integer);

begin

RowCount :=RowCount +1;

MoveRow(RowCount-1, ARow);

end;

procedure TExCell.DeleteColumn(ACol: Longint);

begin

MoveColumn(ACol, ColCount -1);

ColCount := ColCount - 1;

end;

procedure TExCell.DeleteRow(ARow: Longint);

begin

MoveRow(ARow, RowCount - 1);

RowCount := RowCount - 1;

end;

如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;

type

TForm1 = class(TForm)

grid: TStringGrid;

procedure FormCreate(Sender: TObject);

procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure gridClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

fcheck,fnocheck:tbitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var

i:SmallInt;

bmp:TBitmap;

begin

FCheck:= TBitmap.Create;

FNoCheck:= TBitmap.Create;

bmp:= TBitmap.create;

try

bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));

With FNoCheck Do Begin

width := bmp.width div 4;

height := bmp.height div 3;

canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );

End;

With FCheck Do Begin

width := bmp.width div 4;

height := bmp.height div 3;

canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height ));

End;

finally

bmp.free

end;

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.

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?）

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

当我将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的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

怎么改变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;

.........

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;

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;

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

如何实现在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;

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

正确地设置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.

实现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;

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.

fangyuan621

关注

0
点赞
踩
8

收藏

觉得还不错? 一键收藏
0
评论
Delphi StringGrid控件的用法

Delphi StringGrid控件组件名称：StringGrid ●固定行及固定列：StringGrid.FixedCols:=固定行之数;StringGrid.FixedRows:=固定列之数;StringGrid. FixedColor:=固定行列之颜色;StringGrid.Color:=资料区之颜色;●资料行列之宽高度：StringGrid.DefaultColWidth:=内定全部之宽度;StringGrid.Default...
复制链接

扫一扫