FreeAndNil(item[i]);
destroy_flag:=True;
for j:=i to item_index-2 do item[j]:=item[j+1];
item_index:=item_index-1;
end;
for k := 0 to SelectedLinks.Count - 1 do
begin
Sel_Link := SelectedLinks.Items[k];
i := 1;
while (i < Link_index) and (links[i]<>Sel_Link) do
Inc(i);
if i = Link_Index then Continue;
try
links[i].Free;
except
end;
links[i] := nil;
for j:=i to link_index-2 do
begin
links[j]:=links[j+1];
end;
links[link_index-1] := nil;
link_index:=link_index-1;
end;
current_item := 1;
SelectedItems.Clear;
SelectedLinks.Clear;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var form:TInputDlg;
begin
form:=TInputDlg.Create(form1);
form.ShowModal;
t:=StrToFloat(form.Edit1.Text);
ht:=StrToFloat(form.Edit2.Text);
e:=StrToFloat(form.Edit3.Text);
method:=form.RadioGroup1.ItemIndex;
desc:=form.Edit4.Text;
form.Destroy;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//ShellExecute();
end;
end.
Главный модуль прграммы расчётов.
unit modell;
interface
uses classes, stdctrls, graphics, extctrls, QUICKRPT, QRCTRLS, qrprntr,
ShellAPI, Windows, ComObj, inifiles,
types, model_edit_dlg,
model_param_dlg, visual_dlg, report_dlg, waitreportcreate_dlg;
type
TCount=record
Masses, Relations: integer;
end;
TMethod=record
code : TFloat;
digree: integer;
end;
TModel = class(TAbstractObject)
public
Count: TCount;
flIsSaved : boolean; // flag of is model saved
flIsModelling: boolean;
constructor Create;
destructor Destroy; override;
procedure AddElement; virtual;
function ShowDialog(wind: integer): integer;
procedure SaveModel(FileName: string); virtual;
function LoadModel(FileName: string):boolean; virtual;
procedure SetParamsInZero; virtual;
procedure Visio; virtual;
procedure ShowReport(FName: string); virtual;
procedure MakeReport(FName: string); virtual;
protected
t: TFloat; //time
ht: TFloat; // time step
e: TFloat; // inaccuracy
CalcMethod: TMethod; // digital modelling method
WDoc: variant; //for winword report automation;
NewElement: TObject; //current created element
flReadFromFile: boolean; // flag - true if now data read from file
Editor: TEditDlg;
VisualDlg: TVisualDlg;
ReportDlg: TReportDlg;
WaitReportCreateDlg: TWaitReportCreateDlg;
procedure InitInputParamDlg; override;
procedure InitParameters; override;
procedure DeleteElement; virtual;
function EditElementParams: integer; virtual;
procedure ClearData; virtual;
procedure SaveToFile(Stream: TStream);override;
procedure SaveToIniFile(iniF: TIniFile; Section: string);override;
procedure LoadFromFile(Stream: TStream); override;
procedure LoadFromIniFile(IniF: TIniFile; Section: string); override;
procedure EditorOnHide(Sender: TObject); virtual;
procedure ListBox1Click(Sender: TObject); virtual;
procedure ListBox1DblClick(Sender: TObject); virtual;
procedure SpeedButton1Click(Sender: TObject); virtual;
procedure SpeedButton2Click(Sender: TObject); virtual;
procedure OnChangeModelName(Sender: TObject); virtual;
procedure OnClickOkButtonOnParamDlg(Sender: TObject); virtual;
procedure OnClickOkButtonOnEditorDlg(Sender: TObject); virtual;
procedure OnClickToolButton(Sender: TObject); virtual;
procedure CheckState;
function ElementPos(elType: boolean; var elPos: integer):integer; virtual;
function CheckModel: boolean;
procedure Calculate(Sender: TObject); virtual;
procedure ShowGraphs(Sender: TObject); virtual;
procedure HideGraphs(Sender: TObject); virtual;
procedure ModelInformation(Sender: TObject); virtual;
function GetModelInformation:string; virtual;
function MakeReportDlg(where: integer): integer;
function CreateReport(FName: string): boolean;
procedure OnClickSeriesCheckBox(Sender: TObject); virtual;
procedure OnClickSaveButtonOnReportDlg(Sender: TObject); virtual;
procedure WaitReportCreateDlgOnShow(Sender: TObject); virtual;
private
TempFName: string;
end;
var
Model : TModel;
implementation
uses SysUtils, Dialogs, Controls, Comctrls, clipbrd, Chart, TeEngine, Series,
Imglist,
main, massa, relation;
constructor TModel.Create;
var
i: integer;
ResType: TResType;
flType: boolean;
s: shortstring;
begin
inherited Create;
Count.Masses:=0;
Count.Relations:=0;
flIsSaved:=true;
VisualDlg:=TVisualDlg.CreateParented(0);
VisualDlg.Timer1.OnTimer:=Calculate;
VisualDlg.ToolButton3.OnClick:=ShowGraphs;
VisualDlg.ToolButton4.OnClick:=ModelInformation;
VisualDlg.OnHide:=HideGraphs;
with Editor do
begin
OnHide:=EditorOnHide;
ListBox1.OnClick:=ListBox1Click;
ListBox1.OnDblClick:=ListBox1DblClick;
SpeedButton1.OnClick:=SpeedButton1Click;
SpeedButton2.OnClick:=SpeedButton2Click;
Edit1.OnChange:=OnChangeModelName;
if ClassList.Count>0 then
for i:=0 to ClassList.Count-1 do begin
if StrUpper(PChar(ExtractFileExt(TToolButton(ClassList.Items[i]).Caption)))='.BMP'
then ResType:=rtBitmap
else ResType:=rtIcon;
if not ImageList1.FileLoad(ResType, TToolButton(ClassList.Items[i]).Caption, clBtnFace)
then ImageList1.Add(nil,nil);
TToolButton(ClassList.Items[i]).ImageIndex:=i;
TToolButton(ClassList.Items[i]).OnClick:=OnClickToolButton;
flType:=TToolButton(ClassList.Items[i]).Wrap;
TToolButton(ClassList.Items[i]).Wrap:=false;
if flType then
ToolBar1.InsertControl(TToolButton(ClassList.Items[i]))
else
ToolBar2.InsertControl(TToolButton(ClassList.Items[i]));
end;
ToolBar2.Enabled:=false;
end;
WaitReportCreateDlg:=TWaitReportCreateDlg.CreateParented(0);
WaitReportCreateDlg.OnActivate:=WaitReportCreateDlgOnShow;
NewElement:=nil;
flReadFromFile:=false;
flIsModelling:=false;
i:=GetEnvironmentVariable('TEMP',@s[1],255);
SetLength(s,i);
TempFName:=s+'\$$$_mdl_$$$.';
end;
destructor TModel.Destroy;
begin
inherited Destroy;
ClearData;
Editor.Destroy;
VisualDlg.Destroy;
ClassList.Destroy;
WaitReportCreateDlg.Destroy;
end;
procedure TModel.InitInputParamDlg;
begin
TInputDlg(InputParamDlg):=TInputDlg.CreateParented(0);
TInputDlg(InputParamDlg).OKBtn.OnClick:=OnClickOkButtonOnParamDlg;
TInputDlg(InputParamDlg).OnHide:=OnHideParamDlg;
Editor:=TEditDlg.CreateParented(0);
Editor.OKBtn.OnClick:=OnClickOkButtonOnEditorDlg;
end;
procedure TModel.InitParameters;
begin
t:=10;
Params.Add(TParam.Create(@t, varDouble, 'T', 0.001, 1e20, TInputDlg(InputParamDlg).Edit1)); //t
ht:=0.01;
Params.Add(TParam.Create(@ht, varDouble, 'Ht', 1e-10, 10, TInputDlg(InputParamDlg).Edit2)); //ht
e:=1;
Params.Add(TParam.Create(@e, varDouble, 'E', 0.00001, 1, TInputDlg(InputParamDlg).Edit3)); //e
CalcMethod.code:=0;
Params.Add(TParam.Create(@CalcMethod.code, varDouble,'Method', 0, 3, nil)); //CalcMethod
ObjName:='Колебательная система';
Params.Add(TParam.Create(@ObjName, varString, 'Description', '', '', Editor.Edit1)); //string description
end;
procedure TModel.OnClickOkButtonOnEditorDlg(Sender: TObject);
begin
Model.GetParams;
end;
procedure TModel.OnClickOkButtonOnParamDlg(Sender: TObject);
begin
inherited OnClickOkButtonOnParamDlg(Sender);
if Editor.ListBox1.Items.Count > 0 then flIsSaved:=false;
CalcMethod.code:=TInputDlg(InputParamDlg).RadioGroup1.ItemIndex;
end;
procedure TModel.ClearData;
var i: integer;
begin
if Editor.ListBox1.Items.Count > 0 then
for i:=0 to Editor.ListBox1.Items.Count-1 do
TAbstractElement(Editor.ListBox1.Items.Objects[i]).Destroy;
flIsSaved:=true;
Count.Masses:=0;
Count.Relations:=0;
with Editor do ListBox1.Clear;
flIsModelling:=false;
end;
function TModel.ShowDialog(wind: integer) :integer;
begin
case wind of
0: Result:=Editor.ShowModal;
1: Result:=InputParamDlg.ShowModal;
2: Result:=MakeReportDlg(1);
end;
end;
procedure TModel.EditorOnHide(Sender: TObject);
begin
if not flIssaved then
flIsSaved:= (Editor.ListBox1.Items.Count=0);
end;
procedure TModel.OnChangeModelName(Sender: TObject);
begin
flIsSaved:= false;
end;
procedure TModel.ListBox1Click(Sender: TObject);
begin
with Editor do
begin
Memo1.Lines.Clear;
Memo1.Lines.Append(TAbstractElement(ListBox1.Items.Objects[ListBox1.ItemIndex]).AboutStr);
end;
end;
procedure TModel.ListBox1DblClick(Sender: TObject);
begin
SpeedButton2Click(Sender);
end;
procedure TModel.SpeedButton1Click(Sender: TObject);
var
index: integer;
s:string;
begin
with Editor do
if ListBox1.ItemIndex>=0 then
begin
if MessageDlg('Удалить элемент'#10+ListBox1.Items.Strings[ListBox1.ItemIndex],
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
index:=ListBox1.ItemIndex;
s:=ListBox1.Items.Strings[index];
DeleteElement;
ListBox1.Items.Delete(ListBox1.ItemIndex);
Memo1.Lines.Clear;
CheckState;
end
else ListBox1.SetFocus;
end;
procedure TModel.SpeedButton2Click(Sender: TObject);
begin
with Editor do
if ListBox1.ItemIndex>=0 then begin
if EditElementParams =1 then begin
ListBox1Click(Sender);
flIsSaved:=false;
end;
end
else ListBox1.SetFocus;
end;
procedure TModel.OnClickToolButton(Sender: TObject);
begin
try
NewElement:=TNewObject(TToolButton(Sender).Tag);
if not flReadFromFile then AddElement;
except raise ERangeError.Create('Критическая ошибка. Недостаточно памяти');
end;
end;
procedure TModel.CheckState;
begin
with Editor do begin
ToolBar2.Enabled:= Count.Masses>1;
SpeedButton1.Enabled:= ListBox1.Items.Count <>0;
SpeedButton2.Enabled:= SpeedButton1.Enabled;
end;
end;
function TModel.ElementPos(elType: boolean; var elPos: integer):integer;
var
i,n1,n2: integer;
begin
elPos:=0;
Result:=1;
if Editor.ListBox1.Items.Count=0 then exit;
n1:=0;
for i:=0 to Editor.ListBox1.Items.Count-1 do
if TAbstractElement(Editor.ListBox1.Items.Objects[i]).flType = elType then
begin
n2:=StrToInt(Copy(Editor.ListBox1.Items.Strings[i],Pos(' ',Editor.ListBox1.Items.Strings[i]),
length(Editor.ListBox1.Items.Strings[i])));
if (n2-n1)>1 then
begin
break;
end
else n1:=n2;
end;
elPos:=i;
Result:=n1+1;
end;
procedure TModel.AddElement;
var
ps,i: integer;
begin
i:=ElementPos(TAbstractElement(NewElement).flType,ps);
if TAbstractElement(NewElement).flType then
TAbstractElement(NewElement).InputParamDlg.Caption:='Масса '+IntToStr(i)
else
TAbstractElement(NewElement).InputParamDlg.Caption:='Связь '+IntToStr(i);
if (TAbstractElement(NewElement).InputParamDlg.ShowModal=mrOk) then begin
TAbstractElement(NewElement).ObjName:=TAbstractElement(NewElement).InputParamDlg.Caption;
TAbstractElement(NewElement).GraphDlg.Caption:=TAbstractElement(NewElement).ObjName;
Editor.ListBox1.Items.InsertObject(ps,TAbstractElement(NewElement).ObjName, NewElement);
if TAbstractElement(NewElement).flType then inc(Count.Masses)
else inc(Count.Relations);
NewElement:=nil;
flIsSaved:=false;
CheckState;
end
else TAbstractElement(NewElement).Destroy;
end;
function TModel.EditElementParams: integer;
begin
with Editor do
Result:=TAbstractElement(ListBox1.Items.Objects[ListBox1.ItemIndex]).InputParamDlg.ShowModal;
end;
procedure TModel.DeleteElement;
var
num, code, i, index: integer;
flag: boolean;
s: string;
begin
with Editor do
begin
index:=ListBox1.ItemIndex;
s:=ListBox1.Items.Strings[index];
end;
val(Copy(s,Pos(' ', s)+1, length(s)), num, code);
flag:=TAbstractElement(Editor.ListBox1.Items.Objects[Editor.ListBox1.ItemIndex]).flType;
if flag then begin
for i:=0 to Editor.ListBox1.Items.Count-1 do
if not TAbstractElement(Editor.ListBox1.Items.Objects[i]).flType then
if (TAbstractRelation(Editor.ListBox1.Items.Objects[i]).m1=num) or
(TAbstractRelation(Editor.ListBox1.Items.Objects[i]).m2=num) then begin
MessageDlg(TAbstractRelation(Editor.ListBox1.Items.Objects[i]).InputParamDlg.Caption+
' была присоединена к удаляемой массе.'#10'Откорректируйте параметры элемента '+
TAbstractRelation(Editor.ListBox1.Items.Objects[i]).InputParamDlg.Caption,
mtWarning, [mbOk], 0);
TAbstractRelation(Editor.ListBox1.Items.Objects[i]).InputParamDlg.ShowModal;
end;
dec(Count.Masses);
end
else dec(Count.Relations);
TAbstractElement(Editor.ListBox1.Items.Objects[Editor.ListBox1.ItemIndex]).Destroy;
flIsSaved:=false;
end;
procedure TModel.SaveToIniFile(iniF: TIniFile; Section: string);
var i: integer;
begin
inherited SaveToIniFile(iniF,Section);
try
for i:=0 to Editor.ListBox1.Items.Count-1 do
TAbstractElement(Editor.ListBox1.Items.Objects[i]).SaveToIniFile(iniF, IntToStr(i));
except
raise ERangeError.Create('Ошибка записи');
end;
end;
procedure TModel.SaveToFile(Stream: TStream);
var i: integer;
begin
inherited SaveToFile(Stream);
try
for i:=0 to Editor.ListBox1.Items.Count-1 do
TAbstractElement(Editor.ListBox1.Items.Objects[i]).SaveToFile(Stream);
except
raise ERangeError.Create('Ошибка записи');
end;
end;
procedure TModel.SaveModel(FileName: string);
var
Stream: TStream;
IniF: TIniFile;
Ext: string;
begin
Ext:=UpperCase(ExtractFileExt(FileName));
if Ext='.MDL' then
begin
try
Stream:= TFileStream.Create(FileName, fmCreate);
SaveToFile(Stream);
finally
Stream.Free;
end;
end
else begin
try
IniF:=TIniFile.Create(FileName);
SaveToIniFile(IniF,'Model');
finally
IniF.Free;
end;
end;
end;
procedure TModel.LoadFromIniFile(IniF: TIniFile; Section: string);
var
i: integer;
InstControl: TControl;
InstComponentName: string;
begin
inherited LoadFromIniFile(IniF, Section);
i:=0;
while IniF.SectionExists(IntToStr(i)) do
begin
Section:=IntToStr(i);
InstComponentName:=IniF.ReadString(Section,'Class','');
InstControl:=Editor.FindControl(InstComponentName);
if InstControl<>nil then
begin
TToolButton(InstControl).OnClick(InstControl);
TAbstractElement(NewElement).LoadFromIniFile(IniF, Section);
Editor.ListBox1.Items.AddObject(TAbstractElement(NewElement).ObjName, NewElement);
TAbstractElement(NewElement).InputParamDlg.Caption:=TAbstractElement(NewElement).ObjName;
TAbstractElement(NewElement).GraphDlg.Caption:=TAbstractElement(NewElement).ObjName;
if TAbstractElement(NewElement).flType then inc(Count.Masses)
else inc(Count.Relations);
end
else MessageDlg('Неизвестный компонент "'+InstComponentName+'"', mtError, [mbOk], 0 );
CheckState;
inc(i);
end;
end;
procedure TModel.LoadFromFile(Stream: TStream);
var
InstControl: TControl;
InstComponentName: string;
begin
try
InstComponentName:=LoadStrFromStream(Stream);
if InstComponentName<>InstName then
begin
MessageDlg('Файл не содержит необходимых данных', mtError, [mbOk], 0 );
exit;
end;
inherited LoadFromFile(Stream);
while Stream.Position < Stream.Size do
begin
InstComponentName:=LoadStrFromStream(Stream);
InstControl:=Editor.FindControl(InstComponentName);
if InstControl<>nil then