﻿ Sample program in Delphi
 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.