[DrDharm]

Один добрый человек написал вот такую программку, для рассчета плотности двухкомпонентной смеси от температуры; результат - табличка 81х100 значений...Вопрос, собственно, в следующем, можно-ли эти значения(табличку) как-то впихнуть в Xcel, например, кроме как переписывать вручную ?

Код:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
  TFMain = class(TForm)
    table: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    aP1,aP2:array [1..81] of integer;
    procedure LoadArrays;
  end;

var
  FMain: TFMain;

implementation

{$R *.dfm}

procedure TFMain.FormCreate(Sender: TObject);
var
  i,j,P1,P2,D1:integer;
begin
  LoadArrays;
  //Создание обозначений столбцов и строк
  for i:=0 to 100 do
    table.Cells[0,i+1]:=IntToStr(i)+' %';
  for i:=-40 to 40 do
    table.Cells[i+41,0]:=IntToStr(i);
  //Рассчет
  for i:=0 to 100 do
    for j:=-40 to 40 do
      begin
        D1:=i;
        P1:=aP1[j+41];
        P2:=aP2[j+41];
        //Защита от деления на 0
        try
          table.Cells[j+41,i+1]:=FloatToStr(100/(D1/P1+(100-D1)/P2)/10000);
        except
          table.Cells[j+41,i+1]:='0';
        end;
      end;
end;

procedure TFMain.LoadArrays;
const
  ArraysFile='table.txt';
var
  f:TStringList;
  i:integer;
begin
  f:=TStringList.Create;
  if not FileExists(ArraysFile) then
    begin
      Exception.Create('File '+ArraysFile+' not found!');
      halt;
    end;
  f.LoadFromFile(ArraysFile);
  try
    for i:=1 to 81 do
      begin
        aP1[i]:=StrToInt(f[i]);
        aP2[i]:=StrToInt(f[i+82]);
      end;
  except
    Exception.Create('File '+ArraysFile+' format error!');
    halt;
  end;
  f.Free;

end;

end.

Админ: Пользуемся тегами для оформления кода!

[Rat]

Код:

uses ComObj;

procedure Export2XL;
 var XL,Sheet: Variant;
 i: integer; 
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select id,name from table_1');
Query1.Open;
XL:= CreateOleObject('Excel.Application');
XL.WorkBooks.Add;
Sheet:= XL.ActiveWorkBook.Sheets[1];
Sheet.PageSetup.Orientation:= 2; //===Книжная ориентация===
Sheet.Name:= 'Лист № 1';
Sheet.Columns[1].ColumnWidth:= 5;
Sheet.Columns[2].ColumnWidth:= 25;
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]].HorizontalAlignment:= 3;
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]].VerticalAlignment:= 2;
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]].WrapText:= true;
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]].Font.FontStyle:= 'Полужирный';
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]].Merge(false);
Sheet.Range[Sheet.Cells[2,1],Sheet.Cells[2,2]]:= 'Результаты'; 
Sheet.Cells[3,1]:= 'Код';
Sheet.Cells[3,1]:= 'Наименование';
i:= 4;
Query1.First;
while not Query1.Eof do
 begin
 Sheet.Cells[i,1]:= Query1.Fields[0].AsInteger;
 Sheet.Cells[i,2]:= Query1.Fields[1].AsString; 
 inc(i);
 Qury1.Next;
 end;
XL.Visible:= true;
Sheet:= UnAssigned;
XL:= UnAssigned;
end;

Как пример вывод из базы данных в эксель.
Вместо query1 используйте то что вам нужно.

[DrDharm]

Хех, трабла в том, что я в Дельфи пока ноль, если не отрицательная величина...мне б попроще, если возможно. TStringGrid как - то в файл сохранить, что-ли, хотя бы, не в обязалово в excel...если возможно.

[FlyInDream]

Вот вам процедура, которая перенесёт ваш грид в Exel:

Код:

procedure TFMain.OutToExel();
var
 XLApp, Sheet, Colum: Variant;
 i, j: Integer;
begin
  XLApp:= CreateOleObject('Excel.Application');
  XLApp.Visible:=true;
  XLApp.Workbooks.Add(-4167);
  XLApp.Workbooks[1].WorkSheets[1].Name:='Отчёт';
  Colum:=XLApp.Workbooks[1].WorkSheets['Отчёт'].Columns;

  Sheet:=XLApp.Workbooks[1].WorkSheets['Отчёт'];
  for I := 0 to table.RowCount - 1 do
      for j := 0 to table.ColCount - 1 do
          Sheet.Cells[i+1,j+1]:=table.Cells[j,i];
end;

[angvelem]

Сообщение от DrDharm

... TStringGrid как - то в файл сохранить, ...

Сохраняй:

Код:

procedure TForm1.mnuSaveExcelClick(Sender: TObject);
var
  F        : TextFile;
  Col, Row : Integer;
begin
  AssignFile(F, 'myFile.sav');
  try
    Rewrite(F);
    WriteLn(F, ID);
    WriteLn(F, SG.ColCount);
    WriteLn(F, SG.RowCount);
    for Row := 0 to SG.RowCount - 1 do
      for Col := 0 to SG.ColCount - 1 do
      begin
        if (Row > 0) and (SG.Cells[1, Row] = '') then
          Break;
        WriteLn(F, SG.cells[Col, Row]);
      end;
  finally
    CloseFile(F);
  end;
end;

[DrDharm]

Благодарю всех, огромное спасибо.