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;
end;
procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if not (gdFixed in State) then
with TStringGrid(Sender).Canvas do
begin
brush.Color:=clWindow;
FillRect(Rect);
if Grid.Cells[ACol,ARow]='yes' then
Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FCheck )
else
Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FNoCheck );
end;
end;
procedure TForm1.gridClick(Sender: TObject);
begin
if grid.Cells[grid.col,grid.row]='yes' then
grid.Cells[grid.col,grid.row]:='no'
else
grid.Cells[grid.col,grid.row]:='yes';
end;
end.
StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中：
DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);
可以实现文字换行！
在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中,
加入: (所有的列均设成可修改的)
if Col mod 2 = 0 then
grd.Options := grd.Options + [goEditing]
else
grd.Options := grd.Options - [goEditing];
stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）
// Save a TStringGrid to a file
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
i, k: Integer;
begin
AssignFile(f, FileName);
Rewrite(f);
with StringGrid do
begin
// Write number of Columns/Rows
Writeln(f, ColCount);
Writeln(f, RowCount);
// loop through cells
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
Writeln(F, Cells[i, k]);
end;
CloseFile(F);
end;
// Load a TStringGrid from a file
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
iTmp, i, k: Integer;
strTemp: String;
begin
AssignFile(f, FileName);
Reset(f);
with StringGrid do
begin
// Get number of columns
Readln(f, iTmp);
ColCount := iTmp;
// Get number of rows
Readln(f, iTmp);
RowCount := iTmp;
// loop through cells & fill in values
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
begin
Readln(f, strTemp);
Cells[i, k] := strTemp;
end;
end;
CloseFile(f);
end;
// Save StringGrid1 to 'c:.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveStringGrid(StringGrid1, 'c:.txt');
end;
// Load StringGrid1 from 'c:.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadStringGrid(StringGrid1, 'c:.txt');
end;
*******************************************
打开一个已有的文本文件,并将内容放到stringgrid中,文本行与stringgrid行一致;
在文本中遇到空格则放入下一cells.
搞定！注意，我只写了一个空格间隔的，你自己修改一下splitstring可以用多个空格分隔！
procedure TForm1.Button1Click(Sender: TObject);
var
aa,bb:tstringlist;
i:integer;
begin
aa:=tstringlist.Create;
bb:=tstringlist.Create;
aa.LoadFromFile('c:.txt');
for i:=0 to aa.Count-1 do
begin
bb:=SplitString(aa.Strings[i],' ');
stringgrid1.Rows[i]:=bb;
end;
aa.Free;
bb.Free;
end;
其中splitstring为：
function SplitString(const source,ch:string):tstringlist;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
result.Add(copy(temp,0,i-1));
delete(temp,1,i);
i:=pos(ch,temp);
end;
result.Add(temp);
end;
StringGrid组件Cells内容对齐
在StringGrid的DrawCell事件中添加类似的代码就可以了：
VAR
vCol, vRow : LongInt;
begin
vCol := ACol; vRow := ARow;
WITH Sender AS TStringGrid, Canvas DO
IF vCol = 2 THEN BEGIN ///对于第2列设置为右对齐
SetTextAlign(Handle, TA_RIGHT);
FillRect(Rect);
TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);
END;
end;
当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行， 则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
With StringGrid1 do
begin
If (ARow= Krow) and not (acol = 0) then
begin
Canvas.Brush.Color :=clYellow;// ClBlue;
Canvas.FillRect(Rect);
Canvas.font.color:=ClBlack;
Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);
end;
end;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
krow := Arow; //*
kcol := Acol;
end;
注意：必须把变量KROW的值初始为1或其他不为0的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。
怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.
请参考以下代码：
在OnDrawCell事件中处理背景色。程序如下：
//将第二列背景变为红色。
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit;
with stringgrid1 do
begin
canvas.Brush.color:=clRed;
canvas.FillRect(Rect);
canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow])
end;
end;
//加入如下代码,那么StringGrid的第四列就只读了.其他列非只读
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
with StringGrid1 do begin
if ACol = 4 then
Options := Options - [goEditing]
else Options := Options + [goEditing];
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
dx,dy:byte;
begin
if (acol = 4) and not (arow = 0) then
with stringgrid1 do
begin
canvas.Brush.color := clYellow;
canvas.FillRect(Rect);
canvas.font.color := clblue;
dx:=2;//调整此值，控制字在网格中显示的水平位置
dy:=2;//调整此值，控制字在网格中显示的垂直位置
canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);
end;
//控制标题栏的对齐
if (arow = 0) then
with stringgrid1 do
begin
canvas.Brush.color := clbtnface;
canvas.FillRect(Rect);
dx := 12; //调整此值，控制字在网格中显示的水平位置
dy := 5; //调整此值，控制字在网格中显示的垂直位置
canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);
end;
end;
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;
.........
stringgrid如何清空
with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;
选中某单元格,然后在该单元格中修改-> 选中某单元格,然后在该单元格中修改
设置属性:
StringGrid1.Options:=StringGrid1.Options+[goEditing];
让记录在StringGrid中分页显示
在Uses中加入： ADOInt
//首先设定PageSize，取出PageCount
procedure TForm1.Button1Click(Sender: TObject);
begin
ADoquery1.Recordset.PageSize :=spinedit1.Value;
Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount);
ShowData(spinedit2.Value);
end;
//然后将AbsolutePage的数据乾坤大挪移到StringGrid1中
procedure TForm1.ShowData(page:integer);
var
iRow, iCol, iCount : Integer;
rs : ADOInt.Recordset;
begin
ADoquery1.Recordset.AbsolutePage:=Page;
Currpage:=page;
iRow := 0;
iCol := 1;
stringgrid1.Cells[iCol, iRow] := 'FixedCol1';
Inc(iCol);
stringgrid1.Cells[iCol, iRow] := 'FixedCol2';
Inc(iRow);
Dec(iCol);
rs := adoquery1.Recordset;
for iCount := 1 to SpinEdit1.Value do
begin
stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
Inc(iCol);
stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
Inc(iRow);
Dec(iCol);
rs.MoveNext;
end;
//上一页
procedure TForm1.Button2Click(Sender: TObject);
begin
If (CurrPage)<>1 then
ShowData(CurrPage-1);
end;
//下一页
procedure TForm1.Button3Click(Sender: TObject);
begin
If CurrPage<>ADoquery1.Recordset.PageCount then
ShowData(CurrPage+1);
end;
打印StringGrid的程序源码
这段代码没有看懂，但是可能有的朋友需要，所以共享一下子 ：）
procedure TForm1.SpeedButton11Click(Sender: TObject);
Var
Index_R ,ALeft: Integer;
Index : Integer;
begin
StringGrid_File('D:AAA.TXT');
if Not LinkTextFile then
begin
ShowMessage('失败');
Exit;
end;
//
QuickRep1.DataSet := ADOTable1;
Index_R := ReSize(StringGrid1.Width);
ALeft := 13;
Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,
HeaderControl1.Sections[0].Text,taLeftJustify);
with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,
StringGrid1.Font,taLeftJustify) do
begin
DataSet := ADOTable1;
DataField := ADOTable1.Fields[0].DisplayName;
end;
ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R;
For Index := 1 to ADOTable1.FieldCount - 1 do
begin
Create_VLine(TitleBand1,ALeft - 13,16,1,40);
Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,
HeaderControl1.Sections[Index].Text,taLeftJustify);
Create_VLine(DetailBand1,ALeft - 13,-1,1,31);
with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,
StringGrid1.Font,taLeftJustify) do
begin
DataSet := ADOTable1;
DataField := ADOTable1.Fields[Index].DisplayName;
end;
ALeft := ALeft + StringGrid1.ColWidths[Index] * Index_R + Index_R;
end;
QuickRep1.Preview;
end;
function TForm1.ReSize(AGridWidth: Integer): Integer;
begin
Result := Trunc(718 / AGridWidth);
end;
function TForm1.StringGrid_File(AFileName: String): Boolean;
var
StrValue : String;
Index : Integer;
ACol , ARow : Integer;
AFileValue : System.TextFile;
begin
StrValue := '';
Try
AssignFile(AFileValue , AFileName);
ReWrite(AFileValue);
StrValue := HeaderControl1.Sections[0].Text;
For Index := 1 to HeaderControl1.Sections.Count - 1 do
StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;
Writeln(AFileValue,StrValue);
StrValue := '';
For ARow := 0 To StringGrid1.RowCount - 1 do
begin
StrValue := '';
StrValue := StringGrid1.Cells[0,ARow];
For ACol := 1 To StringGrid1.ColCount - 1 do
begin
StrValue := StrValue + ', ' + StringGrid1.Cells[ACol,ARow];
end;
Writeln(AFileValue,StrValue);
end;
Finally
CloseFile(AFileValue);
end;
end;
function TForm1.LinkTextfile: Boolean;
begin
Result := False;
with ADOTable1 do
begin
{ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source= D:;Extended Properties=Text;' +
'Persist Security Info=False';
TableName := 'AAA#TXT';
Open; }
if Active then
Result := True;
end;
end;
function TForm1.Create_QRDBText(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;
var
AQRDBText : TQRDBText;
begin
AQRDBText := TQRDBText.Create(Nil);
with AQRDBText do
begin
Parent := Sender;
Left := ALeft;
Top := ATop;
Width := AWidth;
Height := AHight;
AlignMent := AAlignMent;
Font.Assign(AFont);
end;
Result := AQRDBText;
end;
function TForm1.Create_VLine(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer): TQRShape;
var
AQRShapeV : TQRShape;
begin
AQRShapeV := TQRShape.Create(Nil);
with AQRShapeV do
begin
Parent := Sender;
Left := ALeft;
Top := ATop;
Width := AWidth;
Height := AHight;
end;
Result := AQRShapeV;
end;
procedure TForm1.Create_Title(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; ACaption: String; AAlignMent: TAlignment);
var
AQRLabel : TQRLabel;
begin
AQRLabel := TQRLabel.Create(Nil);
with AQRLabel do
begin
Parent := Sender;
Left := ALeft;
Top := ATop;
Width := AWidth;
AlignMent := AAlignMent;
Caption := ACaption;
end;
end;
-----------------------------
如何实现在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;
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 _/ _/ *)
(* _/ _/ *)
(* _/_/ _/_/ *)
(* *)
(* *)
(* 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;
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;
正确地设置StringGrid列宽而不截断任何一个文字方法
是在对StringGrid填充完文本串后调用SetOptimalGridCellWidth过程。
-----------程序片断-------------------------------------------------
(*
$Header$
Module Name : GeneralBSGrids.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.
实现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;
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.