Sample program in Delphi

{************************************************************************}

{                       Sample program in DELPHI XE                      }

{                                                                        }

{ Authors: RATIOSoftware, Mr. Schettler and Killet GeoSoftware Ing.-GbR  }

{                                                                        }

(    DELPHI demonstration program for using geodetic GeoDLL functions    )

{                                                                        }

(                  Uses the DELPHI Interface "GeoDll32",                 }

(         which is described in the topic "Interface Templates".         }

{                                                                        }

{     In the calling directory of the program the files geodll32.dll     }

{                    and geodllbn.bin must be present.                   }

{************************************************************************}

unit GeoRechnen;

interface

uses

  timebox,Windows, Messages, SysUtils, Variants, Classes, Graphics,

  Controls, Forms,GeoDll32,strTools,dialogs;

const

  _Std=1/24;

  _Min=1/24/60;

  _Sec=1/24/60/60;

  Function BerechneEntfernung(x1,y1,x2,y2:Double):Double;

  Function BerechneDauer(meter:Double;KmGeschwindigkeit:Integer):Double;

  Function BerechneGeschwindikgeit(meter:Double; dauer:Double):Integer;

  Function BerechneFahrtzeit(x1,y1,x2,y2:Double;

           KmGeschwindigkeit:Integer):Double;

  Procedure CheckKoords(Var _X:String; Var _Y:STring);

  Procedure GaussToWGS84(dKoordXQ, dKoordYQ: double;var dKoordXZ:double;

            var dKoordYZ:double);

  Procedure GradToDecimal(Var _X:String);

implementation

  Function BerechneFahrtzeit(x1,y1,x2,y2:Double;

           KmGeschwindigkeit:Integer):Double;

  var

  meter:double;

  begin

  meter:=BerechneEntfernung(x1,y1,x2,y2);

  result:=BerechneDauer(meter,KmGeschwindigkeit);

  end;

  Function BerechneEntfernung(x1,y1,x2,y2:Double):Double;

  //Berechnet die Distanz zwischen zwei Punkten in Meter

  var

  d:Double;

  begin

  if distancegeo(y1,x1,y2,x2,d,0)>0 then

    Result:=d

  else

    result:=-1;

  end;

  Function BerechneDauer(meter:Double;KmGeschwindigkeit:Integer):Double;

  //Berechnet die Dauer für eine Strecke bei gegebener Geschw. in Km/h

  begin

    if KmGeschwindigkeit<=0 then

      raise Exception.create('Kein Geschwindigkeitsprofil für 

      Zeitdauerberechnung angegeben');

    result:=(meter*60)/ (KmGeschwindigkeit*1000) ;

    result:=result/(24*60);

    Result:=RoundTimeToMinute(result);

  end;

  Function BerechneGeschwindikgeit(meter:Double; dauer:Double):Integer;

  //Berechnet die Geschindikgeit für eine Strecke in Km/h

  var

  d:double;

  begin

    if dauer<=0 then

      raise Exception.create('Keine Zeitangabe für 

      Geschwindigkeitsberechnung vorhanden');

    d:=DoubleToMinute(dauer);

    result:=Round((meter*60) / (d*1000));

  end;

  Procedure GradToDecimal(Var _X:String);

  //Rechnet die Geokoordinaten Minuten,Sekunden in Decimalanteil um.

  //Angabe : Bsp. "9,43,13" wird zu "9,72027"

  Var

  i,cnt:Integer;

  grad,min,sec:Integer;

  dec:Integer;

  begin

    cnt:=0;

    for i:=1 to Length(_x) do

      if _x[i]=',' then inc(cnt);

    if cnt<2 then Exit;

    Try

      grad:=StrToInt(TeilStr(_x,',',1));

      min:=StrToInt(TeilStr(_x,',',2));

     Sec:=StrToInt(TeilStr(_x,',',3));

     dec:=Round((((Min*60)+Sec)/360)*10000);

     _x:=Inttostr(grad)+','+Copy(Inttostr(dec)+'00000',1,5);

    Except

      MessageDlg('Ungültiges Zahlenformat: '+_x,mtInformation,[mbOk],0);

      abort;

   end;

  end;

  Procedure CheckKoords(Var _X:String; Var _Y:STring);

  var

  p:Integer;

  x,y:Double;

  xq,yq:Double;

  begin

    p:=Pos(',',_x);

    If p=0 then

      p:=Pos('.',_x);

    if (P=0) or (p>6) //Daten liegen im Gaus-Krügerformat vor.

    then

    begin

      xq:=StrToFloat(_x);

      yq:=StrToFloat(_y);

      GaussToWGS84(xq,yq,x,y);

      _x:=FloatTostr(x);

      _y:=FloatTostr(y);

    end

  end;

  Procedure GaussToWGS84(dKoordXQ, dKoordYQ: double;var dKoordXZ:double;

            var dKoordYZ:double);

  var

  {dKoordXQ X-Koordinate des Quellkoordinatensystems }

  {dKoordYQ Y-Koordinate des Quellkoordinatensystems }

  {dKoordXZ X-Koordinate des Zielkoordinatensystems }

  {dKoordYZ Y-Koordinate des Zielkoordinatensystems }

  sKoordSysQ   : word;    { Kennung fuer das Quellkoordinatensystem }

  sBezSysQ     : word;    { Kennung fuer das Quellbezugssystem }

  sNotationQ   : word;    { Kennung fuer die Notation der Quellkoordinat. }

  sKoordSysZ   : word;    { Kennung fuer das Zielkoordinatensystem }

  sBezSysZ     : word;    { Kennung fuer das Zielbezugssystem }

  sNotationZ   : word;    { Kennung fuer die Notation der Zielkoordinaten }

  sStreifenZ   : word;    { Kennung fuer den Zielmeridianstreifen }

  begin

    sKoordSysQ   := GK3;  { Kennung fuer das Quellkoordinatensystem }

    sBezSysQ     := 0;    { Kennung fuer das Quellbezugssystem }

    sNotationQ   := 0;    { Kennung fuer die Notation der Quellkoordinat. }

    sKoordSysZ   := 1;    { Kennung fuer das Zielkoordinatensystem }

    sBezSysZ     := 0;    { Kennung fuer das Zielbezugssystem }

    sNotationZ   := 0;    { Kennung fuer die Notation der Zielkoordinaten }

    sStreifenZ   := 0 ;   { Kennung fuer den Zielmeridianstreifen }

    if Coordtrans3(dKoordXQ,

      dKoordYQ,

      sKoordSysQ,

      sBezSysQ,

      sNotationQ,

      dKoordYZ,     // ACHTUNG X und Y sind in der DLL vertauscht!

      dKoordXZ,     // ACHTUNG X und Y sind in der DLL vertauscht!

      sKoordSysZ,

      sBezSysZ,

      sNotationZ,

      sStreifenZ)=0 then

      begin

        dKoordYZ:=0;

        dKoordXZ:=0;

      end;

  end;

end.