Борщенко_КСФ_3-4 / Моделирование делфи / Unit1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, Grids, ValEdit, xpman, TeeProcs, TeEngine,
Chart, Series, ExtDlgs, IniFiles, Contnrs, ComObj,ComCtrls;

type
VecSh = array[0..20] of Double;
Mat = array[0..20,0..21] of Double;

TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
ValueListEditor1: TValueListEditor;
GBox: TGroupBox;
Panel1: TPanel;
ValueListEditor2: TValueListEditor;
Splitter1: TSplitter;
Splitter2: TSplitter;
Panel2: TPanel;
StringGrid1: TStringGrid;
N4: TMenuItem;
N5: TMenuItem;
Chart1: TChart;
sX: TLineSeries;
sG: TLineSeries;
sY: TLineSeries;
sZ: TLineSeries;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
ColorDialog1: TColorDialog;
SaveDialog1: TSaveDialog;
Image1: TImage;
Splitter3: TSplitter;
Splitter4: TSplitter;
N2: TMenuItem;
N3: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
SaveDialog2: TSaveDialog;
sF: TLineSeries;
procedure N13Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ClickSelSeries(Sender: TObject);
procedure ValueListEditor1KeyPress(Sender: TObject; var Key: Char);
private
procedure LoadValues;
procedure ShowD;
function RefToCells(Arow,Acol: integer):string;
public
Series: TChartSeries;
MiSeriesList : TObjectList;
N: Integer;
A, B, C, k1, k2, k3, k4, dt, t0, Y0, Z0, F0,
a0, a1, a2, a3, a4, b0, b1, b2, c0, c1, c2,
D1, D2, D3, D4, D5, D6, D7, D8, D9, D10: Double;
Result: array of array of Double;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure Gauss(N:Integer; A:Mat; var X:VecSh; var S:Double);
var
I,J,K,K1,N1 : Integer;
R : Double;
begin
N1:=N+1;
for K:=0 to N-1 do begin
K1:=K+1;
S:=A[K,K];
J:=K;
for I:=K1 to N-1 do begin
R:=A[I,K];
if Abs(R) > Abs(S) then begin
S:=R;
J:=I;
end;
end;
if J<> K then
for I:=K to N1-1 do begin
R:=A[K,I];
A[K,I]:=A[J,I];
A[J,I]:=R
end;
for J:=K1 to N1-1 do A[K,J]:=A[K,J]/S;
for I:=K1 to N-1 do begin
R:=A[I,K];
for J:=K1 to N1-1 do A[I,J]:=A[I,J]-A[K,J]*R;
end;
end;
for I:=N-1 downto 0 do begin
S:=A[I,N1-1];
for J:=I+1 to N-1 do S:=S-A[I,J]*X[J];
X[I]:=S;
end;
end;

procedure TForm1.ClickSelSeries(Sender: TObject);
var
I : Integer;
begin
for I := 0 to MiSeriesList.Count - 1 do
Chart1.Series[i].Active := TMenuItem(MiSeriesList.Items[i]).Checked;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
MinuTemp: TMenuItem;
IFile : TIniFile;
begin
ValueListEditor1.Strings.LoadFromFile('inputs.ini');
ValueListEditor2.Strings.LoadFromFile('Dx.ini');


IFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'st.ini');
Chart1.Gradient.StartColor := IFile.ReadInteger('Color','StartColor',clWhite);
Chart1.Gradient.EndColor := IFile.ReadInteger('Color','EndColor',clWhite);
IFile.Free;

MiSeriesList := TObjectList.Create(true);
for I := 0 to Chart1.SeriesCount - 1 do
begin
MinuTemp := TMenuItem.Create(nil);
MinuTemp.AutoCheck := true;
MinuTemp.Checked := true;
MinuTemp.OnClick := ClickSelSeries;
MinuTemp.Caption := Chart1.Series[i].Title;
N6.Add(MinuTemp);
MiSeriesList.Add(MinuTemp);
end;

StringGrid1.Cells[0,0] := 'I';
StringGrid1.Cells[1,0] := 't';
StringGrid1.Cells[2,0] := 'X';
StringGrid1.Cells[3,0] := 'G';
StringGrid1.Cells[4,0] := 'k1';
StringGrid1.Cells[5,0] := 'D3';
StringGrid1.Cells[6,0] := 'Y';
StringGrid1.Cells[7,0] := 'F';
StringGrid1.Cells[8,0] := 'Z';

SaveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
IFile : TIniFile;
begin
MiSeriesList.Free;
ValueListEditor1.Strings.SaveToFile(ExtractFilePath(Application.ExeName)+'inputs.ini');
IFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'st.ini');
IFile.WriteInteger('Color','StartColor',Chart1.Gradient.StartColor);
IFile.WriteInteger('Color','EndColor',Chart1.Gradient.EndColor);
IFile.Free;
end;

procedure TForm1.LoadValues;
var
ErrorIndex: Integer;
begin
ErrorIndex := 0;
try
A := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
B := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
C := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
k2 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
k3 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
k4 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
dt := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
t0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
Y0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
F0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
Z0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
a0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
a1 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
a2 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
a3 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
a4 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
b0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
b1 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
b2 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
c0 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
c1 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
c2 := StrToFloat(ValueListEditor1.Cells[1,ErrorIndex]);
inc(ErrorIndex);
N := StrToInt(ValueListEditor1.Cells[1,ErrorIndex]);
SetLength(Result,N,9);
except
on E:Exception do begin
ShowMessage('Некоректно введено значение "'+ValueListEditor1.Cells[0,ErrorIndex]+'"');
ValueListEditor1.Row := ErrorIndex;
ValueListEditor1.Col := 1;
end;
end;

end;

procedure TForm1.N10Click(Sender: TObject);
begin
if SaveDialog1.Execute then
Chart1.SaveToBitmapFile(SaveDialog1.FileName);
end;

procedure TForm1.N13Click(Sender: TObject);
const
xlWbatWork=-4167;
var
Row,Col,i,j: Integer;
XLApp, Sheet, Data: OleVariant;
TextF: TStringList;
S: string;
begin
if SaveDialog2.Execute then
case SaveDialog2.FilterIndex of
3,1:try
Row := ValueListEditor1.RowCount + StringGrid1.RowCount;
Col := 9;
Data := VarArrayCreate([1,Row,1,Col],varVariant);
for I := 0 to ValueListEditor1.RowCount - 2 do
begin
Data[I+1,1] := ValueListEditor1.Cells[0, I]+'=';
Data[I+1,2] := StrToFloat(ValueListEditor1.Cells[1, I]);
end;
for I := 1 to ValueListEditor2.RowCount - 1 do
begin
Data[I,3] := ValueListEditor2.Cells[0, I]+'=';
Data[I,4] := StrToFloat(ValueListEditor2.Cells[1, I]);
end;
for J := 0 to StringGrid1.ColCount - 1 do
Data[ValueListEditor1.RowCount+1,J+1] := StringGrid1.Cells[J, 0];
for I := 1 to StringGrid1.RowCount - 1 do
for J := 0 to StringGrid1.ColCount - 1 do
Data[ValueListEditor1.RowCount+I+1,J+1] := Result[I-1, J];

XLApp:=CreateOleObject('Excel.Application');
try
XLApp.Visible:=False;
XLApp.WorkBooks.Add(xlWbatWork);
Sheet:=XLApp.WorkBooks[1].WorkSheets[1];
Sheet.Range[RefToCells(1,1),RefToCells(Row,Col)].Value:=data;

try
XLApp.WorkBooks[1].SaveAs(SaveDialog2.FileName+'.xls');
except
on E:Exception do
ShowMessage('Ошибка при сохранении');
end;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts:=False;
XLApp.Quit;
XLApp:=Unassigned;
Sheet:=Unassigned;
end;
end;
except
on E:EInOutError do
MessageDlg(E.Message,mtError,[mbOK],0);
end;

2:begin
TextF := TStringList.Create;
for I := 0 to ValueListEditor1.RowCount - 1 do
TextF.Add(ValueListEditor1.Cells[0,I]+'='+ValueListEditor1.Cells[1,I]);
for I := 1 to ValueListEditor2.RowCount - 1 do
TextF.Add(ValueListEditor2.Cells[0,I]+'='+ValueListEditor2.Cells[1,I]);
for I := 0 to StringGrid1.RowCount - 1 do begin
S := '';
for J := 0 to StringGrid1.ColCount - 1 do
S := S +#9+ StringGrid1.Cells[j,i];
TextF.Add(S);
end;
TextF.SaveToFile(SaveDialog2.FileName+'.txt');
TextF.Free;
end;
end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.N3Click(Sender: TObject);
var
I: Integer;
t, X, G, Gp, Yp, Zp, Fp, Xp, S : Double;
YZ : VecSh;
Matrix : Mat;
begin
N13.Enabled := true;
LoadValues;
D1 := (2*A-B*dt)/(2*A+B*dt);
D2 := -dt/(2*A+B*dt);
D4 := k2*dt/(2*A+B*dt);
D5 := dt/2;
D6 := (2*C-dt)/(2*C+dt);
D7 := (2*dt/(2*C+dt))*(k3/2+k4/dt);
D8 := (2*dt/(2*C+dt))*(k3/2-k4/dt);
D9 := (2*dt/(2*C+dt))*(-k3/2-k4/dt);
D10 := (2*dt/(2*C+dt))*(-k3/2+k4/dt);

ShowD;

Xp := a0+a1*t0+a2*t0*t0+a3*t0*t0*t0+a4*t0*t0*t0*t0;
Gp := b0+b1*t0+b2*t0*t0;
k1 := c0+c1*Xp+c2*Xp*Xp;
D3 := k1*dt/(2*A+B*dt);
Yp := Y0;
Fp := F0;
Zp := Z0;

StringGrid1.RowCount := N+1;
StringGrid1.Cells[0,1] := '0';
StringGrid1.Cells[1,1] := FloatToStr(t0);//, ffFixed, 8,6);
StringGrid1.Cells[2,1] := FloatToStrF(Xp, ffFixed, 12,10);
StringGrid1.Cells[3,1] := FloatToStr(Gp);//, ffFixed, 8,6);
StringGrid1.Cells[4,1] := FloatToStr(k1);//, ffFixed, 8,6);
StringGrid1.Cells[5,1] := FloatToStr(D3);//, ffFixed, 8,6);
StringGrid1.Cells[6,1] := FloatToStrF(Yp, ffFixed, 12,10);
StringGrid1.Cells[7,1] := FloatToStrF(Fp, ffFixed, 12,10);
StringGrid1.Cells[8,1] := FloatToStrF(Zp, ffFixed, 12,10);
sX.Clear;
SG.Clear;
sY.Clear;
sz.Clear;
sF.Clear;
sX.AddXY(t0,Xp);
sG.AddXY(t0,Gp);
sY.AddXY(t0,Yp);
sZ.AddXY(t0,Zp);
sF.AddXY(t0,Fp);
Result[0,0] := 0;
Result[0,1] := t0;
Result[0,2] := Xp;
Result[0,3] := Gp;
Result[0,4] := k1;
Result[0,5] := D3;
Result[0,6] := Yp;
Result[0,7] := Fp;
Result[0,8] := Zp;

for I := 2 to N do begin
t := t0+(i-1)*dt;
X := a0+a1*t+a2*t*t+a3*t*t*t+a4*t*t*t*t;
G := b0+b1*t+b2*t*t;
k1 := c0+c1*X+c2*X*X;
D3 := k1*dt/(2*A+B*dt);
Matrix[0, 0] := 1;
Matrix[0, 1] := -D5;
Matrix[0, 2] := 0;
Matrix[1, 0] := -D2;
Matrix[1, 1] := 1;
Matrix[1, 2] := -D4;
Matrix[2, 0] := -D7;
Matrix[2, 1] := 0;
Matrix[2, 2] := 1;
Matrix[0, 3] := Yp+Fp*D5;
Matrix[1, 3] := Fp*D1+Yp*D2+X*D3+Xp*D3+Zp*D4;
Matrix[2, 3] := Zp*D6+Yp*D8+G*D9+Gp*D10;

Gauss(3,Matrix,YZ,S);

StringGrid1.Cells[0,i] := IntToStr(i-1);
StringGrid1.Cells[1,i] := FloatToStr(t);//, ffFixed, 8,6);
StringGrid1.Cells[2,i] := FloatToStrF(X, ffFixed, 12,10);
StringGrid1.Cells[3,i] := FloatToStr(G);//, ffFixed, 8,6);
StringGrid1.Cells[4,i] := FloatToStr(k1);//, ffFixed, 8,6);
StringGrid1.Cells[5,i] := FloatToStr(D3);//, ffFixed, 8,6);
StringGrid1.Cells[6,i] := FloatToStrF(YZ[0], ffFixed, 12,10);
StringGrid1.Cells[7,i] := FloatToStrF(YZ[1], ffFixed, 12,10);
StringGrid1.Cells[8,i] := FloatToStrF(YZ[2], ffFixed, 12,10);

Result[i-1,0] := i-1;
Result[i-1,1] := t;
Result[i-1,2] := X;
Result[i-1,3] := G;
Result[i-1,4] := k1;
Result[i-1,5] := D3;
Result[i-1,6] := YZ[0];
Result[i-1,7] := YZ[1];
Result[i-1,8] := YZ[2];

sX.AddXY(t,X);
sG.AddXY(t,G);
sY.AddXY(t,YZ[0]);
sZ.AddXY(t,YZ[2]);
sF.AddXY(t,YZ[1]);

Gp := G;
Xp := X;
Yp := YZ[0];
Fp := YZ[1];
Zp := YZ[2];
end;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Image1.Visible := N5.Checked;
Splitter4.Visible := N5.Checked;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
ColorDialog1.Color := Chart1.Gradient.StartColor;
if ColorDialog1.Execute then
Chart1.Gradient.StartColor := ColorDialog1.Color;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
ColorDialog1.Color := Chart1.Gradient.EndColor;
if ColorDialog1.Execute then
Chart1.Gradient.EndColor := ColorDialog1.Color;
end;

function TForm1.RefToCells(Arow, Acol: integer): string;
begin
Result:=Chr(Ord('A')+Acol-1)+IntToStr(Arow);
end;

procedure TForm1.ShowD;
begin
ValueListEditor2.Cells[1,1] := FloatToStrF(D1,ffFixed,8,6);
ValueListEditor2.Cells[1,2] := FloatToStrF(D2,ffFixed,8,6);
ValueListEditor2.Cells[1,3] := FloatToStrF(D4,ffFixed,8,6);
ValueListEditor2.Cells[1,4] := FloatToStrF(D5,ffFixed,8,6);
ValueListEditor2.Cells[1,5] := FloatToStrF(D6,ffFixed,8,6);
ValueListEditor2.Cells[1,6] := FloatToStrF(D7,ffFixed,8,6);
ValueListEditor2.Cells[1,7] := FloatToStrF(D8,ffFixed,8,6);
ValueListEditor2.Cells[1,8] := FloatToStrF(D9,ffFixed,8,6);
ValueListEditor2.Cells[1,9] := FloatToStrF(D10,ffFixed,8,6);

end;

procedure TForm1.ValueListEditor1KeyPress(Sender: TObject; var Key: Char);
var TKey : Char;
begin
TKey := Key;
Key := #0;
case TKey of
#13: begin
if ValueListEditor1.Row = ValueListEditor1.RowCount - 1 then
ValueListEditor1.Row := 0
else ValueListEditor1.Row := ValueListEditor1.Row + 1;
end;
'0'..'9', #8,'-': Key := TKey;
'.',',': Key := DecimalSeparator;
end;
end;

end.