Исходник программы
.docunit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls,Math, AppEvnts ;
const
LF = #10;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
ListBox1: TListBox;
Edit1: TEdit;
ListBox3: TListBox;
Edit2: TEdit;
ListBox4: TListBox;
StatusBar1: TStatusBar;
Timer1: TTimer;
ListBox5: TListBox;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Label9: TLabel;
Label10: TLabel;
GroupBox3: TGroupBox;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Edit3: TEdit;
Label14: TLabel;
GroupBox4: TGroupBox;
ListBox6: TListBox;
Label15: TLabel;
ListBox7: TListBox;
Label16: TLabel;
ListBox8: TListBox;
Label17: TLabel;
Label18: TLabel;
Edit4: TEdit;
Label19: TLabel;
GroupBox5: TGroupBox;
ListBox9: TListBox;
Label20: TLabel;
Label21: TLabel;
Edit5: TEdit;
Label22: TLabel;
GroupBox6: TGroupBox;
Panel1: TPanel;
ListBox10: TListBox;
ListBox11: TListBox;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
ListBox12: TListBox;
Label27: TLabel;
Label28: TLabel;
Edit6: TEdit;
Label29: TLabel;
ListBox13: TListBox;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
ListBox14: TListBox;
Label34: TLabel;
Label35: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
ListBox2: TListBox;
GroupBox2: TGroupBox;
Label1: TLabel;
Label4: TLabel;
Label11: TLabel;
ApplicationEvents1: TApplicationEvents;
procedure BitBtn1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
kol:integer;
dt:string;
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
st:string;
y123,y124,max:integer;
z: array[1..10,1..10] of integer;
matr_sed: array[1..10,1..10] of integer;
matr_ger: array[1..10,1..10] of integer;
matr_ger2: array[1..10,1..10] of real;
min_mas:array[1..10] of integer;
min_mas_hod:array[1..10] of real;
min_mas_ger:array[1..10] of real;
max_mas:array[1..10] of integer;
vich_mas:array[1..10] of real;
mas_par:array[1..10] of real;
mas_bair:array[1..10] of real;
max_el_stol:array[1..10] of integer;
x,j:integer;
st1,n,u:string;
y,dl,min:integer;
min1,c1,c:variant;
max2,znach,znach1,param_bair,ver:real;
begin
listbox1.Clear;
listbox2.Clear;
listbox3.Clear;
listbox4.clear;
listbox5.Clear;
listbox6.Clear;
listbox7.Clear;
listbox8.clear;
listbox9.Clear;
listbox10.Clear;
listbox11.Clear;
listbox12.clear;
listbox13.Clear;
listbox14.clear;
groupbox1.Visible:=false;
groupbox2.Visible:=false;
groupbox3.Visible:=false;
groupbox4.Visible:=false;
groupbox5.Visible:=false;
groupbox6.Visible:=false;
dt:=InputBox('Размер матрицы', 'Количество исследований-3','3');
kol:=strtoint(dt);
//dt:='3';
j:=1;
for x:=1 to kol do
begin
for y:=1 to kol do
begin
n:=inputbox('Введите элемент:'+inttostr(j),'','');
z[x,y]:=Strtoint(n);
j:=j+1;
end;
end;
////Вывод массива
y123:=0;
y124:=0;
st:='';
for y:=1 to kol do
begin
for x:=1 to kol do
begin
y123:=Length(inttostr(z[x,y]));
if (y123<6 ) then y124:=6-y123;
st1:=inttostr(z[x,y]);
for dl:=1 to y124 do
begin
st1:=' '+st1;
end;
st:=st+st1;
end;
listbox4.Items.Add(st);
st:='';
end;
listbox4.Visible:=true;
if (Checkbox1.Checked=true) then
begin
groupbox2.Visible:=true;
////Минимальные
y:=1;
while y<=kol do
begin
x:=1;
min1:=z[x,y];
max:= z[x,y];
while x<=kol do
begin
if min1>z[x,y] then min1:=z[x,y];
if max<z[x,y] then max:=z[x,y];
x:=x+1;
end;
min_mas[y]:=min1;
max_mas[y]:=max;
y:=y+1;
end;
///////////////////
for x:=1 to kol do
begin
listbox1.Items.Add(inttostr(min_mas[x]));
end;
listbox1.Visible:=true;
////////////////////////////////////
max:=min_mas[1];
for x:=1 to kol do
begin
if (max<min_mas[x]) then max:=min_mas[x];
end;
edit1.text:=inttostr(max);
edit1.Visible:=true;
for x:=1 to kol do
begin
listbox2.Items.Add(inttostr(max_mas[x]));
end;
listbox2.Visible:=true;
///////////////////////////////////
end;
if (Checkbox2.Checked=true) then
begin
c:=InputBox('Критерий Гурвица', '','0,5');
Label32.Caption:=c;
c:=strtofloat(c);
c1:=1-c;
groupbox1.Visible:=true;
/////////Минимальный, максимальный массив
y:=1;
while y<=kol do
begin
x:=1;
min1:=z[x,y];
max:= z[x,y];
while x<=kol do
begin
if min1>z[x,y] then min1:=z[x,y];
if max<z[x,y] then max:=z[x,y];
x:=x+1;
end;
min_mas[y]:=min1;
max_mas[y]:=max;
y:=y+1;
end;
//////////////////////////////////////
for x:=1 to kol do
begin
vich_mas[x]:=min_mas[x]*c+max_mas[x]*c1;
end;
max2:= vich_mas[1];
for x:=1 to kol do
begin
if (max2<vich_mas[x]) then max2:=vich_mas[x];
end;
edit2.text:=floattostr(max2);
edit2.Visible:=true;
for x:=1 to kol do
begin
listbox3.Items.Add(floattostr(vich_mas[x]));
end;
listbox3.Visible:=true;
end;
/////////////////Байеса-Лапласа
if (Checkbox3.Checked=true) then
begin
groupbox3.Visible:=true;
for x:=1 to kol do
begin
n:=inputbox('Введите параметр Байеса-Лапласа:','0.5,0.3,0.2','');
mas_par[x]:=StrtoFloat(n);
listbox14.Items.Add(n);
j:=j+1;
end;
listbox14.Visible:=true;
znach1:=0;
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
znach:=0;
param_bair:=mas_par[x];
znach:=z[x,y]*param_bair;
znach1:=znach1+znach;
x:=x+1;
end;
mas_bair[y]:=znach1;
znach1:=0;
y:=y+1
end;
////Вывод в Box
for x:=1 to kol do
begin
listbox5.Items.Add(floattostr(mas_bair[x]));
end;
listbox5.Visible:=true;
/////Поиск максимального значения
max2:=mas_bair[1];
for x:=1 to kol do
begin
if (max2<mas_bair[x]) then max2:=mas_bair[x];
end;
edit3.text:=floattostr(max2);
edit3.Visible:=true;
end;
////Критерий Сэвиджа
if (Checkbox4.Checked=true) then
begin
groupbox4.Visible:=true;
y:=1;
while y<=kol do
begin
x:=1;
max:= z[y,x];
while x<=kol do
begin
if max<z[y,x] then max:=z[y,x];
x:=x+1;
end;
max_el_stol[y]:=max;
y:=y+1;
end;
////////////////////////
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
matr_sed[y,x]:=max_el_stol[y]-z[y,x];
x:=x+1;
end;
y:=y+1;
end;
///////////
y123:=0;
y124:=0;
st:='';
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
y123:=Length(inttostr(matr_sed[x,y]));
if (y123<6 ) then y124:=6-y123;
st1:=inttostr(matr_sed[x,y]);
x:=x+1;
for dl:=1 to y124 do
begin
st1:=' '+st1;
end;
st:=st+st1;
end;
listbox7.Items.Add(st);
st:='';
y:=y+1;
end;
listbox7.Visible:=true;
/////////////
listbox6.Clear;
for x:=1 to kol do
begin
listbox6.Items.Add(inttostr( max_el_stol[x]));
end;
listbox6.Visible:=true;
///Максимальный
y:=1;
while y<=kol do
begin
x:=1;
max:= matr_sed[x,y];
while x<=kol do
begin
if max<matr_sed[x,y] then max:=matr_sed[x,y];
x:=x+1;
end;
max_mas[y]:=max;
y:=y+1;
end;
for x:=1 to kol do
begin
listbox8.Items.Add(inttostr(max_mas[x]));
end;
listbox8.Visible:=true;
////////////
min:=max_mas[1];
for x:=1 to kol do
begin
if (min>max_mas[x]) then min:=max_mas[x];
end;
edit4.text:=inttostr(min);
edit4.Visible:=true;
end;
if (Checkbox5.Checked=true) then
begin
//////Ходжа-Лемана
c:=InputBox('Введите критерий Ходжа-Лемана <=0.4', '','0,4');
label35.Caption:=c;
groupbox5.Visible:=true;
znach:=1-c;
ver:=roundto(1/kol,-2);
y:=1;
while y<=kol do
begin
x:=1;
min1:=z[x,y];
znach1:=0;
while x<=kol do
begin
if min1>z[x,y] then min1:=z[x,y];
znach1:=znach1+z[x,y]*ver;
x:=x+1;
end;
znach1:=znach1*znach;
znach1:=znach1+ (min1*c);
min_mas_hod[y]:=roundto(znach1,-2);
y:=y+1;
end;
/////////////
listbox9.Clear;
for x:=1 to kol do
begin
listbox9.Items.Add(floattostr( min_mas_hod[x]));
end;
listbox9.Visible:=true;
///////////////
Max2:=min_mas_hod[1];
for x:=1 to kol do
begin
if (max2<min_mas_hod[x]) then max2:=min_mas_hod[x];
end;
edit5.text:=floattostr(max2);
edit5.Visible:=true;
end;
////////Метод Гермейера/////
if (Checkbox6.Checked=true) then
begin
groupbox6.Visible:=true;
for x:=1 to kol do
begin
n:=inputbox('Введите параметры Гермейера:','0.5,0.3,0.2','');
listbox13.Items.Add(n);
mas_par[x]:=StrtoFloat(n);
j:=j+1;
end;
listbox13.Visible:=true;
///Ищем максимум заданной матрицы z[x,y]
y:=1;
max:=z[1,1];
while y<=kol do
begin
x:=1;
while x<=kol do
begin
if max<z[x,y] then max:=z[x,y];
x:=x+1;
end;
y:=y+1;
end;
max:=max+1;
//////Получаем матрицу остатков
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
matr_ger[x,y]:=z[x,y]-max;
x:=x+1;
end;
y:=y+1;
end;
///////////// Вывод на экран расчет
///////////
y123:=0;
y124:=0;
st:='';
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
y123:=Length(inttostr(matr_ger[x,y]));
if (y123<6 ) then y124:=6-y123;
st1:=inttostr(matr_ger[x,y]);
x:=x+1;
for dl:=1 to y124 do
begin
st1:=' '+st1;
end;
st:=st+st1;
end;
listbox10.Items.Add(st);
st:='';
y:=y+1;
end;
listbox10.Visible:=true;
////Умножаем на заданные параметры
x:=1;
while x<=kol do
begin
y:=1;
while y<=kol do
begin
matr_ger2[x,y]:=matr_ger[x,y]*mas_par[x];
y:=y+1;
end;
x:=x+1;
end;
////////////////////// Вывод второй матрицы вычислений
y123:=0;
y124:=0;
st:='';
y:=1;
while y<=kol do
begin
x:=1;
while x<=kol do
begin
y123:=Length(floattostr(matr_ger2[x,y]));
if (y123<6 ) then y124:=6-y123;
st1:=floattostr(matr_ger2[x,y]);
x:=x+1;
for dl:=1 to y124 do
begin
st1:=' '+st1;
end;
st:=st+st1;
end;
listbox11.Items.Add(st);
st:='';
y:=y+1;
end;
listbox11.Visible:=true;
////////В матрице 2 ищем минимальные значения по строкам
y:=1;
while y<=kol do
begin
x:=1;
min1:=matr_ger2[x,y];
while x<=kol do
begin
if min1>matr_ger2[x,y] then min1:=matr_ger2[x,y];
x:=x+1;
end;
min_mas_ger[y]:=min1;
y:=y+1;
end;
/// Вывод минимального массива
for x:=1 to kol do
begin
listbox12.Items.Add(floattostr(min_mas_ger[x]));
end;
listbox12.Visible:=true;
////Завершающий этап
Max2:=min_mas_ger[1];
for x:=1 to kol do
begin
if (max2<min_mas_ger[x]) then max2:=min_mas_ger[x];
end;
edit6.text:=floattostr(max2);
edit6.Visible:=true;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
statusbar1.Panels[0].Text:=TimeToStr(Time) ;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
statusbar1.Panels[1].Text:=Application.ExeName;
end;
procedure TForm1.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
kol:=3;
end;
end.