unit Intensid;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ExtCtrls,setplace,
  Nature,human,Construc,passign,
  map,inputdat,Isosis,about,Pictur, ExtDlgs;

type
  TPRINCIPAL = class(TForm)
    MainMenu1: TMainMenu;
    quake: TMenuItem;
    EditData: TMenuItem;
    Image: TMenuItem;
    Save: TMenuItem;
    Exit1: TMenuItem;
    Intensity: TMenuItem;
    selectplace: TMenuItem;
    ISOSISTAS: TMenuItem;
    Config: TMenuItem;
    IsoView: TMenuItem;
    Options: TMenuItem;
    About1: TMenuItem;
    Help1: TMenuItem;
    InputEfect: TMenuItem;
    AddImage1: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    ImageTemp: TImage;
    SaveDialog1: TSaveDialog;
    EMS1: TMenuItem;
    EditIntensity: TMenuItem;
    procedure EXIT1Click(Sender: TObject);
    procedure selectplaceClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure IsoViewClick(Sender: TObject);
    procedure EditDataClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ConfigClick(Sender: TObject);
    procedure SaveClick(Sender: TObject);
    procedure Help1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure InputEfectClick(Sender: TObject);
    procedure ImageClick(Sender: TObject);
    procedure AddImage1Click(Sender: TObject);
    procedure EMS1Click(Sender: TObject);
    procedure EditIntensityClick(Sender: TObject);
    {procedure InicioClick(Sender: TObject);}
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  PRINCIPAL: TPRINCIPAL;
  F:Text;
  initial:Boolean;
  F2:textfile;


implementation

{$R *.DFM}


procedure savedialog(cadmac,cadmod:string);
var
k,j,i:integer;
cadsite,cadfelt,cad,cadimg:string;
begin
      cadmac[80]:='2';
      writeln(F2,cadmac);
      writeln(F2,cadmod);
      for i:=1 to NumberImage  do
       begin
        cadimg:=' MAC';
        cadimg:=concat(cadimg,' ',ImageList[i]);
        for k:=length(cadimg) to 80 do
         cadimg:=cadimg+' ';
        cadimg[79]:='P';
        cadimg[80]:='3';
        writeln(F2,cadimg);
       end;
      for i:=1 to Maxselsite  do
       begin
        cadfelt:=' MAC';
        cadsite:=' MAC';
        cadsite:=concat(cadsite,' ',SelSite[i].code);
        for k:=length(SelSite[i].code) to 39 do
         cadsite:=cadsite+' ';
        Str(SelSite[i].latitud:7:3,cad);
        cadsite:=concat(cadsite,' ',cad);
        Str(SelSite[i].longitud:8:3,cad);
        cadsite:=concat(cadsite,' ',cad);
        Str(SelSite[i].intensidad:4:1,cad);
        cadsite:=concat(cadsite,' ',cad);
        for k:=length(cadsite) to 80 do
         cadsite:=cadsite+' ';
        cadsite[79]:='S';
        cadsite[80]:='3';
        writeln(F2,cadsite);
        cad:='';
        for j:=1 to 8 do
         cad:=cad + chr(SelSite[i].efecto[j]+48);
        for j:=1 to 19 do
         cad:=cad+chr(SelSite[i].Natura[j]+48);
        for k:=1 to 6 do
         for j:=1 to 5 do
          cad:=cad+chr(SelSite[i].ClaseVul[k,j]+48);
        cadfelt:=concat(cadfelt,' ',copy(SelSite[i].code,1,6));
        for k:=length(copy(SelSite[i].code,1,6)) to 5 do
         cadfelt:=cadfelt+' ';
        cadfelt:=concat(cadfelt,' ',cad);
        DatosTerr.existe:=True;
        for k:=length(cadfelt) to 80 do
         cadfelt:=cadfelt+' ';
        cadfelt[79]:='O';
        cadfelt[80]:='3';
        writeln(F2,cadfelt);
       end;
end;

procedure Savequake;
var
k,j,i,inic:integer;
cadmod,cadsite,cadfelt,cad,cadquake,cadmac,cadimg:string;
filename:string;
F1:TextFile;
Savefile,saveflag:boolean;
begin
 cadquake:='';
 cadmac:='';
 cadmod:=' MAC';
  Str(DatosTerr.ano:4,cad);
  cadquake:=concat(cadquake,' ',cad);
  Str(DatosTerr.mes:2,cad);
  cadquake:=concat(cadquake,' ',cad);
  Str(DatosTerr.dia:2,cad);
  cadquake:=concat(cadquake,cad);
  Str(DatosTerr.hour:2,cad);
  cadquake:=concat(cadquake,' ',cad);
  Str(DatosTerr.minutes:2,cad);
  cadquake:=concat(cadquake,cad);
  Str(DatosTerr.seconds:4:1,cad);
  cadquake:=concat(cadquake,' ',cad);
  Str(DatosTerr.Latitud:7:3,cad);
  cadquake:=concat(cadquake,'   ',cad);
  Str(DatosTerr.Longitud:8:3,cad);
  cadquake:=concat(cadquake,cad);
  Str(DatosTerr.H:5:1,cad);
  cadquake:=concat(cadquake,cad);
  Str(DatosTerr.Magnitud:3:1,cad);
  cadquake:=concat(cadquake,'             ',cad);
  Str(DatosTerr.intensidad:2,cad);
  cadmac:=concat(cadmac,'                           ',cad);
  Str(DatosTerr.Lat_M:6:2,cad);
  cadmac:=concat(cadmac,'    ',cad);
  Str(DatosTerr.Long_M:7:2,cad);
  cadmac:=concat(cadmac,' ',cad);
  Str(DatosTerr.Mag_M:3:1,cad);
  cadmac:=concat(cadmac,' ',cad);
  cad:=copy(DatosTerr.CodZona,1,8);
  for i:=length(cad) to 7 do
   cad:=cad+' ';
  cadmod:=concat(cadmod,' ',cad);
  cadmod:=concat(cadmod,' ',DatosTerr.direccion);
  Str(DatosTerr.A_B:4:2,cad);
  cadmod:=concat(cadmod,' RT:',cad);
  Str(DatosTerr.azimut:3,cad);
  cadmod:=concat(cadmod,' AZ:',cad);
  Str(DatosTerr.a:4:2,cad);
  cadmod:=concat(cadmod,' A:',cad);
  Str(DatosTerr.b:5:2,cad);
  cadmod:=concat(cadmod,' B:',cad);
  Str(DatosTerr.c:7:4,cad);
  cadmod:=concat(cadmod,' C:',cad);
  Str(DatosTerr.d:3:1,cad);
  cadmod:=concat(cadmod,' D:',cad);
  Str(DatosTerr.H_M:5:1,cad);
  cadmod:=concat(cadmod,' ',cad);
  for i:=length(cadquake) to 80 do
   cadquake:=cadquake+' ';
  cadquake[80]:='1';
  for i:=length(cadmac) to 80 do
   cadmac:=cadmac+' ';
  cadmac[80]:='2';
  for i:=length(cadmod) to 80 do
   cadmod:=cadmod+' ';
  cadmod[79]:='M';
  cadmod[80]:='3';
  savefile:=false;
  if (ParamCount<1) and principal.SaveDialog1.Execute then
    savefile:=true;
  AssignFile(F2,sdir+'\temp.tmp');
  Rewrite(F2);
  if ParamCount>=1 then
  begin
  filename:=ParamStr(1);
  if pos('\',filename)=0 then
  AssignFile(F1, sdir+'\'+filename) {was call from current directory}
  else
  AssignFile(F1, filename);
  {$I-}
    Reset(F1);
  {$I+}
  end;
  if (ParamCount>=1) and (IOResult = 0) then
  begin
  saveflag:=true;
  inic:=0;
  while not Eof(F1) do
   begin
    inic:=inic+1;
    Readln(F1, cad);
    if ((length(cad)<80) or (cad[80]='1')
           or (cad[80]=' ')) and (inic=1) then
     begin
      for i:=21 to 23 do
       cadquake[i]:=cad[i];
      for i:=44 to 56 do
       cadquake[i]:=cad[i];
      for i:=60 to 80 do
       cadquake[i]:=cad[i];
      writeln(F2,cadquake);
     end else
     if cad[80]='2' then
      begin
       for i:=1 to 27 do
       cadmac[i]:=cad[i];
       for i:=30 to 33 do
       cadmac[i]:=cad[i];
       for i:=52 to 80 do
       cadmac[i]:=cad[i];
      end else
      if (cad[80]='7') and saveflag then
       begin
        savedialog(cadmac,cadmod);
        writeln(F2,cad);
        saveflag:=false;
       end else
      if (cad[80]=' ') and saveflag then
       begin
        savedialog(cadmac,cadmod);
        writeln(F2,cad);
        saveflag:=false;
       end
      else
       if (cad[79]<>'S') and (cad[79]<>'O') and
          (cad[79]<>'M') and (cad[79]<>'P') then
         writeln(F2,cad);
      end;
       CloseFile(F1);
      end else
      begin
       writeln(F2,cadquake);
       savedialog(cadmac,cadmod);
      end;
    if saveflag then
     savedialog(cadmac,cadmod);
    CloseFile(F2);
    if ParamCount>=1 then {modify record}
    begin
     filename:=ParamStr(1);
      if pos('\',filename)=0 then
       AssignFile(F2, sdir+'\'+filename) {was call from current directory}
      else
       AssignFile(F2, filename);
    end
  else
  if savefile=true then
     AssignFile(F2, principal.SaveDialog1.filename);
  if  (ParamCount>=1) or  savefile then
    begin
     AssignFile(F1,sdir+'\temp.tmp');
     Reset(F1);
    Rewrite(F2);
  while not Eof(F1) do
   begin
    Readln(F1, cad);
    writeln(F2, cad);
    end;
    CloseFile(F2);
    CloseFile(F1);
   end;
  end;


procedure TPRINCIPAL.EXIT1Click(Sender: TObject);
begin
Close;
end;

procedure TPRINCIPAL.selectplaceClick(Sender: TObject);
begin
  DualListDlg.Show;
end;

procedure TPRINCIPAL.FormActivate(Sender: TObject);
begin
  InputEfect.Enabled:=False;
 if MaxSelSite>0 then
  begin
   InputEfect.Enabled:=True;
   EditIntensity.Enabled:=True;
   end;
 if NumberImage>0 then
  Image.Enabled:=True;
  if initial then
   begin
    initial:=False;
   end
end;

procedure TPRINCIPAL.IsoViewClick(Sender: TObject);
begin
 DrawMapa.show;
end;

procedure TPRINCIPAL.EditDataClick(Sender: TObject);
begin
   EditDatTerr.show;
end;

procedure TPRINCIPAL.FormCreate(Sender: TObject);
var
cad,cad1,cad2:string;
seisantop: array[0..80] of char;
n,i:word;
F:textfile;
begin
 syspath:='c:\seismo\';
 indexsite:=0;
 indeximage:=0;
 NumberImage:=0;
 n:=getenvironmentvariable('SEISAN_TOP',seisantop,80);
 if n>0 then
 begin
  syspath:='';
  for i:=0 to n-1 do
   syspath := syspath + seisantop[i];
  if syspath[length(syspath)]<>'\' then
    syspath := syspath + '\';
 end;
 initial:=True;
 filemap:='NORWAY.MAP';
 masterlist:='mas_sites.dat';
 selectedlist:='sel_sites.dat';
 Application.HelpFile:=syspath+'dat\promac.hlp';
 left:=0;
 Top:=0;
 ShortDateFormat:='dd/mm/yyyy';
 DatosTerr.existe:=False;
 Maxselsite:=0;
 NinputSite:=0;
 AssignFile(F, syspath+'dat\promac.par');
    {$I-}
    Reset(F);
    {$I+}
    if IOResult = 0 then
    begin
    while not eof(F) do
    begin
     readln(F,cad);
     i:=pos('=',cad);
     cad1:=copy(cad,1,i);
     cad2:=copy(cad,i+1,length(cad)-i);
     if cad1='MASTER_LIST=' then
      masterlist:=cad2
     else
     if cad1='SELECTED_LIST=' then
      selectedlist:=cad2
     else
     if cad1='MAP_FILE=' then
      filemap:=cad2;
     end;
     closefile(F);
    end
    else
     Application.MessageBox('Missing File "promac.par"', 'Warning',mb_DefButton1);
    namepost:=syspath+'dat\'+selectedlist;
 end;

procedure TPRINCIPAL.ConfigClick(Sender: TObject);
begin
BtnBottomDlg.show;
end;

procedure TPRINCIPAL.SaveClick(Sender: TObject);
begin
 Savequake;
end;

procedure TPRINCIPAL.Help1Click(Sender: TObject);
var
cad1:string;
i:integer;
cad: array[0..100] of char;
begin
cad1:=concat(syspath,'dat\promac.hlp');
for i:=1 to length(cad1) do
 cad[i-1]:=cad1[i];
cad[i]:=chr(0);
  WinHelp(Application.handle,cad,HELP_CONTENTS,0);
end;

procedure TPRINCIPAL.About1Click(Sender: TObject);
begin
Wabout.show;
end;

procedure TPRINCIPAL.InputEfectClick(Sender: TObject);
begin
Dlghumanos.show;
end;

procedure TPRINCIPAL.ImageClick(Sender: TObject);
begin
Image1.Show;
end;

procedure TPRINCIPAL.AddImage1Click(Sender: TObject);
var
  cad,cad1:string;
  i,j:integer;
begin
  if OpenPictureDialog1.Execute then
   begin
    ImageTemp.picture.LoadFromFile(OpenPictureDialog1.FileName);
    Str(DatosTerr.ano:4,cad);
    Str(DatosTerr.mes:2,cad1);
    cad := cad + '-' + cad1;
    Str(DatosTerr.dia:2,cad1);
    cad := cad + '-' + cad1;
    Str(DatosTerr.Hour:2,cad1);
    cad := cad + '-' + cad1;
    Str(DatosTerr.minutes:2,cad1);
    cad := cad + cad1;
    Str(DatosTerr.seconds:2:0,cad1);
    cad := cad + '-' + cad1;
    Str(NumberImage:3,cad1);
    cad := cad +'_'+cad1+'.bmp';
    for i:=1 to length(cad) do
     if cad[i]=' ' then cad[i]:='0';
    ImageTemp.picture.SaveToFile(syspath+'pic\'+cad);
    NumberImage := NumberImage + 1;
    ImageList[NumberImage]:=cad;
    Image.Enabled:=True;
   end
end;

procedure TPRINCIPAL.EMS1Click(Sender: TObject);
var
cad1:string;
i:integer;
cad: array[0..100] of char;
begin
cad1:=concat(syspath,'dat\scale.hlp');
for i:=1 to length(cad1) do
 cad[i-1]:=cad1[i];
cad[i]:=chr(0);
WinHelp(Application.handle,cad,HELP_CONTENTS,0);
end;

procedure TPRINCIPAL.EditIntensityClick(Sender: TObject);
begin
fassign.show;
end;

end.


