Метод экспертных оценок

 

1.4.3 Unit3 - TForm3.FormActivate

1. Начало
2. Задание количество строк (stringgrid1.RowCount:=fakt+1)

3. For i=1 to fakt do

4. Задание значения строк в столбцах таблицы (stringgrid1.Cells[0,i]:=inttostr(dano[i]))
5. Задание значения строк в столбцах таблицы (stringgrid1.Cells[1,i]:=floattostrf(x[i],ffgeneral,3,2))
6. Задание значения строк в столбцах таблицы (stringgrid1.Cells[2,i]:=floattostrf(dis[i],ffgeneral,3,2))
7. Задание значения строк в столбцах таблицы (stringgrid1.Cells[3,i]:=floattostrf(otkl[i],ffgeneral,3,2))
8. Задание значения строк в столбах таблицы (stringgrid1.Cells[4,i]:=floattostrf(v[i],ffgeneral,3,2))
9. Переход к следующему значению I
10. Задание заголовка столбцов таблицы (stringgrid1.Cells[0,0]:='№ объекта')
11. Задание заголовка столбцов таблицы (stringgrid1.Cells[1,0]:='X(ij)')
12. Задание заголовка столбцов таблицы (stringgrid1.Cells[2,0]:='G^2(j)')
13. Задание заголовка столбцов таблицы (stringgrid1.Cells[3,0]:='G(j)')
14. Задание заголовка столбцов таблицы (stringgrid1.Cells[4,0]:='V,%')
15. Вывод значения переменной F в label4 (label4.Caption:=floattostrf(r,ffgeneral,5,2))
16. Вывод значения переменной W в label5 (label5.Caption:=floattostrf(w,ffgeneral,5,2))
17. Если 0.5<r<0.7 истина, то идти к п.  , в противном случае к п.
18. Вывод в label1 сообщения (label1.Caption:= ‘Согласованность экспертов удовл.')
19. Вывод в label1 сообщения (label1.Caption:= ‘Согласованность экспертов неудовл.')
20. Конец

 

 

1.5.1 Текст программы 

unit Unit1; 

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Menus, Grids, StdCtrls, Buttons, ToolWin, ComCtrls, XPMan,

  ExtCtrls, jpeg; 

type

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    StringGrid1: TStringGrid;

    N1: TMenuItem;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    N5: TMenuItem;

    SpeedButton1: TSpeedButton;

    Image1: TImage;

    XPManifest1: TXPManifest;

    SpeedButton2: TSpeedButton;

    procedure N2Click(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);

    procedure SpeedButton1Click(Sender: TObject);

    procedure SpeedButton2Click(Sender: TObject);

    procedure N5Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

  k,fakt,exp:integer;//fakt - количество факторов

  //exp - количество  экспертов; k - вспомогательная переменная

  dano:array[1..20] of integer;

  mas:array[1..20,1..20] of integer;//хранит массив введенных значений

  p:integer;//вспомогательная переменная

  x:array[1..20] of real; //ср. арифметическое по каждому  столбцу

  dis:array[1..20] of real;//дисперсия

  otkl:array[1..20] of real;//ср. квадриатическое отклонение

  v:array[1..20] of real;//коэф. вариации

  r:real; w:real; //коэф. конкордации (W)

  sum1:array[1..20] of integer;//вспомогательная переменная для подсчета суммы по факторам

  sum:array[1..20] of integer;//сумма по факторам 

implementation 

uses Unit2, Unit3, Unit5; 

{$R *.dfm} 

procedure TForm1.N2Click(Sender: TObject);

var

i,j:integer;

begin

if stringgrid1.Visible=true then

 begin

   //обнуление  ("очищение") всех элементов

   for i:=1 to fakt do

    for j:=1 to exp do

    begin

       sum1[i]:=0; sum[i]:=0; v[i]:=0; r:=0;

       dis[i]:=0; x[i]:=0; otkl[i]:=0; w:=0;

      mas[i,j]:=0;

    end;

   for i:=0 to fakt do

    for j:=0 to exp+1 do

     stringgrid1.Cells[i,j]:='';

      SpeedButton2.Visible:=false;

     SpeedButton1.Visible:=false;

    StringGrid1.Visible:=false;

end; 

fakt:=0;

exp:=0;

k:=0; 

form2.ShowModal;

if kont=1 then

begin

stringgrid1.Visible:=true;

stringgrid1.RowCount:=exp+1;

  stringgrid1.ColCount:=fakt+1;

   speedbutton1.Visible:=true;

for i:=1 to exp do

begin

  stringgrid1.Cells[0,i]:=inttostr(dano[i]);

end; 

for i:=1 to fakt do

begin

  stringgrid1.Cells[i,0]:=inttostr(dano[i]);

end; 

   stringgrid1.SetFocus;

end;

end; 

procedure TForm1.N4Click(Sender: TObject);

begin

application.Terminate;

end; 

procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

begin

for i:=1 to 20 do

dano[i]:=i;

application.ShowHint:=true;

end; 

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

case key of

#8,'0'..'9','-':;

chr(13):

begin

if stringgrid1.row<stringgrid1.rowCount-1 then

                        stringgrid1.row:=stringgrid1.row+1

  else if (stringgrid1.row=stringgrid1.rowCount-1) and (stringgrid1.col=fakt) then

  begin

   speedbutton1.Click

  end

  else if stringgrid1.row=stringgrid1.rowCount-1 then

   begin

    stringgrid1.Row:=1;

     stringgrid1.Col:=stringgrid1.Col+1;

   end

  end

else

key := Chr(0);

end; 

end; 

procedure TForm1.SpeedButton1Click(Sender: TObject);

var

j,i: integer; //i,j - вспомогательные переменные

 grect:tgridrect;

begin

if k<>1 then

begin

//запись таблицы в массив

for i:=1 to fakt do

  for j:=1 to exp do

  begin  //проверка "Пустая таблица или нет?"

  if stringgrid1.Cells[i,j]='' then

   begin

   grect.Left:=i;

   grect.Top:=j;

   grect.Right:=i;

   grect.bottom:=j;

    stringgrid1.Selection:=grect;

     MessageDlg('Введите верное значение',mtWarning,[mbOk],0);

     exit;

   end

  else

   begin

    mas[i,j]:=strtoint(stringgrid1.cells[i,j])

   end;

  end;

if messagedlg('Дальнейшее изменение введенных данных будет невозможно'+#13+'Перед тем как нажать "Yes" проверьте их на корректность',mtWarning,[mbYes,mbNo],0)=mrNo then

 exit;

//доб. строки  для вывода суммы по факторам

stringgrid1.RowCount:=exp+2;

//суммы по  факторам

 for i:=1 to fakt do

  for j:=1 to exp do

  begin

   sum1[j]:=strtoint(stringgrid1.Cells[i,j]);

    sum[i]:=sum[i]+sum1[j];

  end;

//вывод суммы по факторам

for i:=1 to fakt do

  stringgrid1.Cells[i,exp+1]:=inttostr(sum[i]);

//ср. арифметическое  по каждому столбцу

for i:=1 to fakt do

  x[i]:=sum[i]/exp;

//дисперсия

for i:=1 to fakt do

  for j:=1 to exp do

  dis[i]:=dis[i]+sqr((mas[i,j]-x[i]))/5;

//ср. квадриатическое  отклонение

for i:=1 to fakt do

  otkl[i]:=sqrt(dis[i]);

//коэф. вариации

for i:=1 to fakt do

  v[i]:=otkl[i]/x[i]*100;

//коэф. конкордации

for i:=1 to fakt do

  r:=r+sqr(sum[i]-x[i]);

   w:=(12*r)/(sqr(exp)*(fakt*fakt*fakt-fakt));

end;

k:=1;

speedbutton2.Visible:=true;

end; 

procedure TForm1.SpeedButton2Click(Sender: TObject);

begin

k:=0;

form3.ShowModal;

end; 

procedure TForm1.N5Click(Sender: TObject);

begin

form5.Visible:=true;

end; 

end. 
 
 

unit Unit2; 

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, unit1; 

type

  TForm2 = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

    Edit1: TEdit;

    Edit2: TEdit;

    Button1: TButton;

    Button2: TButton;

    procedure Button2Click(Sender: TObject);

    procedure EditKeyPress(Sender: TObject; var Key: Char);

    procedure Button1Click(Sender: TObject);

    procedure FormActivate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end; 

var

  Form2: TForm2;

  kont:integer;//если имеет значения 0 - нажата кнопка Отмена

  //1 - нажата кнопка Принять 

implementation 

{$R *.dfm} 

procedure TForm2.Button2Click(Sender: TObject);

begin

kont:=0;

form2.Close;

end; 

procedure TForm2.EditKeyPress(Sender: TObject; var Key: Char);

begin

case key of

'0'..'9','-',chr(8):;

chr(13):

begin

if sender=edit1 then edit2.SetFocus

       else if sender=edit2 then button1.Click;

end

  else key:=chr(0);

end; 

end; 

procedure TForm2.Button1Click(Sender: TObject);

begin

if (edit1.Text='') or (edit2.Text='') then

                                  messagedlg('Данные не были введены',mtinformation,[mbok],0)

else if (edit1.Text='-') or (edit2.Text='-') then