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.