stringgrid.txt

大量Delphi开发资料

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


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 : [e-mail]     *) 
(******************************************************************************) 
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 : [e-mail]     *) 
(******************************************************************************) 
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;  


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; 

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