unit Topo;

interface

uses Math, Grades, Classes, ComCtrls, SysUtils, Divers;

type
  TPedroXYZPoint=record
    Num:string;
    X,Y,Z:double;
    Code:string;
    Active,Alti:boolean;
  end;

  TPedroStation=record
    Num:string;
    Hi,V0,Ppm,X,Y,Z:double;
    Active,Alti:boolean;
  end;

  TPedroNHVDPointPlus=record
    Num:string;
    Hv,Ah,Av,Di,Dh,D0,Dr,Dz:double;
    Code:string;
    Station:^TPedrostation;
    Active,Alti:boolean;
  end;

  TPedroNHVDPoint=record
    Num:string;
    Hv,Ah,Av,Dist:double;
    Code:string;
    Station:^TPedroStation;
    Active,Alti:boolean;
  end;

Function Gis(Xa,Ya,Xb,Yb:real):real;
Function Dist(Xa,Ya,Xb,Yb:real):real;
Function Intersection(Xa,Ya,Ga,Xb,Yb,Gb:real):TPedroXYZPoint;
Function PolRect(Xa,Ya,Gisement,Distance:real):TPedroXYZPoint;
Function RectPol(Xa,Ya,Xb,Yb:real):TPedroNHVDPoint;
Function CalculRealPoint(t:TPedroNHVDPointPlus;Ppm,Z:real):TPedroNHVDPointPlus;
procedure UpdateXYZ(Fichier,Point:string;NewX,NewY,NewZ:real;Digits:integer);
Function UpdateV0(Fichier,Station:string;NewV0:real;Digits:integer):boolean;
Function UpdatePpm(Fichier,Station:string;NewPpm:real;Digits:integer):boolean;
procedure AssignNHVDPoint(const Source:TPedroNHVDPoint;var Dest:TPedroNHVDPoint);
procedure AssignNHVDPointPlus(const Source:TPedroNHVDPointPlus;var Dest:TPedroNHVDPointPlus);
procedure AssignXYZPoint(const Source:TPedroXYZPoint;var Dest:TPedroXYZPoint);
procedure AssignStation(const Source:TPedroStation;var Dest:TPedroStation);

implementation

procedure UpdateXYZ(Fichier,Point:string;NewX,NewY,NewZ:real;Digits:integer);
var t,t1:tstringlist;
    i:integer;
    yop:boolean;
begin
  yop:=false;
  t:=tstringlist.Create;
  if fileexists(fichier) then
  begin
    t.LoadFromFile(fichier);
    for i:=0 to t.Count-1 do
    begin
      t1:=loadelements(t.Strings[i]);
      if t1.Strings[0]=point then
      begin
        t.Strings[i]:=point+','+realtostr(newx,digits)+','+realtostr(newy,digits)+','+realtostr(newz,digits);
        yop:=true;
      end;
    end;
    if fileexists(fichier) then deletefile(fichier);
    //t1.Free;
  end;
  if not yop then t.Add(point+','+realtostr(newx,digits)+','+realtostr(newy,digits)+','+realtostr(newz,digits));
  t.SaveToFile(fichier);
  t.Free;
end;

Function UpdateV0(Fichier,Station:string;NewV0:real;Digits:integer):boolean;
var t,t1:tstringlist;
    i:integer;
    phr,phr2,phr3:string;
begin
  phr3:='400.';
  for i:=1 to digits do phr3:=phr3+'0';
  if fileexists(fichier) then
  begin
    t:=tstringlist.Create;
    t.LoadFromFile(fichier);
    for i:=0 to t.Count-1 do
    begin
      t1:=loadelements(t.Strings[i]);
      phr:=t1.Strings[0];
      delete(phr,1,5);
      if phr=station then
      begin
        phr2:=realtostr(newv0,digits);
        if phr2=phr3 then phr2:='0.00000';
        t.Strings[i]:='**ST '+station+','+t1.Strings[1]+','+phr2+','+t1.Strings[3];
      end;
    end;
    if fileexists(fichier) then deletefile(fichier);
    t.SaveToFile(fichier);
    t.Free;
//    t1.Free;
    result:=true;
  end else result:=false;
end;

Function UpdatePpm(Fichier,Station:string;NewPpm:real;Digits:integer):boolean;
var t,t1:tstringlist;
    i:integer;
    phr:string;
begin
  if fileexists(fichier) then
  begin
    t:=tstringlist.Create;
    t.LoadFromFile(fichier);
    for i:=0 to t.Count-1 do
    begin
      t1:=loadelements(t.Strings[i]);
      phr:=t1.Strings[0];
      delete(phr,1,5);
      if phr=station then t.Strings[i]:='**ST '+station+','+t1.Strings[1]+','+t1.Strings[2]+','+realtostr(newppm,digits);
    end;
    if fileexists(fichier) then deletefile(fichier);
    t.SaveToFile(fichier);
    t.Free;
//    t1.Free;
    result:=true;
  end else result:=false;
end;

Function CalculRealPoint(t:TPedroNHVDPointPlus;Ppm,Z:real):TPedroNHVDPointPlus;
begin
  t.Dh:=t.Di;
  t.Dz:=0;
  if t.Av<>100 then
  begin
    t.Dh:=t.Di*sig(t.Av);
    t.Dz:=t.Di*cog(t.Av);
  end;
  t.Dr:=t.Dh;
  t.D0:=t.Dh;
  if z<>0 then
  begin
    t.D0:=t.Dh*(6370000/(6370000+z));
    if ppm<>0 then t.Dr:=t.D0*(1+(ppm/1000000));
  end;
  result:=t;
end;

Function RectPol(Xa,Ya,Xb,Yb:real):TPedroNHVDPoint;
var t:tpedronhvdpoint;
begin
  t.Dist:=dist(xa,ya,xb,yb);
  t.Ah:=gis(xa,ya,xb,yb);
  result:=t;
end;

Function PolRect(Xa,Ya,Gisement,Distance:real):TPedroXYZPoint;
var t:tpedroxyzpoint;
begin
  t.X:=xa+sig(gisement)*distance;
  t.Y:=ya+cog(gisement)*distance;
  result:=t;
end;

function Gis(Xa,Ya,Xb,Yb:real):real;
var dx,dy,d,g:real;
begin
  dx:=xb-xa;
  dy:=yb-ya;
  if xa=xb then
  begin
    if ya>yb then g:=200 else g:=0;
  end else
  if ya=yb then
  begin
    if xa>xb then g:=300 else g:=100;
  end else
  begin
    d:=dy/dx;
    if dx>0 then g:=100-arctag(d) else
    g:=300-arctag(d);
  end;
  result:=g;
end;

function Dist(Xa,Ya,Xb,Yb:real):real;
begin
  result:=sqrt(sqr(xb-xa)+sqr(yb-ya))
end;

Function Intersection(Xa,Ya,Ga,Xb,Yb,Gb:real):TPedroXYZpoint;
var t:tpedroXYZpoint;
		dy:double;
begin
	if (ga=gb) then msg('Hop  '+realtostr(ga,5)+'  '+realtostr(gb,5));
	if ((Ga<>100) and (Ga<>300) and (Gb<>100) and (Gb<>300)) then
  begin
    t.y:=ya+(xa-xb-(ya-yb)*tag1(gb))/(tag1(gb)-tag1(ga));
  	t.x:=xa+tag1(ga)*(t.Y-ya);
  end else
	begin
		if ((Ga=100) or (Ga=300)) then
		begin
			dy:=Ya-Yb;
			t.X:=Xb+dy*tag1(Gb);
			t.X:=Xa;
		end else
		if ((Gb=100) or (Gb=300)) then
		begin
			dy:=Yb-Ya;
			t.X:=Xa+dy*tag1(Ga);
			t.Y:=Yb;
		end;
	end;
  result:=t;
end;

procedure AssignNHVDPoint(const Source:TPedroNHVDPoint;var Dest:TPedroNHVDPoint);
begin
  with Source do
  begin
    Dest.Num:=Num;
    Dest.Hv:=Hv;
    Dest.Ah:=Ah;
    Dest.Av:=Av;
    Dest.Dist:=Dist;
    Dest.Code:=Code;
    Dest.Station:=Station;
    Dest.Active:=Active;
    Dest.Alti:=Alti;
  end;
end;

procedure AssignNHVDPointPlus(const Source:TPedroNHVDPointPlus;var Dest:TPedroNHVDPointPlus);
begin
  with Source do
  begin
    Dest.Num:=Num;
    Dest.Hv:=Hv;
    Dest.Ah:=Ah;
    Dest.Av:=Av;
    Dest.Di:=Di;
    Dest.Dh:=Dh;
    Dest.D0:=D0;
    Dest.Dr:=Dr;
    Dest.Dz:=Dz;
    Dest.Code:=Code;
    Dest.Station:=Station;
    Dest.Active:=Active;
    Dest.Alti:=Alti;
  end;
end;

procedure AssignXYZPoint(const Source:TPedroXYZPoint;var Dest:TPedroXYZPoint);
begin
  with Source do
  begin
    Dest.Num:=Num;
    Dest.X:=X;
    Dest.Y:=Y;
    Dest.Z:=Z;
    Dest.Code:=Code;
    Dest.Active:=Active;
    Dest.Alti:=Alti;
  end;
end;

procedure AssignStation(const Source:TPedroStation;var Dest:TPedroStation);
begin
  with Source do
  begin
    Dest.Num:=Num;
    Dest.Hi:=Hi;
    Dest.V0:=V0;
    Dest.Ppm:=Ppm;
    Dest.X:=X;
    Dest.Y:=Y;
    Dest.Z:=Z;
    Dest.Active:=Active;
    Dest.Alti:=Alti;
  end;
end;

end.