Delphi-Schnittstelle

Muster einer Delphi-Schnittstelle

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

{ DELPHI 2/3/4/XE -Schnittstelle }

{ zu einigen Funktionen der 32 Bit Dynamic Link Library GeoDLL. }

{ Sie muss gegebenenfalls um andere Funktionen erweitert werden. }

{ Die Schnittstelle kann direkt in den DELPHI-Quellcode eingebaut werden }

{ }

{ Autoren: Killet GeoSoftware Ing.-GbR und IVU GmbH, Berlin. }

{ Getestet mit DELPHI XE am 29.1.2015, Herrn Schettler, RATIOSoftware. }

{ }

{ Im Aufrufverzeichnis von GeoDLL müssen die Dateien geodll32.dll }

{ und geodllbn.bin vorhanden sein. }

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

unit GeoDll32;

interface

uses Windows, Dialogs;

{ Koordinatensysteme }

const

GEO = 1; { geographische Koordinaten }

GK3 = 2; { Gauss-Krueger-Koordinaten (3 Grad) }

UTM = 3; { UTM-Koordinaten }

GK6 = 4; { Gauss-Krueger-Koordinaten (6 Grad) }

BMN = 5; { Transversal Mercator (England) }

{ Bezugssysteme }

DEFAULT = 0; { bei geographischen Koordinaten: PD }

{ bei Gauss-Krueger-Koordinaten (3 Grad): PD }

{ bei UTM-Koordinaten: ED50 }

{ bei Gauss-Krueger-Koordinaten (6 Grad): SYSTEM43/83 }

{ bei Transversal Mercator (England): OSGB36 }

PD = 1; { PD, Rauenberg, Bessel (1841) }

ED50 = 2; { ED50, Potsdam, Hayford (1909) / Internat. (1924) }

SYSTEM4283 = 3; { SYSTEM42/83, Pulkowo, Krassowskij (1940) }

ETRS89 = 4; { ETRS89, earth centerd, GRS80 (1980) }

MGI = 5; { MGI, Hermannskogel, Bessel (1841) }

NTF = 6; { NTF, Pantheon (Paris), Clarke IGN (1880) }

RDNAP = 7; { RD/NAP, Amersfoort, Bessel (1841) }

CH1903 = 8; { CH1903, Old Observatory Bern, Bessel (1841) }

RD83 = 9; { RD83, Bessel (1841) }

WGS84 = 10; { WGS84 (GPS), earth centerd, WGS84 (1984) }

WGS72 = 11; { WGS72, earth centerd, WGS72 (1972) }

USERDEF = 1000; { User-definierter Bezugssystemwechsel (setuserrefsys) }

KEINS = 1100; { kein Bezugssystemwechsel }

{ Notation (Schreibweise) der geographischen Koordinaten }

GGGNNN = 0; { ggg.nnn (g = Grad, n = Minuten und Sekunden als }

{ dezimaler Bruchteil eines Grades }

GGMMSS = 1; { gggmmss.nnn (g = Grad, m = Minuten, s = Sekunden, }

{ n = dezimaler Nachkommaanteil der Sekunden }

{ Freischalten der DLL-Funktionsgruppen }

{ DELPHI 2/3/4 use pchar, DELPHI XE use pAnsichar }

type tGeo_Setunlockcode = function

(

FCode : pAnsichar; { Freischaltschluessel }

LNehm : pAnsichar { Lizenznehmerbezeichnung }

) : dword; stdcall;

var setunlockcode : tGeo_Setunlockcode;

{ Koordinatentransformation }

type tGeo_Coordtrans3 = function

(

dKoordXQ : double; { X-Koordinate des Quellkoordinatensystems }

dKoordYQ : double; { Y-Koordinate des Quellkoordinatensystems }

sKoordSysQ : word; { Kennung fuer das Quellkoordinatensystem }

sBezSysQ : word; { Kennung fuer das Quellbezugssystem }

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

var dKoordXZ : double; { X-Koordinate des Zielkoordinatensystems }

var dKoordYZ : double; { Y-Koordinate des Zielkoordinatensystems }

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 }

) : dword; stdcall;

var coordtrans3 : tGeo_Coordtrans3;

{ Transformationsparameter fuer benutzerdefiniertes Bezugssystem }

{ Nur notwendig, wenn benutzerdefiniertes Bezugssystem verwendet wird }

type tGeo_Setuserrefsys = function

(

sRefSysTyp : word; { Flag zum Anlegen / Löschen eines Bezugssystems }

dTranslX : double; { Verschiebung auf der X-Achse (Translation) }

dTranslY : double; { Verschiebung auf der Y-Achse }

dTranslZ : double; { Verschiebung auf der Z-Achse }

dRotX : double; { Drehung der X-Achse (Rotation) }

dRotY : double; { Drehung der Y-Achse }

dRotZ : double; { Drehung der Z-Achse }

dMasstab : double { Masstabsfaktor in ppm }

) : dword; stdcall;

var setuserrefsys : tGeo_Setuserrefsys;

{ Ellipsoidhabachsen für benutzerdefinierten Quellellipsoiden }

{ Nur notwendig, wenn benutzerdefiniertes Bezugssystem verwendet wird }

type tGeo_Setuserellsource = function

(

sEllSource : word; { Flag für das Quellellipsoid }

dHalbAchsGrQ : double; { Grosse Halbachse des Quellellipsoiden }

dHalbAchsKlQ : double { Kleine Halbachse des Quellellipsoiden }

) : dword; stdcall;

var setuserellsource : tGeo_Setuserellsource;

{ Ellipsoidhabachsen für benutzerdefinierten Zielellipsoiden }

{ Nur notwendig, wenn benutzerdefiniertes Bezugssystem verwendet wird }

type tGeo_Setuserelltarget = function

(

sEllTarget : word; { Flag für das Zielellipsoid }

dHalbAchsGrZ : double; { Grosse Halbachse des Zielellipsoiden }

dHalbAchsKlZ : double { Kleine Halbachse des Zielellipsoiden }

) : dword; stdcall;

var setuserelltarget : tGeo_Setuserelltarget;

{ Entfernung zwischen zwei Koordinatenpaaren }

type tGeo_Distancegeo = function

(

dGeoLaenge1 : double; { Geogr. Laenge der ersten Koordinate }

dGeoBreite1 : double; { Geogr. Breite der ersten Koordinate }

dGeoLaenge2 : double; { Geogr. Laenge der zweiten Koordinate }

dGeoBreite2 : double; { Geogr. Breite der zweiten Koordinate }

var dStrecke: double; { Berechnete Entfernung }

sEllipsoid : word { Kennung fuer das geodaetische Ellipsoid }

) : dword; stdcall;

var distancegeo : tGeo_Distancegeo;

function KoordSysCode (S:String):Integer;

function BezSysCode (S:String):Integer;

implementation

function KoordSysCode (S:String):Integer;

begin

KoordSysCode := 1;

if S = 'GEO' then KoordSysCode := 1;

if S = 'GK3' then KoordSysCode := 2;

if S = 'UTM' then KoordSysCode := 3;

if S = 'GK6' then KoordSysCode := 4;

if S = 'TME' then KoordSysCode := 5;

end;

function BezSysCode (S:String):Integer;

begin

BezSysCode := 0;

if S = 'PD' then BezSysCode := 1;

if S = 'ED50' then BezSysCode := 2;

if S = 'SYSTEM4283' then BezSysCode := 3;

if S = 'ETRS89' then BezSysCode := 4;

if S = 'MGI' then BezSysCode := 5;

if S = 'NTF' then BezSysCode := 6;

if S = 'RDNAP' then BezSysCode := 7;

if S = 'CH1903' then BezSysCode := 8;

if S = 'RD83' then BezSysCode := 9;

if S = 'WGS84' then BezSysCode := 10;

if S = 'WGS72' then BezSysCode := 11;

if S = 'KEINS' then BezSysCode := 1100;

end;

function T_Error (

dKoordXQ : double;

dKoordYQ : double;

sKoordSysQ : word;

sBezSysQ : word;

sNotationQ : word;

var dKoordXZ : double;

var dKoordYZ : double;

sKoordSysZ : word;

sBezSysZ : word;

sNotationZ : word;

sStreifenZ : word

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function coordtrans3() not bound ');

dKoordXZ := 0;

dKoordYZ := 0;

T_ERROR := 0;

end;

function F_Error

(

FCode : pchar;

LNehm : pchar

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function setunlockcode() not bound ');

F_ERROR := 0;

end;

function D_Error

(

dGeoLaenge1 : double;

dGeoBreite1 : double;

dGeoLaenge2 : double;

dGeoBreite2 : double;

var dStrecke: double;

sEllipsoid : word

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function distancegeogeo() not bound ');

dStrecke := 0;

D_Error := 0;

end;

function TP_Error

(

sRefSysTyp : word;

dTranslX : double;

dTranslY : double;

dTranslZ : double;

dRotX : double;

dRotY : double;

dRotZ : double;

dMasstab : double

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function setuserrefsys() not bound ');

TP_Error := 0;

end;

function ES_Error

(

sEllSource : word;

dHalbAchsGrQ : double;

dHalbAchsKlQ : double

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function getuserellsource() not bound ');

ES_Error := 0;

end;

function ET_Error

(

sEllTarget : word;

dHalbAchsGrZ : double;

dHalbAchsKlZ : double

) : dword; stdcall;

begin

ShowMessage ('GeoDLL32 : Function getuserelltarget() not bound ');

ET_Error := 0;

end;

var LHandle : tHandle;

procedure LoadLib;

begin

{ GeoDLL laden und Zeiger auf die DLL-Funktionen setzen }

LHandle := LoadLibrary('geodll32.dll');

if LHandle <> 0

then begin

Setunlockcode := GetProcAddress(LHandle, 'setunlockcode');

Coordtrans3 := GetProcAddress(LHandle, 'coordtrans3');

Distancegeo := GetProcAddress(LHandle, 'distancegeo');

Setuserrefsys := GetProcAddress(LHandle, 'setuserrefsys');

Setuserellsource := GetProcAddress(LHandle, 'setuserellsource');

Setuserelltarget := GetProcAddress(LHandle, 'setuserelltarget');

end

else begin

Setunlockcode := @F_Error;

Coordtrans3 := @T_Error;

Distancegeo := @D_Error;

Setuserrefsys := @TP_Error;

Setuserellsource := @ES_Error;

Setuserelltarget := @ET_Error;

ShowMessage ('Unable to load Geodll32.dll');

end;

initialization

{ GeoDLL-Funktionen laden }

LoadLib;

{ Hier kann die GeoDLL freigeschaltet werden }

Setunlockcode ('Ihr Freischaltschluessel','Ihre Lizenznehmerbezeichnung');

finalization

if LHandle <> 0 then FreeLibrary(LHandle);

end.