stringgrid 应用例子

 

 

 

unit textUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, printers, OleServer, Excel2000;
type

  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    StringGrid1: TStringGrid;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    SaveDialog1: TSaveDialog;
    Button7: TButton;
    ListBox1: TListBox;
    Button9: TButton;
    ComboBox1: TComboBox;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure StringGrid1RowMoved(Sender: TObject; FromIndex, ToIndex: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure DeleteRow(Row: Integer);
    procedure Button6Click(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TExcludeColumns = set of 0..255;
procedure SetOptimalGridCellWidth(sg: TStringGrid; ExcludeColumns: TExcludeColumns);

var
  Form1: TForm1;

implementation

uses
  math;

{$R *.dfm}

 

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.

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;

 

procedure tform1.DeleteRow(Row: Integer);
var
  i: integer;
begin
  if (Row < StringGrid1.RowCount) and (Row > Stringgrid1.FixedRows - 1) then
  begin

    if Row < StringGrid1.RowCount - 1 then //²»ÊÇ×îºóÒ»ÐÐ
    begin
      for i := Row to StringGrid1.RowCount - 1 do
        StringGrid1.Rows[i] := StringGrid1.Rows[i + 1];
    end
    else //×îºóÒ»ÐÐ
      stringGrid1.Rows[Row].Clear;

    StringGrid1.RowCount := StringGrid1.RowCount - 1;
    stringgrid1.SetFocus;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

  s: string;
  allText: string;
  f: TextFile;

begin

  AssignFile(F, 'e:/mydoc/gdgs.txt'); // ½«C:/MyFile.txtÎļþÓëF±äÁ¿½¨Á¢Á¬½Ó£¬ºóÃæ¿ÉÒÔʹÓÃF±äÁ¿¶ÔÎļþ½øÐвÙ×÷¡£

  Reset(F); // ´ò¿ªÎļþ

  while not EOF(F) do
  begin // ʹÓÃWhileÑ­»·£¬Ò»Ö±ÅжÏÊÇ·ñµ½ÁËÎļþδβ

    Readln(F, S); // ¶ÁÈ¡Ò»ÐÐÎı¾

    allText := AllText + S + char(13) + char(10);

  end;
  CloseFile(F); // ¹Ø±ÕÎļþ
  memo1.text := alltext;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  f: textfile;
begin
  if length(edit1.text) > 0 then
  begin
    assignfile(f, 'e:/mydoc/gdgs.txt');
    append(f);
    writeln(f, edit1.text);
    closefile(f);
  end;

end;

function FnGetPartCount(aSource: string; aSeparator: string = ','): integer;
var
  ln: integer;
begin
  ln := 0;
  if aSource = '' then
  begin
    Result := 0;
    exit;
  end;
  if Pos(aSeparator, aSource) > 0 then
  begin
    aSource := copy(aSource, Pos(aSeparator, aSource) + 1, length(aSource));
    ln := FnGetPartCount(aSource, aSeparator) + 1;
  end
  else
    if Pos(aSeparator, aSource) = 0 then
      ln := ln + 1;
  Result := ln;
end;

function FnGetPartString(aSource: string; nPart: Integer; aSeparator: string = ';'): string;
var
  lnfor: integer;
  lsstr: string;
begin
  lnfor := Pos(aSeparator, aSource);
  if (lnfor = 0) then
  begin
    Result := aSource;
    exit;
  end;
  if nPart > 1 then
  begin
    aSource := Copy(aSource, lnfor + 1, length(aSource));
    lsstr := FnGetPartString(aSource, nPart - 1, aSeparator);
  end
  else if nPart = 1 then
    lsstr := copy(aSource, 1, lnfor - 1);

  result := lsstr;
end;

// Save a TStringGrid to a file

procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
  f: TextFile;
  i, k: Integer;
  rowstr: string;
begin
  AssignFile(f, FileName);
  Rewrite(f);
  with StringGrid do
  begin
    for i := 1 to rowCount - 1 do //´ÓµÚ2ÐпªÊ¼  µÚÒ»ÐÐÊDZêÌâ
    begin
      rowstr := '';
      for k := 1 to colCount - 1 do //´ÓµÚ2ÁпªÊ¼  µÚÒ»ÁÐÊÇÐòºÅ
      begin
        if k = 1 then
       //µÚÒ»¸ö ×Ö¶Î
          rowstr := cells[k, i]
        else
          rowstr := rowstr + ',' + cells[k, i];
      end;
     //----------------------------
     { begin
        if k = 1 then
          rowstr := cells[k, i] + ',' //µÚÒ»¸ö ×Ö¶Î
        else
          if k = colcount - 1 then //×îºóÒ»¸ö×ֶκó²»Òª ¼Ó,
            rowstr := rowstr + cells[k, i]
          else
            rowstr := rowstr + cells[k, i] + ','; //Öмä×Ö¶ÎͨÓÃ×éºÏ
      end; }
      //---------------------------------------------
//      if rowstr <> ',,,,,' then
      Writeln(F, rowstr); //Ò»ÐÐ×éºÏ½áÊø£¬Ð´ÈëÎļþ
    end;
  end;
  CloseFile(F);
end;

procedure TForm1.Button3Click(Sender: TObject);

var
//  aa: tstringlist;
  aa: tstrings;
  i, col: integer;
begin

  with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;

  aa := tstringlist.Create;

  if opendialog1.Execute then
  begin
    aa.LoadFromFile(opendialog1.filename);

    stringgrid1.RowCount := aa.count + 1;
    stringgrid1.ColCount := 2;
    stringgrid1.Cells[0, 0] := 'ÐòºÅ';

    for i := 0 to aa.Count - 1 do
    begin
      for col := 1 to fngetpartcount(aa.strings[i], ',') do
      begin
        if fngetpartcount(aa.Strings[i], ',') + 1 > stringgrid1.ColCount then
          stringgrid1.ColCount := fngetpartcount(aa.Strings[i], ',') + 1;

        stringgrid1.cells[0, i + 1] := inttostr(i + 1);
        stringgrid1.cells[col, i + 1] := fnGetPartString(aa.strings[i], col, ',');

      end;
    end;

    for i := 1 to stringgrid1.ColCount - 1 do
    begin
      stringgrid1.Cells[i, 0] := 'µÚ' + inttostr(i + 1) + 'ÁÐ';
    end;

    SetOptimalGridCellWidth(stringgrid1, [0..0]);

    aa.Free;

  end;

end;

procedure TForm1.StringGrid1RowMoved(Sender: TObject; FromIndex,
  ToIndex: Integer);
var
  i: integer;
begin
  for i := 0 to stringgrid1.RowCount - 1 do
    stringgrid1.cells[0, i + 1] := inttostr(i + 1);

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  stringgrid1.ColCount := stringgrid1.ColCount + 1;

end;

// delete row

procedure TForm1.Button5Click(Sender: TObject);
var
  Sel: TGridRect;
  i: integer;
begin
  Sel := StringGrid1.Selection;
  DeleteRow(Sel.Top);

  for i := 0 to stringgrid1.rowcount - 1 do
    stringgrid1.Cells[0, i + 1] := inttostr(i + 1);

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

  if SaveDialog1.Execute then
    SaveStringGrid(StringGrid1, SaveDialog1.FileName);

end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
type
  TCharSet = set of char;
var
  NumSet: TCharSet;

begin
 //----------------
  if stringgrid1.Cells[stringgrid1.Col, 0] = 'µÚ5ÁÐ' then
  begin
    NumSet := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '.'];
    if (Key <> #8) and (key <> #13) then if not (Key in NumSet) then Key := #0;
  end;

//----------------------------------------
  if key = #13 then
  begin
    if (stringgrid1.Col < stringgrid1.ColCount - 1) then
      stringgrid1.Col := stringgrid1.Col + 1
    else
    begin
      if stringgrid1.Row = stringgrid1.RowCount - 1 then
      begin
        stringgrid1.RowCount := stringgrid1.rowCount + 1;
        stringgrid1.row := stringgrid1.row + 1;
        stringgrid1.Cells[0, stringgrid1.Row] := inttostr(stringgrid1.Row);
        stringgrid1.col := 1
      end
      else
      begin
        stringgrid1.Row := stringgrid1.Row + 1;
        stringgrid1.Col := 1;
      end;
    end;
  end;

end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  stringgrid1.RowCount := stringgrid1.RowCount + 1;
  stringgrid1.Row := stringgrid1.RowCount - 1;
  stringgrid1.Cells[0, stringgrid1.Row] := inttostr(stringgrid1.Row);
  stringgrid1.col := 1;
  stringgrid1.SetFocus;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin
  MessageDlg('my new dialog', mtInformation, mbOKCancel, 0);

//listbox1.Items:=screen.Fonts;
//listbox1.Items:=stringgrid1.cols[1];

end;

procedure TForm1.Button9Click(Sender: TObject);
var
  i, textheight: integer;

begin
  if printer.Printers.Count = 0 then

  begin
    showmessage('not found any printer');
    exit;
  end;

//textheight:=printer.Canvas.TextHeight(memo1.Lines.text);
  textheight := printer.Canvas.TextHeight(stringgrid1.Rows[1].Text);
  printer.BeginDoc;

{try
for i:=0 to stringgrid1.RowCount-1 do

//printer.Canvas.TextOut(10,10+(i*textheight),memo1.Lines[i]);
printer.Canvas.TextOut(1,(i*textheight),stringgrid1.cells[1,i+1]);
finally}
  printer.Canvas.TextOut(0, 0, stringgrid1.cells[stringgrid1.Col, stringgrid1.row]);

  printer.EndDoc;
//end;

end;

 

end.