StringGrid使用全书2

如何实现在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 : [email protected]　　 *)
(******************************************************************************)
procedure MoveStringGridData(Grid: TStringGrid; Sou,Des :Integer );
var
　TmpStrList: TStringList ;
　K : Integer ;
begin
　try
　　TmpStrList :=TStringList.Create() ;
　　TmpStrList.Clear ;
　　for K := Grid.FixedCols to Grid.ColCount -1 do
　　　TmpStrList.Add(Grid.Cells[K,Sou]) ;
　　Grid.Rows [Sou] := Grid.Rows [Des] ;
　　for K := Grid.FixedCols to Grid.ColCount -1 do
　　　Grid.Cells [K,Des]:= TmpStrList.Strings[K] ;
　finally
　　TmpStrList.Free ;
　end;
end;

procedure QuickSort(Grid: TStringGrid; iLo, iHi: Integer);
var
　Lo, Hi : Integer;
　Mid: String ;
begin
　Lo := iLo ;
　Hi := iHi ;
　Mid := Grid.Cells[ACol,(Lo + Hi) div 2];
　repeat
　　if Order and not NumOrStr then //按正序、字符排
　　begin
　　　while Grid.Cells[ACol,Lo] < Mid do Inc(Lo);
　　　while Grid.Cells[ACol,Hi] > Mid do Dec(Hi);
　　end ;
　　if not Order and not NumOrStr then //按反序、字符排
　　begin
　　　while Grid.Cells[ACol,Lo] > Mid do Inc(Lo);
　　　while Grid.Cells[ACol,Hi] < Mid do Dec(Hi);
　　end;

　　if NumOrStr then
　　begin
　　　if Grid.Cells[ACol,Lo] = '' then Grid.Cells[ACol,Lo] := '0' ;
　　　if Grid.Cells[ACol,Hi] = '' then Grid.Cells[ACol,Hi] := '0' ;
　　　if Mid = '' then Mid := '0' ;
　　　if Order then
　　　begin //按正序、数字排
　　　　while StrToFloat(Grid.Cells[ACol,Lo]) < StrToFloat(Mid) do Inc(Lo);
　　　　while StrToFloat(Grid.Cells[ACol,Hi]) > StrToFloat(Mid) do Dec(Hi);
　　　end else
　　　begin //按反序、数字排
　　　　while StrToFloat(Grid.Cells[ACol,Lo]) > StrToFloat(Mid) do Inc(Lo);
　　　　while StrToFloat(Grid.Cells[ACol,Hi]) < StrToFloat(Mid) do Dec(Hi);
　　　end;
　　end ;
　　if Lo <= Hi then
　　begin
　　　MoveStringGridData(Grid, Lo, Hi) ;
　　　Inc(Lo);
　　　Dec(Hi);
　　end;
　until Lo > Hi;
　if Hi > iLo then QuickSort(Grid, iLo, Hi);
　if Lo < iHi then QuickSort(Grid, Lo, iHi);
end;

begin
try
　QuickSort(Grid, Grid.FixedRows, Grid.RowCount - 1 ) ;
except
on E: Exception do
　Application.MessageBox(Pchar('系统在排序数据的时候遇到异常:'#13+E.message+#13'请重试，如果该问题依然存在请与程序供应商联系！'),'系统错误',MB_OK+MB_ICONERROR) ;
end;
end;

procedure StringGridTitleDown(Sender: TObject;
Button: TMouseButton;　X, Y: Integer);
(******************************************************************************)
(*　函数名称：StringGridTitleDown　　　　　　　　　　　　　　　　　　　　　　 *)
(*　函数功能：取鼠标点StringGrid 的列　　　　　　　　_/_/　　 _/_/　_/_/_/_/_/ *)
(*　参数说明:　　　　　　　　　　　　　　　　　　　　　_/　 _/　　　　_/　　　*)
(*　　　　　　Sender　　　　　　　　　　　　　　　　　　 _/　　　　　_/　　　 *)
(*　　　　　　　　　　　　　　　　　　　　　　　　　　　_/　　　　　_/　　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　　　　 _/_/　　　　_/_/　　　　 *)
(*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　 Author: YuJie　2001-05-27　　　*)
(*　　　　　　　　　　　　　　　　　　　　　　 Email : [email protected]　　 *)
(******************************************************************************)
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 : 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.

　

 

实现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 (Arowbegin
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.