StringGrid使用全书( 一)

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

(2)实现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;

(3) 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: 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.

(4)让stringgrid点列头进行排序procedure GridQuickSort(Grid: TStringGrid; ACol: Integer; Order: Boolean ; NumOrStr: Boolean);

(******************************************************************************)

(* 函数名称：GridQuickSort *)

(* 函数功能：给 StringGrid 的 ACol 列快速法排序 _/_/ _/_/ _/_/_/_/_/ *)

(* 参数说明: _/ _/ _/ *)

(* Order: True 从小到大 _/ _/ *)

(* : False 从大到小 _/ _/ *)

(* NumOrStr : true 值的类型是Integer _/_/ _/_/ *)

(* : False 值的类型是String *)

(* 函数说明：对于日期，时间等类型数据均可按字符方式排序， *)

(* *)

(* *)(******************************************************************************)

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 的列 _/_/ _/_/ _/_/_/_/_/ *)

(* 参数说明: _/ _/ _/ *)

(* Sender _/ _/ *)

(* (*

(******************************************************************************)

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;

end;

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;

Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=188947