unit gg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TDGrid1 = class(TForm)

    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit3: TEdit;
    Edit8: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DGrid1: TDGrid1;

implementation

{$R *.DFM}


function Sgn (X: Real): Real;
  begin
        if abs(x) > x then
          result := -1.000
        else if abs(x)= x then
          result := 1.000;
  end;



procedure TDGrid1.Button1Click(Sender: TObject);

var
        JJ, W1, W2, Wr, WT, L1, L2: real;
        Lt, LR, W3, HH, GG, H0, H9 : real;

        Bearing : real;
        Distance : real;

        La, Lb : real;
 La2, Lb2 : real;
 A : array[1..6] of integer;
 A2 : array[1..6] of integer;
 s:string;
 c, value:integer;
 s2:string;
 c2, value2:integer;




  begin        //calculates latitude and longitude of the 1st grid square
 s:=edit4.Text;   //the grid square
 if (length(s) < 5 )then      //if only 4 grid terms are input assumes the
                              //approx. middle of the grid, i.e. "LL"
    begin
    s:= s+'LL';
    end;
 if (length(s) > 6 )then      //handle too many terms
    begin
    edit4.text :='too long!' ;
    s := 'JJ00AA';    //default value
    edit1.text :='0';
    edit2.text :='0';
    exit ;
    end;

 for c:=1 to length(s) do      //finally, calculate the lat/long
 begin
     value:=ord(s[c]);
     a[c]:= value;
 end;

   La := -180 +(A[1]-65)*20+(A[3]-48)*2+(A[5]-64.5)/12 ;
   Lb := -90 + (A[2]-65)*10+A[4]-48+(A[6]-64.5)/24 ;

  Edit5.Text := FloattoStrf(Lb,ffFixed,4,3);
  Edit6.Text := floattoStrf(-La,ffFixed,5,3);

  //calculate the 2nd grid
 begin        //calculates latitude and longitude of the 2nd grid square
 s2:=edit7.Text;   //the grid square
 if (length(s2) < 5 )then      //if only 4 grid terms are input assumes the
                              //approx. middle of the grid, i.e. "LL"
    begin
    s2:= s2+'LL';
    end;
 if (length(s2) > 6 )then      //handle too many terms
    begin
    edit7.text :='too long!' ;
    s2 := 'JJ00AA';    //default value
    edit1.text :='0';
    edit2.text :='0';
    exit ;
    end;

 for c2:=1 to length(s2) do      //finally, calculate the lat/long
 begin
     value2:=ord(s2[c2]);
     a2[c2]:= value2;
 end;

   La2 := -180 +(A2[1]-65)*20+(A2[3]-48)*2+(A2[5]-64.5)/12 ;
   Lb2 := -90 + (A2[2]-65)*10+A2[4]-48+(A2[6]-64.5)/24 ;

  Edit1.Text := FloattoStrf(Lb2,ffFixed,4,3);
  Edit2.Text := floattoStrf(-La2,ffFixed,5,3);
  // finish calculate the 2nd grid

end;


 begin
        //L1 := 33.01;
        //W1 := 96.892;
        L1 := StrToFloat(Edit5.text);   //1st grid latitude
        W1 := StrToFloat(Edit6.text);   //1st grid longitude in degrees west

        L2 := StrToFloat(Edit1.text);   //2nd grid latitude
        W2 := StrToFloat(Edit2.text);   //2nd grid longitude

        if (L1 = 0) and (L2 = 0) then
        L1 := L1 + 0.00001;     //program crashes if both L1 and L2 are 0

        //  PI := 3.141592;
        JJ := PI/180;
        Wr := -(W1 - 180*(1+ Sgn(W1-0.0001))) * JJ ;
        WT := -(W2 - 180*(1+ Sgn(W2-0.0001))) * JJ ;
        Lt := L1 * JJ;
        LR := L2 * JJ;
        W3 := Wr - Wt + 0.0001;
        W3 := PI * (1 - Sgn(W3)) + W3;
        HH := Sin(Lt)*Sin(Lr)+Cos(Lt)*Cos(Lr)*Cos(W3);
        GG := ArcTan(Sqrt(1-HH*HH)/HH)+PI/2*(1-Sgn(HH));
        H0 := int(1.59 * GG) + 1;
        H9 := (Sin(Lr)-HH*Sin(Lt))/sin(GG)/Cos(Lt);

   begin;
        If H9< -0.9999999 then
                H9 := ArcTan(PI/2*(1-Sgn(H9)))
        Else    H9 := ArcTan(Sqrt(1-H9*H9)/H9)+PI/2*(1- Sgn(H9)); //sgn;
   end;

   H9 := H9* Sgn(W3-PI)* Sgn(PI - GG);
   H9 := H9 + PI * (1- Sgn(H9));
   Bearing := INT(H9/JJ + 0.5);
   Distance := INT(6356.775* GG + 0.5);
   Edit3.text := FloatToStr(Bearing);
   Edit8.Text := FloatToStr(Distance);

end;
end;
 end.


