Материалы представленные на сайте исключительно с целью ознакомления пользователям Интернета и не преследуют коммерческих целей или нарушение авторских прав.
© 2018 - 2025
1 Савчук В.П. Оценка инвестиционных проектов. – На сайте:
2 Каблуков В.В. Модели оценки рисков стратегических инвестиционных проектов: Дис…кандидата экономических наук. – Санкт-Петербург, 1999. – 167 с.
3 http://sedok.narod.ru/inv_risk_calc.html - Бессонов Д.А. Оценка риска инвестиционного проекта
4 Абрамов С.И. Инвестирование. – М.: Центр экономики и маркетинга, 2000.
5 Виленский В.Л., Лифшиц В.Н., Смоляк С.А. Оценка эффективности инвестиционных проектов. Теория и практика. – М. Дело, 2001.
6 Недосекин О.А. Нечетко-множественный анализ рисков фондовых инвестиций. – СПб.: Сезам, 2003.
7 Моделирование рисковых ситуаций в экономике и бизнесе / Дубров А.М., Лагоша Б.А., Хрусталев Е.Ю. и др.; Под ред. Б.А.Лагоша; М.: Финансы и статистика, 2001.
8 Лапуста М.Г., Шаршукова Л.Г. Риски в предпринимательской деятельности. – М.: Инфра, 1998.
9 http://www.cfin.ru/finanalysis/quant_risk.shtml - Дмитриев М.Н., Кошечкин С.А. Количественный анализ риска инвестиционных проектов.
10 Козинцев Т.О. – Использование техники динамического моделирования в менеджменте процентных рисков. – М.: Диалог-МГУ, 2000.
11 Заде Л. - Понятие лингвистической переменной и ее применение к принятию приближенных решений, М., Мир, 1976.
12 Беллман Р., Заде Л. – Принятие решений в расплывчатых условиях // Вопросы анализа и процедуры принятия решения. – М.: Мир, 1976.
13 Кофман А. – Введение в теорию нечетких множеств. – М.: Радио и связь, 1982.
14 Кофман А., Хил Алуха Х. - Введение теории нечетких множеств в управлении предприятиями, Минск, Вышэйшая школа, 1992.
15 http://sedok.narod.ru/sc_group.html - Недосекин О.А. Оценка риска инвестиций по NPV произвольно-нечеткой формы.
16 http://sedok.narod.ru/sc_group.html - Недосекин О.А., Кокош А.М. Оценка риска инвестиций для произвольно-размытых факторов инвестиционного проекта.
17 Смирнов А.П., Якунин А.Г.. Модель управления операциями участка «сталь-прокат» в классе нечетких систем // Черная металлургия. – 2001. - №3.
18 Прикладные нечеткие системы: пер. с япон. / К.Асаи, Д.Ватада, С.Иваи и др.; под. ред. Т.Тэрано, К.Асаи, М.Сугэно. – М.: Мир, 1993.
19 Бабайцев И.В., Варенков А.Н., Потоцкий Е.П. Безопасность жизнедеятельности и экология в дипломной работе. Учебное пособие. – М.: мисис, 1997.
20 ГОСТ 12.0.003-74. Опасные и вредные производственные факторы. Классификация. – М.: Издательство стандартов, 1975.
21СНиП 2.01.02-85. Противопожарные нормы. – М.: Стройиздат, 1986.
22 НПБ 105-95. Определение категорий помещений и зданий по взрывопожарной и пожарной опасности. М.:МВД РФ. Государственная противопожарная служба, 1995.
23 ГОСТ 12.1.030-81. Электробезопасность. Защитное заземление. Зануление. - М.: Издательство стандартов, 1981.
24 СанПиН 2.2.542-96. Гигиенические требования к видеодисплейным терминалам, персональным электронно-вычислительным машинам и организации работы. – М.: Госкомсанэпиднадзор России, 1996.
25 Учебное пособие по разделам «Безопасность жизнедеятельности» и «Охрана окружающей природной среды» в дипломной работе / под ред. проф. Б.С.Мастрюкова – М.: мисис, 2000.
Приложение Б. Текст программы
unit datamodul;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls, Spin, Menus;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
SpinEdit1: TSpinEdit;
Label3: TLabel;
Edit1: TEdit;
StringGrid1: TStringGrid;
Label4: TLabel;
StringGrid2: TStringGrid;
Label5: TLabel;
StringGrid3: TStringGrid;
CheckBox1: TCheckBox;
StringGrid4: TStringGrid;
Label6: TLabel;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
Label7: TLabel;
Edit2: TEdit;
N5: TMenuItem;
N9: TMenuItem;
GroupBox1: TGroupBox;
Label8: TLabel;
Edit3: TEdit;
Label9: TLabel;
Edit4: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid2KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid3KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid4KeyPress(Sender: TObject; var Key: Char);
procedure CheckBox1Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure N5Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
i,j,n,nRt : integer; {циклич.пер-е, кол-во ПУП,кол-во ПУП для рассчета Rt}
Ir,G : real; {соб.кап вложения для Rt, критерий эффективности}
Ip : array[1..3] of real; {макс. и мин-е значение первонач.кап.вложений}
RSvar,Rdvar,Vt : array[1..20] of real;{реальное значение Si и di для подсчета Rt, кр.риска}
dvar : array[1..3,1..20] of real; {безриск.%ставка 1-я строка - мин, 2 - макс.}
Svar,NPVvar,Rt : array[1..3,1..20] of real; {интервалы ден.потоков 1 строка - мин,2 - сред.зн.,3 - макс,NPV-массив,кр.ликвидности}
At,Zt,Ct : array[1..2,1..20] of real; {соб,заем средства, кр.покрытия 1- мин, 2- макс}
mCt,mVt,mRt : array[1..4,1..20] of real; {массивы функций принадлежностей к риску}
kCt,kVt,kRt,kre : array[1..3] of real; {массивы верхних границ весов для оценки риска, 1- минимальный, 4 - недопустимый}
implementation
uses Rtmodul, Rezaltmodul, Formirmodul, mmodul, Rulermodul;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
n:=SpinEdit1.Value;
StringGrid1.ColCount:=n;
StringGrid2.ColCount:=n;
StringGrid3.ColCount:=n;
StringGrid4.ColCount:=n;
Checkbox1.Checked:=false;
kCt[1]:=0.25;kCt[2]:=0.5;kCt[3]:=0.75;
kRt[1]:=0.25;kRt[2]:=0.5;kRt[3]:=0.75;
kVt[1]:=0.05;kVt[2]:=0.1;kVt[3]:=0.2;
kre[1]:=0.25;kre[2]:=0.5;kre[3]:=0.75;
for j:=0 to n-1 do begin
StringGrid1.Cells[j,0]:=IntToStr(j+1);
StringGrid2.Cells[j,0]:=IntToStr(j+1);
StringGrid3.Cells[j,0]:=IntToStr(j+1);
StringGrid4.Cells[j,0]:=IntToStr(j+1);
RSvar[j+1]:=0;Rdvar[j+1]:=0;
end;
Rtkey:=false; Ir:=0;nRt:=0;
end;
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
n:=SpinEdit1.Value; CheckBox1.Checked:=false;
Form4.StringGrid1.ColCount:=n+1; Form4.StringGrid2.ColCount:=n+1; Form2.SpinEdit1.Value:=n;
Form3.StringGrid1.RowCount:=n+1; Form3.StringGrid2.RowCount:=n+1;
StringGrid1.ColCount:=n; StringGrid2.ColCount:=n; StringGrid3.ColCount:=n; StringGrid4.ColCount:=n;
for j:=0 to n-1 do begin
StringGrid1.Cells[j,0]:=IntToStr(j+1); StringGrid2.Cells[j,0]:=IntToStr(j+1); StringGrid3.Cells[j,0]:=IntToStr(j+1);
StringGrid4.Cells[j,0]:=IntToStr(j+1);
Form3.StringGrid1.Cells[0,j+1]:=IntToStr(j+1);Form3.StringGrid2.Cells[0,j+1]:=IntToStr(j+1);
Form4.StringGrid1.Cells[j+1,0]:=IntToStr(j+1); Form4.StringGrid2.Cells[j+1,0]:=IntToStr(j+1);
end;
end;
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(59),chr(44),chr(8):;
else key:=chr(0); end;
end;
procedure TForm1.StringGrid2KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(59),chr(44),chr(8):;
else key:=chr(0); end;
end;
procedure TForm1.StringGrid3KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(59),chr(44),chr(8):;
else key:=chr(0);end;
end;
procedure TForm1.StringGrid4KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(59),chr(44),chr(8):;
else key:=chr(0);end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
case CheckBox1.State of
cbChecked: begin
StringGrid4.ColCount:=1; Stringgrid4.RowCount:=1; StringGrid4.FixedCols:=0; StringGrid4.FixedRows:=0;
end;
cbUnchecked: begin
StringGrid4.ColCount:=n; Stringgrid4.RowCount:=2; StringGrid4.FixedCols:=0; StringGrid4.FixedRows:=1;
For j:=1 to n do begin StringGrid4.Cells[j-1,0]:=IntToStr(j); end;
end;
end;
end;
procedure TForm1.N8Click(Sender: TObject);
var
str,str2,str3 : string;
k,ii,iv,re : integer;
Cto,Rto : array[1..20] of real; // массивы обобщенных значений Ct и Rt
smax,smin,sav,min,A1,A2,B1,B2,C1,C2,K1,K2,vr,vrz,vrch,mvr1,mvr2,mvr3,mvr4 : real;
begin
//-------------------------------ввод критерия эффективности
try G:=StrToFloat(Edit2.Text);
Except G:=0;Edit2.Text:=IntToStr(0); end;
//-------------------------------ввод первонач. ден кап
str:=Edit1.Text;
if pos(';',str)<>0 then begin str2:=''; k:=1;
for i:=1 to Length(str) do begin
if (str[i]<>';') then str2:=str2+str[i]
else begin
Ip[k]:=StrToFloat(str2);
str2:='';
k:=k+1;
end;
if i=Length(str) then Ip[k]:=StrToFloat(str2);
end;
end else begin
try
Ip[1]:=StrToFloat(str); Ip[2]:=StrToFloat(str); Ip[3]:=StrToFloat(str);
except
showmessage('Ошибка при вводе значения первоначальных капиталовложений!'); FocusControl(Edit1);
end;
end;
//------------------------------ввод массива денежных потоков:
for j:=0 to n-1 do begin
str:=StringGrid1.Cells[j,1];
if pos(';',str)<>0 then begin str2:='';k:=1;
for i:=1 to Length(str)do begin
if (str[i]<>';') then str2:=str2+str[i]
else begin
Svar[k,j+1]:=StrToFloat(str2);
k:=k+1;str2:='';
end;
if i=Length(str) then Svar[k,j+1]:=StrToFloat(str2);
end;
end else try
Svar[1,j+1]:=StrToFloat(str); Svar[2,j+1]:=StrToFloat(str); Svar[3,j+1]:=StrToFloat(str);
except
showmessage('Ошибка при вводе значений интервалов денежных потоков!'); FocusControl(Stringgrid1);
end;
end;
//----------------------------ввод массива соб.и заем. средств
for j:=0 to n-1 do begin
str:=StringGrid2.Cells[j,1];
str3:=StringGrid3.Cells[j,1];
if pos(';',str)<>0 then begin str2:='';k:=1;
for i:=1 to Length(str)do begin
if (str[i]<>';') then str2:=str2+str[i]
else begin
At[k,j+1]:=StrToFloat(str2);
k:=k+1;str2:='';
end;
if i=Length(str) then At[k,j+1]:=StrToFloat(str2);
end;
end else try
At[1,j+1]:=StrToFloat(str);
At[2,j+1]:=StrToFloat(str);
except
showmessage('Ошибка при вводе значений собственных средств!');
FocusControl(StringGrid2);
end;
if pos(';',str3)<>0 then begin str2:='';k:=1;
for i:=1 to Length(str3)do begin
if (str3[i]<>';') then str2:=str2+str3[i]
else begin
Zt[k,j+1]:=StrToFloat(str2);
k:=k+1;str2:='';
end;
if i=Length(str3) then Zt[k,j+1]:=StrToFloat(str2);
end;
end else try
Zt[1,j+1]:=StrToFloat(str3);
Zt[2,j+1]:=StrToFloat(str3);
except
showmessage('Ошибка при вводе значений заемных средств!');
FocusControl(StringGrid3);
end;
end;
//------------------------Ввод массива безриск.% ставки
case CheckBox1.State of
cbChecked: begin
str:=StringGrid4.Cells[0,0];
if pos(';',str)<>0 then begin str2:='';k:=1;
for i:=1 to Length(str)do begin
if (str[i]<>';') then str2:=str2+str[i]
else begin
dvar[k,1]:=StrToFloat(str2);
k:=k+1;str2:='';
end;
if i=Length(str) then dvar[k,1]:=StrToFloat(str2);
end;
end else begin try
dvar[1,1]:=StrToFloat(str);
dvar[2,1]:=StrToFloat(str);
dvar[3,1]:=StrToFloat(str);
except
showmessage('Ошибка при вводе значения безрисковой процентной ставки!');
FocusControl(Stringgrid4);
end; end;
for i:=2 to n do begin
dvar[1,i]:=dvar[1,1];
dvar[2,i]:=dvar[2,1];
dvar[3,i]:=dvar[2,1];
end;
end;
cbUnchecked: begin
for j:=0 to n-1 do begin
str:=StringGrid4.Cells[j,1];
if pos(';',str)<>0 then begin str2:='';k:=1;
for i:=1 to Length(str)do begin
if (str[i]<>';') then str2:=str2+str[i]
else begin
dvar[k,j+1]:=StrToFloat(str2);
k:=k+1;str2:='';
end;
if i=Length(str) then dvar[k,j+1]:=StrToFloat(str2);
end;
end else try
dvar[1,j+1]:=StrToFloat(str);
dvar[2,j+1]:=StrToFloat(str);
dvar[3,j+1]:=StrToFloat(str);
except
showmessage('Ошибка при вводе значений безрисковой процентной ставки!');
FocusControl(Stringgrid4);
end;
end;
end;end;
//------------------------------Рассчет значения коэф-та покрытия Сt
for i:=1 to n do begin
Ct[1,i]:=1;
Ct[2,i]:=1;
end;
for i:=1 to n do begin
if Zt[2,i]<>0 then Ct[1,i]:=At[1,i]/Zt[2,i];
if Zt[1,i]<>0 then Ct[2,i]:=At[2,i]/Zt[1,i];
j:=3;
if (Ct[1,i]*Ct[2,i])<=(kCt[1]*kCt[1]) then Cto[i]:=(Ct[1,i]*Ct[2,i])/(kCt[1]*kCt[1]);
if ((Ct[1,i]*Ct[2,i])>(kCt[1]*kCt[1]))and (Ct[1,i]*Ct[2,i]<=(kCt[2]*kCt[2]))then j:=0;
if ((Ct[1,i]*Ct[2,i])>(kCt[2]*kCt[2]))and (Ct[1,i]*Ct[2,i]<=(kCt[3]*kCt[3])) then j:=1;
if ((Ct[1,i]*Ct[2,i])>(kCt[3]*kCt[3]))and (Ct[1,i]*Ct[2,i]<1) then j:=2;
if (Ct[1,i]*Ct[2,i]>=1) then Cto[i]:=1;
if (j = 0) or (j = 1) then
Cto[i]:=kCt[1+j]+((((Ct[1,i]*Ct[2,i])-(kCt[1+j]*kCt[1+j]))*(kCt[2+j]-kCt[1+j]))/((kCt[2+j]*kCt[2+j])-(kCt[1+j]*kCt[1+j])));
if j = 2 then
Cto[i]:=kCt[1+j]+((((Ct[1,i]*Ct[2,i])-(kCt[1+j]*kCt[1+j]))*(1-kCt[1+j]))/(1-(kCt[1+j]*kCt[1+j])));
end;
for i:=1 to n do begin
for j:=1 to 3 do begin
NPVvar[j,i]:=0;
end;
end;
//------------------------------Рассчет инервалов NPVt
if Rtkey=false then begin
for ii:=1 to n do begin
for i:=1 to ii do begin
smin:=1;smax:=1;sav:=1;
for j:=1 to i do begin smax:=smax*dvar[1,i];
smin:=smin*dvar[3,i];
sav:=sav*dvar[2,i];
end;
NPVvar[3,ii]:=NPVvar[3,ii]+(Svar[3,i]/smax);
NPVvar[1,ii]:=NPVvar[1,ii]+(Svar[1,i]/smin);
NPVvar[2,ii]:=NPVvar[2,ii]+(Svar[2,i]/sav);
end;
NPVvar[1,ii]:=NPVvar[1,ii]-Ip[3];
NPVvar[2,ii]:=NPVvar[2,ii]-Ip[2];
NPVvar[3,ii]:=NPVvar[3,ii]-Ip[1];
end;
end else begin
for ii:=1 to nRt do begin
for i:=1 to ii do begin
smax:=1;
for j:=1 to i do begin smax:=smax*Rdvar[i];end;
NPVvar[3,ii]:=NPVvar[3,ii]+(RSvar[i]/smax);
end;
NPVvar[1,ii]:=NPVvar[3,ii]-Ir;
NPVvar[2,ii]:=NPVvar[3,ii]-Ir;
NPVvar[3,ii]:=NPVvar[3,ii]-Ir;
end;
for ii:=nRt+1 to n do begin
for i:=1 to nRt do begin
smax:=1;
for j:=1 to i do begin smax:=smax*Rdvar[i];end;
NPVvar[3,ii]:=NPVvar[3,ii]+(RSvar[i]/smax);
end;
NPVvar[2,ii]:=NPVvar[3,ii];
NPVvar[1,ii]:=NPVvar[3,ii];
for i:=nRt+1 to ii do begin
smin:=1;smax:=1;sav:=1;
for j:=1 to i do begin smax:=smax*dvar[1,i];
smin:=smin*dvar[3,i];
sav:=sav*dvar[2,i];
end;
NPVvar[3,ii]:=NPVvar[3,ii]+(Svar[3,i]/smax);
NPVvar[1,ii]:=NPVvar[1,ii]+(Svar[1,i]/smin);
NPVvar[2,ii]:=NPVvar[2,ii]+(Svar[2,i]/sav);
end;
NPVvar[1,ii]:=NPVvar[1,ii]-Ir;
NPVvar[2,ii]:=NPVvar[2,ii]-Ir;
NPVvar[3,ii]:=NPVvar[3,ii]-Ir;
end;
end;
//------------------------------Рассчет значения коэффициента риска Vt
for i:=1 to n do begin
if (NPVvar[3,i]=NPVvar[1,i]) or (NPVvar[2,i]=NPVvar[1,i]) or (NPVvar[3,i]=NPVvar[2,i]) then begin
if (NPVvar[1,i]>G) then Vt[i]:=0;
if (NPVvar[1,i]<=G) and (NPVvar[3,i]>=G) then Vt[i]:=(G-NPVvar[1,i])/(NPVvar[3,i]-NPVvar[1,i]);
if (NPVvar[3,i]<G) then Vt[i]:=1;
end else begin
smin:=(G-NPVvar[1,i])/(NPVvar[3,i]-NPVvar[1,i]);
if G<NPVvar[1,i] then Vt[i]:=0;
if (G>=NPVvar[1,i]) and (G<NPVvar[2,i]) then begin
smax:=(G-NPVvar[1,i])/(NPVvar[2,i]-NPVvar[1,i]);
Vt[i]:=smin*(1+((1-smax)/smax)*Ln(1-smax));
end;
if (G>=NPVvar[2,i]) and (G<NPVvar[3,i]) then begin
if G=NPVvar[2,i] then smax:=1 else smax:=(NPVvar[3,i]-G)/(NPVvar[3,i]-NPVvar[2,i]);
Vt[i]:=1-((1-smin)*(1+((1-smax)/smax)*Ln(1-smax)));
end;
if G>=NPVvar[3,i] then Vt[i]:=1;
end;
end;
//-----------------------------Рассчет значения коэ-та ликвидности Rt
For i:=1 to n do begin
Rt[1,i]:=1;Rto[i]:=1;
Rt[2,i]:=1;
end;
//-----------------------------рассчет прогнозного занчения NPV и Rt
if Rtkey=true then begin
for ii:=1 to n do begin
NPVpmin:=0;NPVpmax:=0;NPVpav:=0;
for i:=1 to ii do begin
smin:=1;smax:=1;sav:=1;
for j:=1 to i do begin smin:=smin*dvar[3,i];smax:=smax*dvar[1,i];sav:=sav*dvar[2,i];end;
NPVpmax:=NPVpmax+(Svar[3,i]/smax);
NPVpmin:=NPVpmin+(Svar[1,i]/smin);
NPVpav:=NPVpav+(Svar[2,i]/sav);
end;
NPVpmin:=NPVpmin-Ip[3];
if NPVpmin<>0 then Rt[1,ii]:=NPVvar[1,ii]/NPVpmin;
NPVpmax:=NPVpmax-Ip[1];
if NPVpmax<>0 then Rt[3,ii]:=NPVvar[3,ii]/NPVpmax;
NPVpav:=NPVpav-Ip[2];
if NPVpav<>0 then Rt[2,ii]:=NPVvar[2,ii]/NPVpav;
if (NPVpmin<=0) and (NPVvar[1,ii]>=0) then Rt[1,ii]:=1;
if (NPVpmax<=0) and (NPVvar[3,ii]>=0) then Rt[3,ii]:=1;
if (NPVpav<=0) and (NPVvar[2,ii]>=0) then Rt[2,ii]:=1;
if (NPVpmin>=0) and (NPVvar[1,ii]<0) then Rt[1,ii]:=0;
if (NPVpmax>=0) and (NPVvar[3,ii]<0) then Rt[3,ii]:=0;
if (NPVpav>=0) and (NPVvar[2,ii]<0) then Rt[2,ii]:=0;
end;
for i:=1 to n do begin
j:=3;
if (Rt[1,i]*Rt[2,i]*Rt[3,i])<=(kRt[1]*kRt[1]*kRt[1]) then Rto[i]:=(Rt[1,i]*Rt[2,i]*Rt[3,i])/(kRt[1]*kRt[1]);
if ((Rt[1,i]*Rt[2,i]*Rt[3,i])>(kRt[1]*kRt[1]*kRt[1]))and (Rt[1,i]*Rt[2,i]*Rt[3,i]<=(kRt[2]*kRt[2]*kRt[2]))then j:=0;
if ((Rt[1,i]*Rt[2,i]*Rt[3,i])>(kRt[2]*kRt[2]*kRt[2]))and (Rt[1,i]*Rt[2,i]*Rt[3,i]<=(kRt[3]*kRt[3]*kRt[3])) then j:=1;
if ((Rt[1,i]*Rt[2,i]*Rt[3,i])>(kRt[3]*kRt[3]*kRt[3]))and (Rt[1,i]*Rt[2,i]*Rt[3,i]<1) then j:=2;
if (Rt[1,i]*Rt[2,i]*Rt[3,i]>=1) then Rto[i]:=1;
if (j = 0) or (j = 1) then
Rto[i]:=kRt[1+j]+((((Rt[1,i]*Rt[2,i]*Rt[3,i])-(kRt[1+j]*kRt[1+j]*kRt[1+j]))*(kRt[2+j]-kRt[1+j]))/((kRt[2+j]*kRt[2+j]*kRt[2+j])-(kRt[1+j]*kRt[1+j]*kRt[1+j])));
if j = 2 then
Rto[i]:=kRt[1+j]+((((Rt[1,i]*Rt[2,i]*Rt[3,i])-(kRt[1+j]*kRt[1+j]*kRt[1+j]))*(1-kRt[1+j]))/(1-(kRt[1+j]*kRt[1+j]*kRt[1+j])));
end;
end;
for i:=1 to n do begin
//----------------------------------Значения ф. принадлежности для Сt
if Cto[i]<=((kCt[2]+kCt[3])/2) then mCt[1,i]:=0;
if (Cto[i]>((kCt[2]+kCt[3])/2)) and (Cto[i]<kCt[3]) then mCt[1,i]:=(2*Cto[i]-kCt[2]-kCt[3])/(kCt[3]-kCt[2]);
if Cto[i]>=kCt[3] then mCt[1,i]:=1;
if (Cto[i]<=((kCt[1]+kCt[2])/2)) or (Cto[i]>=((kCt[3]+1)/2)) then mCt[2,i]:=0;
if (Cto[i]>((kCt[1]+kCt[2])/2)) and (Cto[i]<((kCt[2]+kCt[3])/2)) then mCt[2,i]:=(2*Cto[i]-kCt[1]-kCt[2])/(kCt[3]-kCt[1]);
if (Cto[i]>=((kCt[2]+kCt[3])/2)) and (Cto[i]<=((kCt[3]+1)/2)) then mCt[2,i]:=1-((2*Cto[i]-kCt[2]-kCt[3])/(1-kCt[2]));
if (Cto[i]<=(kCt[1]/2)) or (Cto[i]>((kCt[2]+kCt[3])/2)) then mCt[3,i]:=0;
if (Cto[i]>(kCt[1]/2)) and (Cto[i]<((kCt[1]+kCt[2])/2)) then mCt[3,i]:=(2*Cto[i]-kCt[1])/(kCt[2]);
if (Cto[i]>=((kCt[1]+kCt[2])/2)) and (Cto[i]<=((kCt[2]+kCt[3])/2)) then mCt[3,i]:=1-(2*Cto[i]-kCt[1]-kCt[2])/(kCt[3]-kCt[1]);
if Cto[i]>=((kCt[1]+kCt[2])/2) then mCt[4,i]:=0;
if (Cto[i]<((kCt[1]+kCt[2])/2)) and (Cto[i]>kCt[1]) then mCt[4,i]:=1-(2*(Cto[i]-kCt[1])/(kCt[2]-kCt[1]));
if Cto[i]<=kCt[1] then mCt[4,i]:=1;
//----------------------------------Значения ф. принадлежности для Rt
if Rto[i]<=((kRt[2]+kRt[3])/2) then mRt[1,i]:=0;
if (Rto[i]>((kRt[2]+kRt[3])/2)) and (Rto[i]<kRt[3]) then mRt[1,i]:=(2*Rto[i]-kRt[2]-kRt[3])/(kRt[3]-kRt[2]);
if Rto[i]>=kRt[3] then mRt[1,i]:=1;
if (Rto[i]<=((kRt[1]+kRt[2])/2)) or (Rto[i]>=((kRt[3]+1)/2)) then mRt[2,i]:=0;
if (Rto[i]>((kRt[1]+kRt[2])/2)) and (Rto[i]<((kRt[2]+kRt[3])/2)) then mRt[2,i]:=(2*Rto[i]-kRt[1]-kRt[2])/(kRt[3]-kRt[1]);
if (Rto[i]>=((kRt[2]+kRt[3])/2)) and (Rto[i]<=((kRt[3]+1)/2)) then mRt[2,i]:=1-((2*Rto[i]-kRt[2]-kRt[3])/(1-kRt[2]));
if (Rto[i]<=(kRt[1]/2)) or (Rto[i]>=((kRt[2]+kRt[3])/2)) then mRt[3,i]:=0;
if (Rto[i]>=(kRt[1]/2)) and (Rto[i]<((kRt[1]+kRt[2])/2)) then mRt[3,i]:=(2*Rto[i]-kRt[1])/(kRt[2]);
if (Rto[i]>=((kRt[1]+kRt[2])/2)) and (Rto[i]<((kRt[2]+kRt[3])/2)) then mRt[3,i]:=1-((2*Rto[i]-kRt[1]-kRt[2])/(kRt[3]-kRt[1]));
if Rto[i]>=((kRt[1]+kRt[2])/2) then mRt[4,i]:=0;
if (Rto[i]<((kRt[1]+kRt[2])/2)) and (Rto[i]>kRt[1]) then mRt[4,i]:=1-(2*(Rto[i]-kRt[1])/(kRt[2]-kRt[1]));
if Rto[i]<=kRt[1] then mRt[4,i]:=1;
//----------------------------------Значения ф. принадлежности для Vt
if Vt[i]<=((kVt[2]+kVt[3])/2) then mVt[4,i]:=0;
if (Vt[i]>((kVt[2]+kVt[3])/2)) and (Vt[i]<kVt[3]) then mVt[4,i]:=(2*Vt[i]-kVt[2]-kVt[3])/(kVt[3]-kVt[2]);
if Vt[i]>=kVt[3] then mVt[4,i]:=1;
if (Vt[i]<=((kVt[1]+kVt[2])/2)) or (Vt[i]>=((kVt[3]+1)/2)) then mVt[3,i]:=0;
if (Vt[i]>((kVt[1]+kVt[2])/2)) and (Vt[i]<((kVt[2]+kVt[3])/2)) then mVt[3,i]:=(2*Vt[i]-kVt[1]-kVt[2])/(kVt[3]-kVt[1]);
if (Vt[i]<((kVt[3]+1)/2)) and (Vt[i]>((kVt[2]+kVt[3])/2)) then mVt[3,i]:=1-((2*Vt[i]-kVt[2]-kVt[3])/(1-kVt[2]));
if (Vt[i]<=(kVt[1]/2)) or (Vt[i]>=((kVt[2]+kVt[3])/2)) then mVt[2,i]:=0;
if (Vt[i]>(kVt[1]/2)) and (Vt[i]<((kVt[1]+kVt[2])/2)) then mVt[2,i]:=(2*Vt[i]-kVt[1])/(kVt[2]);
if (Vt[i]>=((kVt[1]+kVt[2])/2)) and (Vt[i]<=((kVt[2]+kVt[3])/2)) then mVt[2,i]:=1-((2*Vt[i]-kVt[1]-kVt[2])/(kVt[3]-kVt[1]));
if Vt[i]>=((kVt[1]+kVt[2])/2) then mVt[1,i]:=0;
if (Vt[i]<((kVt[1]+kVt[2])/2)) and (Vt[i]>kVt[1]) then mVt[1,i]:=1-(2*(Vt[i]-kVt[1])/(kVt[2]-kVt[1]));
if Vt[i]<=kVt[1] then mVt[1,i]:=1;
end;
//-----------------------------Вывод значений
For i:=1 to n do begin
str:='('+FloatToStrF(Ct[1,i],ffFixed,9,2)+'; '+FloatToStrF(Ct[2,i],ffFixed,9,2)+')';
Form3.StringGrid1.Cells[1,i]:=str;
Form3.StringGrid1.Cells[4,i]:=FloatToStrF(Vt[i],ffFixed,9,2);
str:='('+FloatToStrF(NPVvar[1,i],ffFixed,9,2)+'; '+FloatToStrF(NPVvar[2,i],ffFixed,9,2)+'; '+FloatToStrF(NPVvar[3,i],ffFixed,9,2)+')';
Form3.StringGrid1.Cells[2,i]:=str;
str:='('+FloatToStrF(Rt[1,i],ffFixed,9,2)+'; '+FloatToStrF(Rt[2,i],ffFixed,9,2)+'; '+FloatToStrF(Rt[3,i],ffFixed,9,2)+')';
Form3.StringGrid1.Cells[3,i]:=str;
end;
for j:=1 to n do begin
// Form3.StringGrid2.Cells[1,j]:=FloatToStr(Cto[j]);
// Form3.StringGrid2.Cells[2,j]:=FloatToStr(Rto[j]);
k:=1; ii:=1;iv:=1;
for i:=2 to 4 do begin
if mCt[i-1,j]<mCt[i,j] then k:=i;
if mRt[i-1,j]<mRt[i,j] then ii:=i;
if mVt[i-1,j]<mVt[i,j] then iv:=i;
end;
if k=1 then Form3.StringGrid2.Cells[1,j]:=FloatToStrF(mCt[k,j],ffFixed,9,2)+'-минимальный';
if k=2 then Form3.StringGrid2.Cells[1,j]:=FloatToStrF(mCt[k,j],ffFixed,9,2)+'-повышенный';
if k=3 then Form3.StringGrid2.Cells[1,j]:=FloatToStrF(mCt[k,j],ffFixed,9,2)+'-критический';
if k=4 then Form3.StringGrid2.Cells[1,j]:=FloatToStrF(mCt[k,j],ffFixed,9,2)+'-недопустимый';
if ii=1 then Form3.StringGrid2.Cells[2,j]:=FloatToStrF(mRt[ii,j],ffFixed,9,2)+'-минимальный';
if ii=2 then Form3.StringGrid2.Cells[2,j]:=FloatToStrF(mRt[ii,j],ffFixed,9,2)+'-повышенный';
if ii=3 then Form3.StringGrid2.Cells[2,j]:=FloatToStrF(mRt[ii,j],ffFixed,9,2)+'-критический';
if ii=4 then Form3.StringGrid2.Cells[2,j]:=FloatToStrF(mRt[ii,j],ffFixed,9,2)+'-недопустимый';
if iv=1 then Form3.StringGrid2.Cells[3,j]:=FloatToStrF(mVt[iv,j],ffFixed,9,2)+'-минимальный';
if iv=2 then Form3.StringGrid2.Cells[3,j]:=FloatToStrF(mVt[iv,j],ffFixed,9,2)+'-повышенный';
if iv=3 then Form3.StringGrid2.Cells[3,j]:=FloatToStrF(mVt[iv,j],ffFixed,9,2)+'-критический';
if iv=4 then Form3.StringGrid2.Cells[3,j]:=FloatToStrF(mVt[iv,j],ffFixed,9,2)+'-недопустимый';
//----------------------------------Рассчет общего риска проекта
re:=TR[iv,k,ii];
min:=mVt[iv,j];
if mRt[ii,j]<min then min:=mRt[ii,j];
if mCt[k,j]<min then min:=mCt[k,j];
if re=1 then begin
A1:=0;B1:=0;K1:=0;C1:=0;
C2:=(((1-min)*(kre[2]-kre[1]))+2*kre[1])/2;
K2:=(kre[1]+kre[2])/2;
A2:=(-2/(kre[2]-kre[1]));
B2:=1+((2*kre[1])/(kre[2]-kre[1]));
end;
if re=2 then begin
A1:=2/kre[2];
B1:=-kre[1]/kre[2];
K1:=kre[1]/2;
C1:=((min*kre[2])+kre[1])/2;
C2:=(((1-min)*kre[3])+kre[2]+(min*kre[1]))/2;
K2:=(kre[2]+kre[3])/2;
A2:=(-2/(kre[3]-kre[1]));
B2:=1+((kre[1]+kre[2])/(kre[3]-kre[1]));
end;
if re=3 then begin
A1:=2/(kre[3]-kre[1]);
B1:=-(kre[1]+kre[2])/(kre[3]-kre[1]);
K1:=(kre[1]+kre[2])/2;
C1:=((min*(kre[3]-kre[1]))+kre[1]+kre[2])/2;
C2:=(((1-min)*(1-kre[2]))+kre[3]+kre[2])/2;
K2:=(kre[3]+1)/2;
A2:=(-2/(1-kre[2]));
B2:=1-((kre[2]+kre[3])/(1-kre[2]));
end;
if re=4 then begin
A1:=(2/(kre[3]-kre[2]));
B1:=-(kre[2]+kre[3])/(kre[3]-kre[2]);
K1:=(kre[2]+kre[3])/2;
C1:=((min*(kre[3]-kre[2]))+kre[2]+kre[3])/2;
C2:=1;K2:=0;A2:=0;B2:=0;
end;
vrch:=(A1*((C1*C1*C1)-(K1*K1*K1))/3);
vrch:=vrch+((B1*((C1*C1)-(K1*K1)))/2);
vrch:=vrch+(min*((C2*C2)-(C1*C1))/2);
vrch:=vrch+(A2*(((K2*K2*K2)-(C2*C2*C2)))/3)+(B2*((K2*K2)-(C2*C2))/2);
vrz:=(A1*((C1*C1)-(K1*K1))/2);
vrz:=vrz+(B1*(C1-K1));
vrz:=vrz+(min*(C2-C1));
vrz:=vrz+(A2*((K2*K2)-(C2*C2))/2)+(B2*(K2-C2));
vr:=vrch/vrz;
//----------------------
if TR[iv,k,ii]=1 then begin
if (vr<=(kre[1]/2)) or (vr>=((kre[2]+kre[3])/2)) then mvr2:=0;
if (vr>(kre[1]/2)) and (vr<((kre[1]+kre[2])/2)) then mvr2:=(2*vr-kre[1])/(kre[2]);
if (vr>=((kre[1]+kre[2])/2)) and (vr<=((kre[2]+kre[3])/2)) then mvr2:=1-((2*vr-kre[1]-kre[2])/(kre[3]-kre[1]));
if vr>=((kre[1]+kre[2])/2) then mvr1:=0;
if (vr<((kre[1]+kre[2])/2)) and (vr>C2) then mvr1:=1-(2*(vr-kre[1])/(kre[2]-kre[1]));
if vr<=C2 then mvr1:=min;
if mvr2>mvr1 then re:=2;
end;
if TR[iv,k,ii]=2 then begin
if (vr<=((kre[1]+kre[2])/2)) or (vr>=((kre[3]+1)/2)) then mvr3:=0;
if (vr>((kre[1]+kre[2])/2)) and (vr<((kre[2]+kre[3])/2)) then mvr3:=(2*vr-kre[1]-kre[2])/(kre[3]-kre[1]);
if (vr<((kre[3]+1)/2)) and (vr>((kre[2]+kre[3])/2)) then mvr3:=1-((2*vr-kre[2]-kre[3])/(1-kre[2]));
if (vr<=(kre[1]/2)) or (vr>=((kre[2]+kre[3])/2)) then mvr2:=0;
if (vr>(kre[1]/2)) and (vr<C1) then mvr2:=(2*vr-kre[1])/(kre[2]);
if (vr>=C1) and (vr<=C2) then mvr2:=min;
if (vr>=C2) and (vr<((kre[2]+kre[3])/2)) then mvr2:=1-((2*vr-kre[1]-kre[2])/(kre[3]-kre[1]));
if vr>=((kre[1]+kre[2])/2) then mvr1:=0;
if (vr<((kre[1]+kre[2])/2)) and (vr>kre[1]) then mvr1:=1-(2*(vr-kre[1])/(kre[2]-kre[1]));
if vr<=kre[1] then mvr1:=1;
if mvr1>mvr2 then re:=1;
if mvr3>mvr2 then re:=3;
end;
if TR[iv,k,ii]=3 then begin
if vr<=((kre[2]+kre[3])/2) then mvr4:=0;
if (vr>((kre[2]+kre[3])/2)) and (vr<kre[3]) then mvr4:=(2*vr-kre[2]-kre[3])/(kre[3]-kre[2]);
if vr>=kre[3] then mvr4:=1;
if (vr<=((kre[1]+kre[2])/2)) or (vr>=((kre[3]+1)/2)) then mvr3:=0;
if (vr>((kre[1]+kre[2])/2)) and (vr<C1) then mvr3:=(2*vr-kre[1]-kre[2])/(kre[3]-kre[1]);
if (vr>=C1) and (vr<=C2) then mvr3:=min;
if (vr<((kre[3]+1)/2)) and (Vt[i]>C2) then mvr3:=1-((2*vr-kre[2]-kre[3])/(1-kre[2]));
if (vr<=(kre[1]/2)) or (vr>=((kre[2]+kre[3])/2)) then mvr2:=0;
if (vr>(kre[1]/2)) and (vr<((kre[1]+kre[2])/2)) then mvr2:=(2*vr-kre[1])/(kre[2]);
if (vr>=((kre[1]+kre[2])/2)) and (vr<=((kre[2]+kre[3])/2)) then mvr2:=1-((2*vr-kre[1]-kre[2])/(kre[3]-kre[1]));
if mvr4>mvr3 then re:=4;
if mvr2>mvr3 then re:=2;
end;
if TR[iv,k,ii]=4 then begin
if vr<=((kre[2]+kre[3])/2) then mvr4:=0;
if (vr>((kre[2]+kre[3])/2)) and (Vt[i]<C1) then mvr4:=(2*vr-kre[2]-kre[3])/(kre[3]-kre[2]);
if vr>=C1 then mvr4:=min;
if (vr<=((kre[1]+kre[2])/2)) or (vr>=((kre[3]+1)/2)) then mvr3:=0;
if (vr>((kre[1]+kre[2])/2)) and (vr<((kre[2]+kre[3])/2)) then mvr3:=(2*vr-kre[1]-kre[2])/(kre[3]-kre[1]);
if (vr<((kre[3]+1)/2)) and (vr>((kre[2]+kre[3])/2)) then mvr3:=1-((2*vr-kre[2]-kre[3])/(1-kre[2]));
if mvr3>mvr4 then re:=3;
end;
//---------------------
if re=1 then begin
Form3.StringGrid2.Cells[4,j]:=FloatToStrF(vr,ffFixed,9,2)+'-минимальный';
Edit4.Text:='минимальный';
end;
if re=2 then begin
Form3.StringGrid2.Cells[4,j]:=FloatToStrF(vr,ffFixed,9,2)+'-повышенный';
Edit4.Text:='повышенный';
end;
if re=3 then begin
Form3.StringGrid2.Cells[4,j]:=FloatToStrF(vr,ffFixed,9,2)+'-критический';
Edit4.Text:='критический';
end;
if re=4 then begin
Form3.StringGrid2.Cells[4,j]:=FloatToStrF(vr,ffFixed,9,2)+'-недопустимый';
Edit4.Text:='недопустимый';
end;
end;
Edit3.Text:=FloatToStrF(vr,ffFixed,9,2);
end;
procedure TForm1.N7Click(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.N3Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (saveDialog1.Execute) then begin
AssignFile(Myfile,Savedialog1.FileName);
Try Rewrite(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
Date:=IntToStr(SpinEdit1.Value);WriteLn(MyFile,Date);
Date:=Edit1.Text;WriteLn(MyFile,Date);
Date:=Edit2.Text;WriteLn(MyFile,Date);
For i:=0 to n-1 do begin
Date:=StringGrid1.Cells[i,1];
WriteLn(Myfile,Date);
end;
For i:=0 to n-1 do begin
Date:=StringGrid2.Cells[i,1];
WriteLn(Myfile,Date);
End;
For i:=0 to n-1 do begin
Date:=StringGrid3.Cells[i,1];
WriteLn(Myfile,Date);
End;
Date:=IntToStr(StringGrid4.ColCount);WriteLn(Myfile,Date);
For i:=0 to StringGrid4.ColCount-1 do begin
Date:=StringGrid4.Cells[i,1];
WriteLn(Myfile,Date);
End;
With Form2 do begin
Date:=IntToStr(SpinEdit1.Value);WriteLn(Myfile,Date);
Date:=Edit1.Text;WriteLn(Myfile,Date);
For i:=0 to nRt-1 do begin
Date:=StringGrid1.Cells[i,1];
WriteLn(Myfile,Date);
end;
For i:=0 to nRt-1 do begin
Date:=StringGrid2.Cells[i,1];
WriteLn(Myfile,Date);
end;
end;
Closefile(myFile);
end
else Begin Showmessage('Ошибка!'); Exit;end;
end;
procedure TForm1.N4Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (OpenDialog1.Execute) then begin
AssignFile(Myfile,Opendialog1.FileName);
Try Reset(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
ReadLn(MyFile,Date);SpinEdit1.Value:=StrToInt(Date);n:=StrToInt(Date);
ReadLn(MyFile,Date);Edit1.Text:=Date;
ReadLn(MyFile,Date);Edit2.Text:=Date;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,1]:=Date;
end;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid2.Cells[i,1]:=Date;
End;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid3.Cells[i,1]:=Date;
End;
ReadLn(MyFile,Date);StringGrid4.ColCount:=StrToInt(Date);
For i:=0 to StringGrid4.ColCount-1 do begin
ReadLn(MyFile,Date);
StringGrid4.Cells[i,1]:=Date;
End;
With Form2 do begin
ReadLn(MyFile,Date);SpinEdit1.Value:=StrToInt(Date);
nRt:=StrToInt(Date);StringGrid1.ColCount:=nRt;StringGrid2.ColCount:=nRt;
ReadLn(MyFile,Date);Edit1.Text:=Date;
For i:=0 to nRt-1 do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,1]:=Date;
end;
For i:=0 to nRt-1 do begin
ReadLn(MyFile,Date);
StringGrid2.Cells[i,1]:=Date;
end;
end;
Closefile(myFile);
if StringGrid4.ColCount=1 then CheckBox1.Checked:=true;
end
else Begin Showmessage('Файл не найден!'); Exit;end;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
Form4.Show;
end;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44),chr(8):;
else key:=chr(0); end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
Form5.show;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
Form6.show;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form3.Show;
end;
end.
unit Rtmodul;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Grids, Spin;
type
TForm2 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label2: TLabel;
Edit1: TEdit;
GroupBox2: TGroupBox;
StringGrid1: TStringGrid;
GroupBox3: TGroupBox;
StringGrid2: TStringGrid;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure SpinEdit1Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid2KeyPress(Sender: TObject; var Key: Char);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
Rtkey : boolean;
i,j,ii : integer;
NPVpmin,NPVpmax,NPVpav,smin,smax : real;{прогнозное значение NPV для интервала}
implementation
uses datamodul;
{$R *.dfm}
procedure TForm2.SpinEdit1Change(Sender: TObject);
begin
nRt:=SpinEdit1.Value;
StringGrid1.ColCount:=nRt;
StringGrid2.ColCount:=nRt;
for i:=1 to nRt do begin
StringGrid1.Cells[i-1,0]:=IntToStr(i);
StringGrid2.Cells[i-1,0]:=IntToStr(i);
end;
end;
procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54),
chr(55),chr(56),chr(57),chr(44),chr(8):;
else key:=chr(0);
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
nRt:=n;
StringGrid1.ColCount:=nRt;
StringGrid2.ColCount:=nRt;
for j:=0 to nRt-1 do begin
StringGrid1.Cells[j,0]:=IntToStr(j+1);
StringGrid2.Cells[j,0]:=IntToStr(j+1);
end;
For i:=1 to n do begin
RSvar[i]:=0;
Rdvar[i]:=0;
end;
end;
procedure TForm2.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54),
chr(55),chr(56),chr(57),chr(44),chr(8):;
else key:=chr(0);
end;
end;
procedure TForm2.StringGrid2KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(45),chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54),
chr(55),chr(56),chr(57),chr(44),chr(8):;
else key:=chr(0);
end;
end;
procedure TForm2.BitBtn1Click(Sender: TObject);
begin
//----------------------------- Ввод значений в массив для рассчета коэф-та ликвидности Rt
try Ir:=StrToFloat(Edit1.Text); Except Ir:=0; Edit1.Text:=IntToStr(0); end;
for i:=1 to nRt do begin
try
RSvar[i]:=StrToFloat(StringGrid2.Cells[i-1,1]);
Except
StringGrid2.Cells[i-1,1]:=IntToStr(0);
end;
try
Rdvar[i]:=StrToFloat(StringGrid1.Cells[i-1,1]);
Except
StringGrid1.Cells[i-1,1]:=IntToStr(0);
end;
end;
Rtkey:=true;
Form2.Hide;
Form1.Show;
end;
procedure TForm2.BitBtn2Click(Sender: TObject);
begin
nRt:=n;
Rtkey:=false;
Form2.Close;
end;
end.
unit Formirmodul;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, Menus;
type
TForm4 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
GroupBox1: TGroupBox;
Label1: TLabel;
StringGrid1: TStringGrid;
GroupBox2: TGroupBox;
StringGrid2: TStringGrid;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
i,j,t : integer;
PlusSi,MinusSi : array[1..3,1..20] of real;
implementation
uses datamodul;
{$R *.dfm}
procedure TForm4.FormCreate(Sender: TObject);
begin
StringGrid1.ColCount:=n+1;
StringGrid2.ColCount:=n+1;
StringGrid1.Cells[0,1]:='Доходы от реализации продукции';
StringGrid1.Cells[0,2]:='Возмещение НДС по инвестиции';
StringGrid1.Cells[0,3]:='Амортизация';
StringGrid2.Cells[0,1]:='Инвестиции (включая НДС)';
StringGrid2.Cells[0,2]:='Прирост оборотных средств';
StringGrid2.Cells[0,3]:='Эксплутационные затраты';
StringGrid2.Cells[0,4]:='Налоги';
For i:=1 to n do begin
StringGrid1.Cells[i,0]:=IntToStr(i);
StringGrid2.Cells[i,0]:=IntToStr(i);
end;
end;
procedure TForm4.N5Click(Sender: TObject);
begin
if StringGrid1.Focused then StringGrid1.RowCount:=StringGrid1.RowCount+1;
if StringGrid2.Focused then StringGrid2.RowCount:=StringGrid2.RowCount+1;
end;
procedure TForm4.N6Click(Sender: TObject);
begin
if StringGrid1.Focused then StringGrid1.RowCount:=StringGrid1.RowCount-1;
if StringGrid2.Focused then StringGrid2.RowCount:=StringGrid2.RowCount-1;
end;
procedure TForm4.N3Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (saveDialog1.Execute) then begin
AssignFile(Myfile,Savedialog1.FileName);
Try Rewrite(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
Date:=IntToStr(StringGrid1.RowCount);WriteLn(MyFile,Date);
Date:=IntToStr(StringGrid2.RowCount);WriteLn(MyFile,Date);
For j:=0 to n do begin
For i:=0 to StringGrid1.RowCount-1 do begin
Date:=StringGrid1.Cells[j,i];
WriteLn(Myfile,Date);
end;
end;
For j:=0 to n do begin
For i:=0 to StringGrid2.RowCount-1 do begin
Date:=StringGrid2.Cells[j,i];
WriteLn(Myfile,Date);
end;
end;
Closefile(myFile);
end
else Begin Showmessage('Ошибка!'); Exit;end;
end;
procedure TForm4.N2Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (OpenDialog1.Execute) then begin
AssignFile(Myfile,Opendialog1.FileName);
Try Reset(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
ReadLn(MyFile,Date);StringGrid1.RowCount:=StrToInt(Date);
ReadLn(MyFile,Date);StringGrid2.RowCount:=StrToInt(Date);
For j:=0 to n do begin
For i:=0 to StringGrid1.RowCount-1 do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[j,i]:=Date;
end;
end;
For j:=0 to n do begin
For i:=0 to StringGrid2.RowCount-1 do begin
ReadLn(MyFile,Date);
StringGrid2.Cells[j,i]:=Date;
end;
end;
Closefile(myFile);
end
else Begin Showmessage('Файл не найден!'); Exit;end;
end;
procedure TForm4.N7Click(Sender: TObject);
var
str,str2 : string;
k : integer;
begin
for t:=1 to n do begin
for j:=1 to 3 do begin
PlusSi[j,t]:=0;
end;
end;
for t:=1 to n do begin
for i:=1 to StringGrid1.RowCount-1 do begin
str:=StringGrid1.Cells[t,i];
if pos(';',str)<>0 then begin str2:='';k:=1;
for j:=1 to Length(str)do begin
if (str[j]<>';') then str2:=str2+str[j]
else begin
PlusSi[k,t]:=PlusSi[k,t]+StrToFloat(str2);
k:=k+1;str2:='';
end;
if j=Length(str) then PlusSi[k,t]:=PlusSi[k,t]+StrToFloat(str2);
end;
end else try
PlusSi[1,t]:=PlusSi[1,t]+StrToFloat(str);
PlusSi[2,t]:=PlusSi[2,t]+StrToFloat(str);
PlusSi[3,t]:=PlusSi[3,t]+StrToFloat(str);
except
showmessage('Ошибка при вводе значений интервалов денежных потоков!');
FocusControl(Stringgrid1);
end;
end;
for i:=1 to StringGrid2.RowCount-1 do begin
str:=StringGrid2.Cells[t,i];
if pos(';',str)<>0 then begin str2:='';k:=1;
for j:=1 to Length(str)do begin
if (str[j]<>';') then str2:=str2+str[j]
else begin
if k=1 then PlusSi[3,t]:=PlusSi[3,t]-StrToFloat(str2);
if k=2 then PlusSi[2,t]:=PlusSi[2,t]-StrToFloat(str2);
k:=k+1;str2:='';
end;
if j=Length(str) then PlusSi[1,t]:=PlusSi[1,t]-StrToFloat(str2);
end;
end else try
PlusSi[1,t]:=PlusSi[1,t]-StrToFloat(str);
PlusSi[2,t]:=PlusSi[2,t]-StrToFloat(str);
PlusSi[3,t]:=PlusSi[3,t]-StrToFloat(str);
except
showmessage('Ошибка при вводе значений интервалов денежных потоков!');
FocusControl(Stringgrid1);
end;
end;
end;
for i:=1 to n do begin
str:='';
for j:=1 to 3 do begin
str:=str+FloatToStr(PlusSi[j,i]);
if j<>3 then str:=str+';';
end;
Form1.StringGrid1.Cells[i-1,1]:=str;
end;
end;
end.
unit Risk;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Grids, ExtCtrls, Buttons, Spin, Menus;
type
TForm8 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
TabSheet2: TTabSheet;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
StringGrid3: TStringGrid;
StringGrid4: TStringGrid;
TabSheet3: TTabSheet;
Label8: TLabel;
StringGrid6: TStringGrid;
Label9: TLabel;
StringGrid7: TStringGrid;
StringGrid8: TStringGrid;
Label10: TLabel;
Panel3: TPanel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Edit1: TEdit;
Edit2: TEdit;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
CheckBox1: TCheckBox;
MainMenu1: TMainMenu;
N1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N5: TMenuItem;
N9: TMenuItem;
CheckBox2: TCheckBox;
Label7: TLabel;
procedure SpinEdit1Change(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure Edit1Exit(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid2KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid3KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid4KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid6KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid7KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid8KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form8: TForm8;
Ct,At,Zt,Simd : array[1..20] of real;{критерий покрытия,соб.капитал,заемный кап.,мат.ож.ден.потоков(прогнозир.ден.потоки)}
Pfsr : real; {ср.зн.цены}
Sij,Vt : array[1..20] of real;{чист.ден.потоки,риск,}
Rt : array[1..20] of real;{кр.ликвидности}
n,i,j,f,l,ii : integer; {число ПУП,число ресурсов,}
d,NPV,NPVi,NPVj,s,sum,sum2,sum3,ENPV : real; {коэф.дисконтирования,ЧПЭ,мат.ож.NPV}
Ip : real; {первонач.кап.вложения}
Pf : array[1..20,1..20] of real; {цена на ресурс в каждый ПУП, }
Pkrit,Xf : array[1..20] of real; {Критический лимит цены,доля ресурса в портфеле ресурсов}
implementation
uses Results,Cov, PriceCov, Riskproject, normgenerator;
{$R *.dfm}
procedure TForm8.SpinEdit1Change(Sender: TObject);
begin
n:=SpinEdit1.Value;
StringGrid1.ColCount:=n; StringGrid2.ColCount:=n; StringGrid3.ColCount:=n; StringGrid4.ColCount:=n;
Stringgrid7.RowCount:=n+1; Form3.StringGrid1.ColCount:=n+1;Form3.Stringgrid1.RowCount:=n+1;
Form4.StringGrid1.ColCount:=n+1; Form4.Stringgrid1.RowCount:=n+1;
Form7.StringGrid1.ColCount:=n+3; Form7.StringGrid2.ColCount:=n+2;Form7.StringGrid3.ColCount:=n+1;
For i:=1 to n do begin
Stringgrid1.Cells[i-1,0]:=IntToStr(i); Stringgrid2.Cells[i-1,0]:=IntToStr(i);
Stringgrid3.Cells[i-1,0]:=IntToStr(i); Stringgrid4.Cells[i-1,0]:=IntToStr(i);
Form3.Stringgrid1.Cells[i,0]:=IntToStr(i);Form3.Stringgrid1.Cells[0,i]:=IntToStr(i);
Form4.Stringgrid1.Cells[i,0]:=IntToStr(i); Form4.Stringgrid1.Cells[0,i]:=IntToStr(i);
Form7.StringGrid1.Cells[i+2,0]:=IntToStr(i); Form7.StringGrid2.Cells[i+1,0]:=IntToStr(i);
Form7.StringGrid3.Cells[i,0]:=IntToStr(i); Stringgrid7.Cells[0,i]:=IntToStr(i);
end;
end;
procedure TForm8.SpinEdit2Change(Sender: TObject);
begin
f:=SpinEdit2.Value;
StringGrid6.ColCount:=f;StringGrid7.ColCount:=f+1;
StringGrid7.RowCount:=n+1; StringGrid8.ColCount:=f;
For i:=1 to f do begin
Stringgrid6.Cells[i-1,0]:=IntToStr(i);
Stringgrid7.Cells[i,0]:=IntToStr(i);
Stringgrid8.Cells[i-1,0]:=IntToStr(i);
end;
For i:=1 to n+1 do begin
StringGrid7.Cells[0,i]:=IntToStr(i);
end;
end;
procedure TForm8.Edit1Exit(Sender: TObject);
begin
try
d:=StrToFloat(Edit1.Text);
except
Showmessage('Неправельный ввод данных!');
end;
end;
procedure TForm8.Edit2Exit(Sender: TObject);
begin
try
Ip:=StrToFloat(Edit2.Text);
except
Showmessage('Неправельный ввод данных!');
end;
end;
procedure TForm8.FormCreate(Sender: TObject);
begin
n:=5;f:=5;d:=1.2;Ip:=10;
For i:=1 to 5 do begin
Stringgrid1.Cells[i-1,0]:=IntToStr(i); Stringgrid2.Cells[i-1,0]:=IntToStr(i);
Stringgrid3.Cells[i-1,0]:=IntToStr(i); Stringgrid4.Cells[i-1,0]:=IntToStr(i);
Stringgrid6.Cells[i-1,0]:=IntToStr(i); Stringgrid7.Cells[0,i]:=IntToStr(i);
StringGrid7.Cells[i,0]:=IntToStr(i); Stringgrid8.Cells[i-1,0]:=IntToStr(i);
end;
For i:=1 to 20 do begin
For j:=1 to 20 do begin
Pcovar[i,j]:=0;
Covar[i,j]:=0;
end;
end;
end;
procedure TForm8.CheckBox1Click(Sender: TObject);
begin
if checkBox1.Checked then Form4.Show;
end;
procedure TForm8.N7Click(Sender: TObject);
var
keyw: boolean;
begin
// Заполнение данных в массивы
keyw:=true;
try
For i:=0 to n-1 do begin
Zt[i+1]:=StrToFloat(StringGrid1.Cells[i,1]);
At[i+1]:=StrToFloat(StringGrid2.Cells[i,1]);
Simd[i+1]:=StrToFloat(Stringgrid3.Cells[i,1]);
Sij[i+1]:=StrToFloat(Stringgrid4.Cells[i,1]);
end;
s:=0;
For i:=1 to f do begin
Pkrit[i]:=StrToFloat(Stringgrid8.Cells[i-1,1]);
Xf[i]:= StrToFloat(Stringgrid6.Cells[i-1,1]);
s:=s+Xf[i];
end;
if s<>1 then begin
Showmessage('Общяя сумма долей ресурсов в портфеле должна быть меньше равна единице!');
keyw:=false;
PageControl1.ActivePage:=TabSheet3;
FocusControl(StringGrid6);
end;
For j:=1 to f do begin
for i:=1 to n do begin
Pf[i,j]:=StrToFloat(Stringgrid7.Cells[j,i]);
end;
end;
Except
ShowMessage('Неправильно заполнены поля!');
keyw:=false;
end;
if keyw=true then begin
// --------------------------------вычисление мат. ож. NPV
ENPV:=0;
For i:=1 to n do begin NPV:=0;
For j:=1 to i do begin
NPV:=NPV+Sij[j];
end;
NPV:=NPV/i;s:=1;
for j:=1 to i do begin s:=s*d;end;
ENPV:=ENPV+(NPV/s);
end;
ENPV:=ENPV-Ip;
//----------------------------------вычисление критерия покрытия Ct
For i:=1 to n do begin
if Zt[i]<>0 then Ct[i]:=At[i]/Zt[i] else Ct[i]:=0;
end;
For i:=0 to Form2.StringGrid1.ColCount-1 do begin
Form2.StringGrid1.ColWidths[i]:=Form2.Header1.SectionWidth[i]-1;
end;
//-----------------------------------вычисление критерия ликвидности Rt в том числе
//-----------------------------------и NPVt
NPV:=0;s:=d;
For i:=1 to n do begin
For j:=1 to i-1 do begin s:=s*d;end;
NPV:=NPV+(Simd[i]/s); s:=d;
end;
NPV:=NPV-Ip; // прогнозное NPV
For i:=1 to n-1 do begin
NPVi:=0;NPVj:=0;s:=d;
for j:=1 to i do begin
For l:=1 to j-1 do begin s:=s*d; end;
NPVi:=NPVi+(Sij[j]/s);s:=d; //то NPV, которое получаем по имеющ. данным
end;
s:=d;
for j:=i+1 to n do begin
For l:=1 to j-1 do begin s:=s*d; end;
NPVj:=NPVj+(Simd[j]/s);s:=d;
end;
NPVj:=NPVj-Ip; //то, что осталось от прогногзного NPV
Rt[i]:=(NPVi+NPVj)/NPV;
Form2.StringGrid1.Cells[2,i-1]:=FloatToStr(NPVi);
end;
NPVi:=0;s:=d;
for i:=1 to n do begin
For l:=1 to i-1 do begin s:=s*d; end;
NPVi:=NPVi+(Sij[i]/s);s:=d;
end;
Rt[n]:=NPVi/NPV;Form2.StringGrid1.Cells[2,n-1]:=FloatToStr(NPVi);
Form2.StringGrid1.RowCount:=n;
For i:=0 to n-1 do begin
Form2.StringGrid1.Cells[0,i]:=IntToStr(i+1);
Form2.StringGrid1.Cells[1,i]:=FloatToStr(Ct[i+1]);
Form2.StringGrid1.Cells[3,i]:=FloatToStr(Rt[i+1])
end;
Form2.Memo1.Lines.Clear;
Form2.Memo1.Lines.Add('E(NPV) = ' + FloatToStr(ENPV) + ';');
// Оценка общего риска проекта
For j:=1 to f do begin
Pfsr:=0;
For i:=1 to n do begin
Pfsr:=Pfsr+Pf[i,j];
end;
Pfsr:=Pfsr/n;
if Pfsr>Pkrit[j] then
Form2.Memo1.Lines.Add('Покупка ' + IntToStr(j) + '-го ресурса невыгодна');
end;
for i:=1 to n do begin
sum:=0;s:=1;
For j:=1 to i do begin
For l:=1 to 2*j do begin s:=s*d; end;
sum:=sum+(Covar[j,j]/s);s:=1;
end;
sum2:=0;sum3:=0;
for l:=1 to i-1 do begin
for j:=l+1 to i do begin
s:=1;
For ii:=1 to l+j do begin s:=s*d; end;
sum2:=sum2+(Covar[l,j]/s);
end;
end;
for l:=1 to i do begin
for j:=1 to i do begin
sum3:=sum3+(Xf[l]*Xf[j]*PCovar[l,j])
end;
end;
Vt[i]:=sum+(2*sum2)+sum3;
form2.StringGrid1.Cells[4,i-1]:=FloatToStr(Vt[i]);
end;
Form2.Show;
end;
end;
procedure TForm8.N4Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (OpenDialog1.Execute) then begin
AssignFile(Myfile,Opendialog1.FileName);
Try Reset(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
With Form1 do begin
ReadLn(MyFile,Date);SpinEdit1.Value:=StrToInt(Date);n:=StrToInt(Date);
ReadLn(MyFile,Date);SpinEdit2.Value:=StrToInt(Date);f:=StrToInt(Date);
ReadLn(MyFile,Date);Edit1.Text:=Date;d:=StrToFloat(Date);
ReadLn(MyFile,Date);Edit2.Text:=Date;Ip:=StrToFloat(Date);
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,1]:=Date;
end;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid2.Cells[i,1]:=Date;
End;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid3.Cells[i,1]:=Date;
End;
For i:=0 to n-1 do begin
ReadLn(MyFile,Date);
StringGrid4.Cells[i,1]:=Date;
End;
For i:=0 to f-1 do begin
ReadLn(MyFile,Date);
StringGrid6.Cells[i,1]:=Date;
End;
For i:=1 to n do begin
For j:=1 to f do begin
ReadLn(MyFile,Date);
StringGrid7.Cells[i,j]:=Date;
end;
end;
For i:=0 to f-1 do begin
ReadLn(MyFile,Date);
StringGrid8.Cells[i,1]:=Date;
End;
end;
With Form3 do begin
For i:=1 to n do begin
For j:=1 to n do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,j]:=Date;
end;
End;
BitBtn1Click(Sender);
end;
With Form4 do begin
For i:=1 to n do begin
For j:=1 to n do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,j]:=Date;
end;
End;
BitBtn1Click(Sender);
end;
Closefile(myFile);
end
else Begin Showmessage('Файл не найден!'); Exit;end;
end;
procedure TForm8.N5Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (saveDialog1.Execute) then begin
AssignFile(Myfile,Savedialog1.FileName);
Try Rewrite(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
With Form8 do begin
Date:=IntToStr(SpinEdit1.Value);WriteLn(MyFile,Date);
Date:=IntToStr(SpinEdit2.Value);WriteLn(MyFile,Date);
Date:=Edit1.Text;WriteLn(MyFile,Date);
Date:=Edit2.Text;WriteLn(MyFile,Date);
For i:=0 to n-1 do begin
Date:=StringGrid1.Cells[i,1];
WriteLn(Myfile,Date);
end;
For i:=0 to n-1 do begin
Date:=StringGrid2.Cells[i,1];
WriteLn(Myfile,Date);
End;
For i:=0 to n-1 do begin
Date:=StringGrid3.Cells[i,1];
WriteLn(Myfile,Date);
End;
For i:=0 to n-1 do begin
Date:=StringGrid4.Cells[i,1];
WriteLn(Myfile,Date);
End;
{For i:=0 to n-1 do begin
Date:=StringGrid5.Cells[i,1];
WriteLn(Myfile,Date);
End; }
For i:=0 to f-1 do begin
Date:=StringGrid6.Cells[i,1];
WriteLn(Myfile,Date);
End;
For i:=1 to n do begin
for j:=1 to f do begin
Date:=StringGrid7.Cells[i,j];
WriteLn(Myfile,Date);
end;
end;
For i:=0 to f-1 do begin
Date:=StringGrid8.Cells[i,1];
WriteLn(Myfile,Date);
End;
end;
With Form3 do begin
For i:=1 to n do begin
For j:=1 to n do begin
Date:=StringGrid1.Cells[i,j];
WriteLn(Myfile,Date);
end;
end;
end;
With Form4 do begin
For i:=1 to n do begin
For j:=1 to n do begin
Date:=StringGrid1.Cells[i,j];
WriteLn(Myfile,Date);
end;
end;
end;
Closefile(myFile);
end
else Begin Showmessage('Ошибка!'); Exit;end;
end;
procedure TForm8.N9Click(Sender: TObject);
begin
Form7.show;
end;
procedure TForm8.CheckBox2Click(Sender: TObject);
begin
if checkBox2.Checked then Form3.Showmodal;
end;
procedure TForm8.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0);end;
end;
procedure TForm8.StringGrid2KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0); end;
end;
procedure TForm8.StringGrid3KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0); end;
end;
procedure TForm8.StringGrid4KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44),chr(45):;
else key:=chr(0); end;
end;
procedure TForm8.StringGrid6KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0); end;
end;
procedure TForm8.StringGrid7KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0);end;
end;
procedure TForm8.StringGrid8KeyPress(Sender: TObject; var Key: Char);
begin
Case key of
chr(48),chr(49),chr(50),chr(51),chr(52),chr(53),chr(54), chr(55),chr(56),chr(57),chr(44):;
else key:=chr(0); end;
end;
end.
unit normgenerator;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls, Buttons, Menus;
procedure normgen(var num1,num2 : real);
type
TForm7 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
GroupBox1: TGroupBox;
Label2: TLabel;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
Label1: TLabel;
TabSheet2: TTabSheet;
StringGrid3: TStringGrid;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure StringGrid1Exit(Sender: TObject);
procedure StringGrid2Exit(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form7: TForm7;
i,j, ndvar : integer; {число дтерм. перем-х проекта}
Svar : array[1..500,1..20] of real;{массив значений сгенерированных сл.вел}
Xvar : array[1..40,1..20] of real; {массив сл.перемен-х проекта}
Dvar : array[1..20,1..20] of real; {массив детермиированных перем-х ден. потоков}
implementation
uses Risk, Cov;
{$R *.dfm}
procedure normgen(var num1,num2 : real);
var
r1,r2,svar : real;
begin
Repeat
r1:=2*random-1;
r2:=2*random-1;
svar:=Sqr(r1)+Sqr(r2);
Until (svar<1);
svar:=sqrt((-2*ln(svar))/svar);
num1:=r1*svar;
num2:=r2*svar;
end;
procedure TForm7.N2Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (OpenDialog1.Execute) then begin
AssignFile(Myfile,Opendialog1.FileName);
Try Reset(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
ReadLn(MyFile,Date);StringGrid1.ColCount:=StrToInt(Date);
ReadLn(MyFile,Date);StringGrid1.RowCount:=StrToInt(Date);
ReadLn(MyFile,Date);StringGrid2.ColCount:=StrToInt(Date);
ReadLn(MyFile,Date);StringGrid2.RowCount:=StrToInt(Date);
For i:=0 to StringGrid1.ColCount do begin
For j:=0 to StringGrid1.RowCount do begin
ReadLn(MyFile,Date);
StringGrid1.Cells[i,j]:=Date;
end;
end;
For i:=0 to StringGrid2.ColCount do begin
For j:=0 to StringGrid2.RowCount do begin
ReadLn(MyFile,Date);
StringGrid2.Cells[i,j]:=Date;
end;
End;
Closefile(myFile);
end
else Begin Showmessage('Файл не найден!'); Exit;end;
end;
procedure TForm7.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,1]:='+'; StringGrid1.Cells[0,3]:='-'; StringGrid1.Cells[0,5]:='-';
StringGrid2.Cells[0,1]:='+'; StringGrid2.Cells[0,2]:='+'; StringGrid2.Cells[0,3]:='-'; StringGrid2.Cells[0,4]:='-';
StringGrid1.Cells[1,1]:='Доходы от реализации продукции';
StringGrid1.Cells[1,3]:='Эксплутационные затраты';
StringGrid1.Cells[1,5]:='Налоги';
StringGrid2.Cells[1,1]:='Возмещение НДС по инвестициям';
StringGrid2.Cells[1,2]:='Амортизация';
StringGrid2.Cells[1,3]:='Инвестиции';
StringGrid2.Cells[1,4]:='Прирост оборотных средств';
StringGrid1.Cells[1,0]:='Название';
StringGrid1.Cells[2,0]:='Инт-л';
StringGrid2.Cells[1,0]:='Название';
i:=1;
While (i<=StringGrid1.ColCount) do begin
StringGrid1.Cells[2,i]:='Мин.';
StringGrid1.Cells[2,i+1]:='Макс.';
i:=i+2;
end;
For i:=3 to StringGrid1.ColCount do begin
StringGrid1.Cells[i,0]:=IntToStr(i-2);
StringGrid2.Cells[i-1,0]:=IntToStr(i-2);
StringGrid3.Cells[i-2,0]:=IntToStr(i-2);
end;
For i:=1 to 500 do begin
Stringgrid3.Cells[0,i]:=IntToStr(i);
end;
end;
procedure TForm7.N7Click(Sender: TObject);
var
nvar,nn1,nn2,sv1,sv2 : real; //число стох.пер-х проекта,сл.числа,коэф-ты для прироста об.ср-в.
kvar : integer;
begin
nvar:=StringGrid1.RowCount-1;
For j:=1 to 20 do begin
Simd[j]:=0;
end;
For i:=1 to 500 do begin
For j:=1 to 20 do begin
Svar[i,j]:=0;
end;
end;
For i:=1 to 20 do begin
For j:=1 to 20 do begin
Covar[i,j]:=0;
end;
end;
for i:=1 to (StringGrid1.ColCount-3) do begin
j:=1;
While j<=(nvar-1) do begin
kvar:=1;
While kvar<=500 do begin
normgen(nn1,nn2);
nn1:=Xvar[j,i]+nn1*Xvar[j+1,i];
nn2:=Xvar[j,i]+nn2*Xvar[j+1,i];
if StringGrid1.Cells[0,j]='-' then begin
nn1:=-nn1;
nn2:=-nn2;
end;
if j=5 then begin
if Xvar[j,i]<>0 then begin
sv1:=nn1/Xvar[j,i];
sv2:=nn2/Xvar[j,i];
end else begin sv1:=0; sv2:=0; end;
Svar[kvar,i]:=Svar[kvar,i]+sv1*Dvar[4,i];
Svar[kvar+1,i]:=Svar[kvar+1,i]+sv2*Dvar[4,i];
end;
Svar[kvar,i]:=Svar[kvar,i]+nn1;
Svar[kvar+1,i]:=Svar[kvar+1,i]+nn2;
kvar:=kvar+2;
end;
j:=j+2;
end;
for j:=1 to 500 do begin
For kvar:=1 to ndvar do begin
if kvar <>4 then Svar[j,i]:=Svar[j,i]+Dvar[kvar,i];
end;
end;
end;
For i:=1 to StringGrid1.Colcount-3 do begin
For j:=1 to 500 do begin
StringGrid3.Cells[i,j]:=FloatToStr(Svar[j,i]);
Simd[i]:=Simd[i]+Svar[j,i];
end;
Simd[i]:=Simd[i]/500;
Form8.StringGrid3.Cells[i-1,1]:=FloatToStrF(Simd[i],ffFixed,9,2);
end;
For i:=1 to StringGrid1.ColCount-3 do begin
For j:=i to StringGrid1.ColCount-3 do begin
For kvar:=1 to 500 do begin
Covar[i,j]:=Covar[i,j]+((Svar[kvar,i]-Simd[i])*(Svar[kvar,j]-Simd[j]));
end;
Covar[i,j]:=Covar[i,j]/500;
Form3.StringGrid1.Cells[j,i]:=FloatToStrF(Covar[i,j],ffFixed,12,2);
Form3.StringGrid1.Cells[i,j]:=FloatToStrF(Covar[i,j],ffFixed,12,2);
end;
end;
end;
procedure TForm7.StringGrid1Exit(Sender: TObject);
begin
Try
For j:=3 to StringGrid1.ColCount-1 do begin
i:=1;
While i<=StringGrid1.RowCount-1 do begin
Xvar[i,j-2]:=StrToFloat(StringGrid1.Cells[j,i]);
Xvar[i,j-2]:=(Xvar[i,j-2]+StrToFloat(StringGrid1.Cells[j,i+1]))/2;
Xvar[i+1,j-2]:=Xvar[i,j-2]-StrToFloat(StringGrid1.Cells[j,i]);
i:=i+2;
end;
end;
except
ShowMessage('Неправельный ввод данных!');
FocusControl(StringGrid1);
end;
end;
procedure TForm7.StringGrid2Exit(Sender: TObject);
var
nn1 : real;
begin
Try
For j:=2 to StringGrid2.ColCount-1 do begin
For i:=1 to StringGrid2.RowCount-1 do begin
Dvar[i,j-1]:=StrToFloat(StringGrid2.Cells[j,i]);
If StringGrid2.Cells[0,i]='-' then Dvar[i,j-1]:=-Dvar[i,j-1]
end;
end;
Except
ShowMessage('Неправельный ввод данных!');
FocusControl(StringGrid2);
end;
ndvar:=StringGrid2.RowCount-1;
end;
procedure TForm7.N3Click(Sender: TObject);
Var
Myfile : Textfile;
Date : String;
begin
If (saveDialog1.Execute) then begin
AssignFile(Myfile,Savedialog1.FileName);
Try Rewrite(myFile);
Except
Showmessage('Ошибка при чтении файла!'); Exit;
end;
Date:=IntToStr(StringGrid1.ColCount);WriteLn(MyFile,Date);
Date:=IntToStr(StringGrid1.RowCount);WriteLn(MyFile,Date);
Date:=IntToStr(StringGrid2.ColCount);WriteLn(MyFile,Date);
Date:=IntToStr(StringGrid2.RowCount);WriteLn(MyFile,Date);
For i:=0 to StringGrid1.ColCount do begin
for j:=0 to StringGrid1.RowCount do begin
Date:=StringGrid1.Cells[i,j];
WriteLn(Myfile,Date);
end;
end;
For i:=0 to StringGrid2.ColCount do begin
For j:=0 to StringGrid2.RowCount do begin
Date:=StringGrid2.Cells[i,j];
WriteLn(Myfile,Date);
end;
end;
Closefile(myFile);
end
else Begin Showmessage('Ошибка!'); Exit;end;
end;
end.
Дата: 2019-05-29, просмотров: 203.