|
Состояние
|
Нормальное функциониро-вание
|
Режим функции сохранения питания
|
|
Временный режим
|
Режим отключения питания
|
|
1
|
2
|
3
|
4
|
|
Горизонтальная
Вертикальная
Видео
|
Активна
Активна
Активна
|
Активна / Не активна
Не активна / Активна
Не используется
|
Не активный
Не активный
Не используется
|
|
Индикатор
(Цвет LED)
|
Зеленый
|
Оранжевый
|
Оранжевый,
Зеленый,
Мигающий (интервал 1 сек)
|
|
Потребление мощности
|
до 80 Вт
|
Меньше 15 Вт
|
Меньше
8 Вт
|
В соответствии со спецификацией VESA
монитор может находиться в одном из четырех режимов: On
(включен), Stand by ("дежурный", или
"ждущий"), Suspend (минимальное потребление
электроэнергии) и Off (выключен). Переход на каждый
следующий режим происходит после определенного времени не активности, которое
задается программно.
Нормы энергосбережения содержатся также в стандарте ТСО-99.
Производство:
вопросы защиты окружающей среды в процессе производства компьютеров
возникли давно. Они регламентируются, в частности, стандартом NUTEK, по которому контролируются выбросы
токсичных веществ, условия работы и др. Согласно стандарту произведенное
оборудование может быть сертифицировано лишь в том случае, если не только контролируемые
параметры самого
оборудования соответствуют требованиям этого стандарта, но и технология производства
этого оборудования отвечает требованиям стандарта.
Утилизация:
расширение областей применения компьютерной техники, ее быстрое моральное
старение остро ставит вопрос о необходимости разработки новых технологий переработки
компьютерного лома.
До
недавнего времени при утилизации старых компьютеров происходила их разработка на фракции:
металлы, пластмассы, стекло, провода, штекеры. Вторичные ресурсы металлов складываются из лома (3-4 %) и отходов (57 %).
Из одной тонны компьютерного лома получают до 200 кг меди, 480 кг железа и
нержавеющей стали, 32 кг алюминия, 3 кг серебра, 1 кг золота и 300 г палладия.
В
настоящее время разработаны следующие методы переработки компьютерного лома и защиты
литосферы от него:
- сортировка печатных плат по
доминирующим материалам;
- дробление и измельчение;
- гранулирование, в отдельных
случаях сепарация;
- обжиг полученной массы для
удаления сгорающих компонент;
- расплавление полученной
массы, рафинирование;
- прецизионное извлечение
отдельных металлов;
- создание экологических схем
переработки компьютерного лома;
- создание экологически чистых
компьютеров.
В
последнее время приняты радикальные меры по улучшению разделки, сортировки и использования
лома и отходов цветных металлов. Важной задачей является переработка медных
проводов и кабелей, так как более одной трети меди идет на производство проводов.
Лучшим
способом разделки проводов можно считать отделение изоляции от проволоки
механическим способом. С помощью грануляторов специальной конструкции
удовлетворительно решена проблема отделения термоплавкой и резиновой изоляции.
Установка пригодна
для переработки проволоки, изолированной термопластом и бумагой. Установка не
пригодна для некоторых типов проводов, изолированных хлопчатобумажной тканью,
для кабелей со свинцовой оболочкой и для всех сортов изоляции, которая
прилипает к проводу так, что не отделяется от металла даже при очень тонкой
грануляции. При переработки проводов, у которых разделение изоляции и меди
осуществляется удовлетворительно и почти без потерь получается термопласт,
последний может служить сырьем для изготовления менее ответственных деталей.
Если
между проводами, изолированными термопластом, есть изоляция из ткани, ее можно удалить из
смеси кусков меди и изоляции с помощью отсасывающего устройства. Эта установка закрыта и механизирована, требует
минимального обслуживания и обеспечивает производительность - 500 тонн изолированной проволоки
в год. При
работе установки не загрязняется атмосфера, технология экономически более
выгодна, чем обжиг изоляции в печах.
Переработку
промышленных отходов производят на специальных
полигонах, создаваемых в соответствии с требованиями СНиП 2.01.28-85 и предназначенных для централизованного сбора
обезвреживания и захоронения токсичных отходов промышленных предприятий, НИИ и учреждений.
При
всех существующих способах переработки компьютерного лома необходимы новые, более
совершенные, экологически чистые методы.
Таким образом, параметры экологической
оценки компьютера как объекта загрязнения окружающей среды в рассматриваемом
помещение соответствуют оптимальным нормам /25/.
1
В дипломной работе разработана новая модель оценки
уровня риска инвестиционного проекта, сочетающая в себе достоинства уже
применяемых в практике моделей.
2
Для однозначной характеристики уровня риска проекта
было предложено использование нечетко-множественной модели принятия решения.
3
Новая модель использует свертку трех критериев
оценки уровня риска проекта: вероятность попадания в зону неэффективности,
критерий ликвидности и критерий покрытия, при помощи которых наиболее полно
можно охарактеризовать неопределенность существующей информационной среды.
4
Разработана технология использования нечеткого
вывода для принятия решения по оценке уровня риска инвестиционного проекта.
5
Разработано программно-алгоритмическое обеспечение
расчета значений используемых в модели критериев и объединения их в один общий
показатель, характеризующий уровень риска проекта.
6
Преимущества разработанной модели были показаны при
оценке уровня риска инвестиционного проекта строительства завода труб большого
диаметра в Нижнем Тагиле.
7
В разделе безопасность жизнедеятельности учтено
влияние опасных и вредных факторов и проведен расчет защитного зануления.
1
Савчук В.П. Оценка инвестиционных проектов. – На
сайте:
2
Каблуков В.В. Модели оценки рисков стратегических
инвестиционных проектов: Дис…кандидата экономических наук. – Санкт-Петербург,
1999. – 167 с.
3
#"_Toc64360542"> Приложение Б. Текст программы
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;
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;
//-----------------------------рассчет
прогнозного занчения 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
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 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;
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.