unit Human;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls, SetPlace,nature,inputdat,SysUtils;

Const

ValC:array[1..8,1..30] of integer = (
(4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4),
(4,4,4,4,4,4,4,4,4,4,4,4,4,4,3,4,4,4,3,2,4,4,3,2,1,4,3,2,1,1),
(4,4,4,4,4,4,4,4,4,3,4,4,4,3,2,4,4,3,2,1,4,3,2,1,1,3,2,1,1,1),
(4,4,4,4,3,4,4,4,3,2,4,4,3,2,1,4,3,2,1,1,3,2,1,1,1,2,1,1,1,1),
(4,4,4,3,2,4,4,3,2,1,4,3,2,1,1,3,2,1,1,1,2,1,1,1,1,1,1,1,1,1),
(4,4,3,2,1,4,3,2,1,1,3,2,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(3,2,1,1,1,3,2,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(2,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
);


ValA:array[1..8,1..8] of integer = ((5,5,4,4,4,4,4,2),(5,5,4,4,4,4,3,1),
(5,5,4,4,3,3,2,1),(5,4,4,3,2,2,1,1),(5,3,3,2,1,1,1,1),(4,2,2,1,1,1,1,1),
(3,1,1,1,1,1,1,1),(2,1,1,1,1,1,1,1));


ValB:array[1..8,1..19] of integer = ((4,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3),
(4,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2),
(4,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1),
(4,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1),
(4,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1),
(3,1,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1),
(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1));



  type
  TDlghumanos = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    Site: TComboBox;
    Label1: TLabel;
    ComboBox2: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    ComboBox3: TComboBox;
    Label4: TLabel;
    ComboBox4: TComboBox;
    Label5: TLabel;
    ComboBox5: TComboBox;
    Label6: TLabel;
    ComboBox6: TComboBox;
    Label7: TLabel;
    ComboBox7: TComboBox;
    Label8: TLabel;
    ComboBox8: TComboBox;
    Label9: TLabel;
    ComboBox1: TComboBox;
    Bevel1: TBevel;
    Button1: TButton;
    Button2: TButton;
    Label10: TLabel;
    Edit1: TEdit;
    EditInten: TEdit;
    Label11: TLabel;
    Button3: TButton;
    procedure FormActivate(Sender: TObject);
    procedure SiteChange(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox6Change(Sender: TObject);
    procedure ComboBox7Change(Sender: TObject);
    procedure ComboBox8Change(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SetIntensity(var max:real;var l:integer);
    function romano(valor:real):string;
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


  var
  Dlghumanos: TDlghumanos;
  cp:array[1..12] of integer; {para contar los efectos diferentes de 0}
  cp_no:array[1..12] of integer; {para contar los efectos iguales a 0}


implementation

{$R *.DFM}

procedure TDlghumanos.FormActivate(Sender: TObject);
var
i,j,temp:integer;
begin
 if Site.ItemIndex>=0 then {check for calculate intensity}
  begin
   temp:=indexsite;
   indexsite:=Site.ItemIndex;
   if indexsite<>temp then
    Button2Click(sender);
   indexsite:=temp;
  end;
 Site.items.clear;
 for i:=1 to MaxSelSite do
   Site.items.add(SelSite[i].code);

 Site.ItemIndex := indexsite;
 Site.text:= SelSite[indexsite+1].code;
 SiteChange(Sender);
 Site.SetFocus;
end;

procedure TDlghumanos.SiteChange(Sender: TObject);
var
 Idx:integer;
begin
    if indexsite<>Site.ItemIndex then
     Button2Click(sender);

    Idx:=Site.ItemIndex + 1;
    indexsite:=Site.ItemIndex;
   if EfecHuman[Idx].efecto[1]=0 then
     ComboBox2.text:='No Selected'
    else
     ComboBox2.text:=ComboBox2.items[EfecHuman[Idx].efecto[1]];

   if EfecHuman[Idx].efecto[2]=0 then
     ComboBox3.text:='No Selected'
    else
     ComboBox3.text:=ComboBox3.items[EfecHuman[Idx].efecto[2]];

   if EfecHuman[Idx].efecto[3]=0 then
     ComboBox4.text:='No Selected'
    else
     ComboBox4.text:=ComboBox4.items[EfecHuman[Idx].efecto[3]];

   if EfecHuman[Idx].efecto[4]=0 then
     ComboBox5.text:='No Selected'
    else
     ComboBox5.text:=ComboBox5.items[EfecHuman[Idx].efecto[4]];

   if EfecHuman[Idx].efecto[5]=0 then
     ComboBox6.text:='No Selected'
    else
     ComboBox6.text:=ComboBox6.items[EfecHuman[Idx].efecto[5]];

   if EfecHuman[Idx].efecto[6]=0 then
     ComboBox7.text:='No Selected'
    else
     ComboBox7.text:=ComboBox7.items[EfecHuman[Idx].efecto[6]];

   if EfecHuman[Idx].efecto[7]=0 then
     ComboBox8.text:='No Selected'
    else
      ComboBox8.text:=ComboBox8.items[EfecHuman[Idx].efecto[7]];
   if EfecHuman[Idx].efecto[8]=0 then
     ComboBox1.text:='No Selected'
    else
      ComboBox1.text:=ComboBox1.items[EfecHuman[Idx].efecto[8]];

 Button2Click(sender);
end;

procedure TDlghumanos.ComboBox2Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[1]:= ComboBox2.ItemIndex;
end;

procedure TDlghumanos.ComboBox3Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[2]:=ComboBox3.ItemIndex;
end;

procedure TDlghumanos.ComboBox4Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[3]:=ComboBox4.ItemIndex;
end;

procedure TDlghumanos.ComboBox5Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[4]:=ComboBox5.ItemIndex;
end;

procedure TDlghumanos.ComboBox6Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[5]:=ComboBox6.ItemIndex;
end;

procedure TDlghumanos.ComboBox7Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[6]:=ComboBox7.ItemIndex;
end;

procedure TDlghumanos.ComboBox8Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[7]:=ComboBox8.ItemIndex;
end;


procedure TDlghumanos.OKBtnClick(Sender: TObject);
var
 i:integer;
begin
  Button2Click(sender);
  for i:=1 to MaxSelSite do
    begin
      SelSite[i].efecto:=EfecHuman[i].efecto;
      SelSite[i].natura:=EfecHuman[i].natura;
      SelSite[i].ClaseVul:=EfecHuman[i].ClaseVul;
      SelSite[i].intensidad:=EfecHuman[i].intensidad;
     end;
   close;
end;


procedure TDlghumanos.CancelBtnClick(Sender: TObject);
var
i:integer;
begin
  for i:=1 to MaxSelSite do
   begin
    EfecHuman[i].efecto:=SelSite[i].efecto;
    EfecHuman[i].natura:=SelSite[i].natura;
    EfecHuman[i].ClaseVul:=SelSite[i].ClaseVul;
    EfecHuman[i].intensidad :=SelSite[i].intensidad;
   end;
close;
end;

procedure TDlghumanos.ComboBox1Change(Sender: TObject);
begin
  EfecHuman[Site.ItemIndex+1].efecto[8]:=ComboBox1.ItemIndex;
end;

procedure TDlghumanos.HelpBtnClick(Sender: TObject);
begin
Application.HelpJump('Effect_humans');
end;

procedure TDlghumanos.Button1Click(Sender: TObject);
begin
Natura.show;
end;


procedure TDlghumanos.Button2Click(Sender: TObject);
var
max,percent1:real;
i:integer;
cad:string;
begin
 percent1:=0;
 SetIntensity(max,i);
 if (EfecHuman[indexsite+1].efecto[1]=1) and ((i<>2) or (max<0.5)) then
   Application.MessageBox('Error in the input data',
       'Error', mb_OK);
 if EfecHuman[indexsite+1].efecto[1]=1 then
  begin
   max:=0;
   EfecHuman[indexsite+1].intensidad:=0;
  end;
 if (max>0.66) then
  begin
  if (i<>0) and ((cp[i+1]+cp_no[i+1])<>0) then
   percent1:= cp[i+1]/(cp[i+1]+cp_no[i+1]);
   if percent1=max then
    begin
      EditInten.Text:=romano(i+0.5) +' with '+
      InttoStr(trunc(percent1*100))+'%'+ ' and '+
      InttoStr(trunc(max*100))+'% of effects';
      EfecHuman[indexsite+1].intensidad:=i+0.5;
    end else begin
      EditInten.Text:=romano(i)+' with '+
      InttoStr(trunc(max*100))+'% of effects';
      EfecHuman[indexsite+1].intensidad:=i;
     end;
     Str(EfecHuman[indexsite+1].intensidad:4:1,cad);
     Edit1.Text:=cad
  end else
  begin
   if max=0 then
     begin
      EditInten.Text:='No perceptibility';
      Edit1.Text:='0';
     end
    else
     begin
      if max<=0.5 then
       Application.MessageBox('Probable contradiction in the data',
       'Warning', mb_OK);
       EditInten.Text:=romano(i)+' with '+
       InttoStr(trunc(max*100))+'% of effects';
       EfecHuman[indexsite+1].intensidad:=i;
       Str(EfecHuman[indexsite+1].intensidad:4:1,cad);
       Edit1.Text:=cad
     end
  end
end;

procedure TDlghumanos.SetIntensity(var max:real;var l:integer);
var
 i,j,k:integer;
 percent,percent1:real;
begin
 for i:=2 to 12 do
  begin
   cp[i]:=0;
   cp_no[i]:=0;
  end;
 for i:=1 to 8 do
   for j:=1 to 8 do
     if EfecHuman[indexsite+1].efecto[j]<>0 then
      begin
       if EfecHuman[indexsite+1].efecto[j]=ValA[i,j] then
        cp[10-i]:=cp[10-i]+1
        else
       cp_no[10-i]:=cp_no[10-i]+1;
      end;
 for i:=1 to 8 do
   for j:=1 to 19 do
    if (EfecHuman[indexsite+1].natura[j]<>0) then
     begin
      if EfecHuman[indexsite+1].natura[j]=ValB[i,j] then
       cp[10-i]:=cp[10-i]+1
       else
       cp_no[10-i]:=cp_no[10-i]+1;
     end;
 for i:=1 to 8 do
  for j:=1 to 6 do
   for k:=1 to 5 do
    if (EfecHuman[indexsite+1].claseVul[j,k]<>0) then
     begin
      if EfecHuman[indexsite+1].claseVul[j,k]=ValC[i,k+5*(j-1)] then
       cp[13-i]:=cp[13-i]+1
       else
       cp_no[13-i]:=cp_no[13-i]+1;
     end;
 percent:=0;
 percent1:=0;
 max:=0;
 i:=0;
 for j:=12 downto 2  do
 begin
 if (cp[j]+cp_no[j])<>0 then
  percent:=cp[j]/(cp[j]+cp_no[j]);
  if percent>=max then
   begin
    max:=percent;
    i:=j;
   end
  end;
  l:=i;
 if (max>0.66) then
  begin
  if (i<>0) and ((cp[i+1]+cp_no[i+1])<>0) then
   percent1:= cp[i+1]/(cp[i+1]+cp_no[i+1]);
   if percent1=max then
      EfecHuman[indexsite+1].intensidad:=i+0.5
    else
      EfecHuman[indexsite+1].intensidad:=i;
  end else
  begin
   if (max>0) then
       EfecHuman[indexsite+1].intensidad:=i;
  end
end;

function TDlghumanos.romano(valor:real):string;
 begin
  if valor=0 then romano:=' ';
  if valor=2 then romano:='II';
  if valor=2.5 then romano:='II-III';
  if valor=3 then romano:='III';
  if valor=3.5 then romano:='III-IV';
  if valor=4 then romano:='IV';
  if valor=4.5 then romano:='IV-V';
  if valor=5 then romano:='V';
  if valor=5.5 then romano:='V-VI';
  if valor=6 then romano:='VI';
  if valor=6.5 then romano:='VI-VII';
  if valor=7 then romano:='VII';
  if valor=7.5 then romano:='VII-VIII';
  if valor=8 then romano:='VIII';
  if valor=8.5 then romano:='VIII-IX';
  if valor=9 then romano:='IX';
  if valor=9.5 then romano:='IX-X';
  if valor=10 then romano:='X';
  if valor=10.5 then romano:='X-XI';
  if valor=11 then romano:='XI';
  if valor=11.5 then romano:='XI-XII';
  if valor=12 then romano:='XII';
 end;

procedure TDlghumanos.Button3Click(Sender: TObject);
begin
Button2Click(sender);
if  Site.ItemIndex<MaxSelsite-1 then
Site.ItemIndex:=Site.ItemIndex + 1 else
Site.ItemIndex:=0;
SiteChange(Sender);
end;

end.
