Beispiel in Visual Objects

Beispielprogramm in Visual Objects

/************************************************************************/

/* Beispielprogramm in Visual Objects */

/* */

/* Autor: Killet GeoSoftware Ing.-GbR */

/* */

/* VO Demonstrationsprogramm zum Einbinden von GeoDLL-Funktionen */

/* */

/* Im Aufrufverzeichnis des Programms müssen die Dateien geodll32.dll */

/* und geodllbn.bin vorhanden sein. */

/************************************************************************/

FUNCTION Start()

// Programm zum Testen einiger Funktionen aus der Dynamic Link Library

// GeoDLL von Killet GeoSoftware Ing.-GbR. Um das Programm

// lauffähig zu machen, müssen noch die Prototypen der DLL-Funktionen

// aus den Funktionsbeschreibungen des Handbuchs GeoDLL_d.chm übernommen

// werden.

// Variabeln:

LOCAL nKoordXQ,nKoordYQ,nKoordXZ,nKoordYZ,nStrecke AS REAL8

LOCAL nHalbAchsGrQ,nHalbAchsKlQ,nHalbAchsGrZ,nHalbAchsKlZ,nVerschX,;

nVerschY,nVerschZ,nDrehungX,nDrehungY,nDrehungZ,nMasstab AS REAL8

LOCAL nEllipsoid,nKoordSysQ,nKoordSysZ,wBezSysQ,wBezSysZ,nStreifen,;

nNotationQ,nNotationZ,wCoordSys AS WORD

LOCAL pszKoordQ,pszKoordZ,pszKoordZ2,pszText AS PSZ

LOCAL l AS LOGIC

// Zum Testen: Wenn die drei Zeilen nicht auskommentiert sind, verwaltet

// das Testprogramm selbstständig den Speicher für die von der GeoDLL

// zurückgegebenen Strings. Andernfalls wird die Speicherverwaltung

// innerhalb der DLL durchgeführt.

setstringallocate(FALSE)

pszText := MemAlloc(1000)

pszKoordZ := MemAlloc(20)

// Hinweis.

? "Drücken sie eine Taste um schnell fortzufahren!"

// Test der DLL-Funktion setunlockcode() durchführen.

// Die Freischaltschlüssel stimmen natürlich nicht!

// Sie müssen bei Killet GeoSoftware Ing.-GbR erworben werden!

// Vollversion: Der Freischaltschlüssel muss bei der 1. Eingabe stimmen!

// Testversion: Die Funktion darf nicht aufgerufen werden!

// Die Testversion funktioniert pro Programmlauf kurze Zeit ohne

// Freischaltung!

*? "Freischaltungen:"

*l := setunlockcode(string2psz("123456789-987654321"),;

* string2Psz("MicroModia GmbH"))

*? "setunlockcode():"

*if l

* ? "Gruppe 'Koordinatentransformationen': frei geschaltet!"

*else

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*endif

*l := setunlockcode(string2psz("234567890-0987654332"),;

* string2psz("MicroModia GmbH"))

*? "setunlockcode():"

*IF l

* ? "Gruppe 'Benutzerdefinitionen': frei geschaltet!"

*ELSE

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*ENDIF

*l := setunlockcode(string2psz("345678901-109876543"),;

* string2psz("MicroModia GmbH"))

*? "setunlockcode():"

*if l

* ? "Gruppe 'Entfernungsberechnungen': frei geschaltet!"

*else

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*endif

*l := setunlockcode(string2psz("456789012-210987654"),;

* string2psz("MicroModia GmbH"))

*? "setunlockcode():"

*if l

* ? "Gruppe 'Parameterermittlung': frei geschaltet!"

*else

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*endif

*l := setunlockcode(string2psz("567890123-321098765"),;

* string2psz("MicroModia GmbH"))

*? "setunlockcode():"

*if l

* ? "Gruppe 'Notationsberechnungen': frei geschaltet!"

*else

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*endif

*l := setunlockcode(string2psz("678901234-432109876"),;

* string2psz("MicroModia GmbH"))

*? "setunlockcode():"

*if l

* ? "Gruppe 'Kartenberechnungen': frei geschaltet!"

*else

* geterrorcode(@pszText)

* ? Psz2String(pszText)

*endif

// Test der DLL-Funktion getdllversion() durchführen.

getdllversion(@pszText)

? "getdllversion():"

? "DLL-Version:", Psz2String(pszText)

inkey(3)

// Test der DLL-Funktion getauthor() durchführen.

getauthor(@pszText)

? "getauthor():"

? Psz2String(pszText)

inkey(3)

// Test der DLL-Funktion getlicensee() durchführen.

getlicensee(@pszText)

? "getlicensee():"

? Psz2String(pszText)

inkey(3)

// Bereichsprüfung einschalten.

l := setcoordarea(TRUE)

? "setcoordarea():"

IF l

? "OK!"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion coordtrans() durchführen.

// Gauß-Krüger -> UTMref

nKoordXQ := 2500000.0

nKoordYQ := 5500000.0

nKoordSysQ := 2

wBezSysQ := 1

nKoordSysZ := 51

wBezSysZ := 2

nStreifen := 0

l := coordtrans(nKoordXQ,nKoordYQ,pszKoordQ,nKoordSysQ,wBezSysQ,;

@nKoordXZ,@nKoordYZ,@pszKoordZ,nKoordSysZ,wBezSysZ,;

nStreifen)

? "coordtrans():"

IF l

? "UTMref:", Psz2String(pszKoordZ)

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion coordtrans2() durchführen.

// UTMref -> QTH (Maidenhead)

pszKoordQ := pszKoordZ

nKoordSysQ := 51

wBezSysQ := 2

pszKoordZ2 := MemAlloc(16)

nKoordSysZ := 52

wBezSysZ := 10

nStreifen := 0

l := coordtrans2(nKoordXQ,nKoordYQ,pszKoordQ,nKoordSysQ,wBezSysQ,;

@nKoordXZ,@nKoordYZ,pszKoordZ2,nKoordSysZ,wBezSysZ,;

nStreifen)

? "coordtrans2():"

IF l

? "QTH (Maidenhead):", Psz2String(pszKoordZ2)

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

MemFree(pszKoordZ2)

inkey(3)

// Test der DLL-Funktion coordtrans3() durchführen.

// Gauß-Krüger -> Länge / Breite

nKoordXQ := 2500000.0

nKoordYQ := 5500000.0

nKoordSysQ := 2

wBezSysQ := 1

nNotationQ := 0

nKoordSysZ := 1

wBezSysZ := 2

nNotationZ := 1

nStreifen := 0

l := coordtrans3(nKoordXQ,nKoordYQ,nKoordSysQ,wBezSysQ,nNotationQ,;

@nKoordXZ,@nKoordYZ,nKoordSysZ,wBezSysZ,nNotationZ,;

nStreifen)

? "coordtrans3():"

IF l

? "Laenge:", nKoordXZ

? "Breite:", nKoordYZ

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion setuserrefsys() durchführen.

// Verschiebungen, Drehungen, Maßstabsfaktor (ppm)

nVerschX := REAL8(-128.0)

nVerschY := REAL8(311.0)

nVerschZ := REAL8(-222.5)

nDrehungX := REAL8(2.43)

nDrehungY := REAL8(-3.15)

nDrehungZ := REAL8(4.14)

nMasstab := REAL8(8.6)

l := setuserrefsys(1,nVerschX, nVerschY, nVerschZ,;

nDrehungX, nDrehungY, nDrehungZ,;

nMasstab)

? "setuserrefsys():"

IF l

? "OK!"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion setuserellsource().

// Ellipsoid-Halbachsen.

nHalbAchsGrQ := REAL8(6379900.0)

nHalbAchsKlQ := REAL8(6377700.0)

l := setuserellsource(1000,nHalbAchsGrQ, nHalbAchsKlQ)

? "setuserellsource():"

IF l

? "OK!"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion setuserelltarget().

// Ellipsoid-Halbachsen.

nHalbAchsGrZ := REAL8(6378200.0)

nHalbAchsKlZ := REAL8(6375500.0)

l := setuserelltarget(1000,nHalbAchsGrZ, nHalbAchsKlZ)

? "setuserelltarget():"

IF l

? "OK!"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Benutzerdefiniertes Bezugssystem und Ellipsoide mit der Funktion

// coordtrans3() testen.

nKoordXQ := 2500000.0

nKoordYQ := 5500000.0

nKoordSysQ := 2

wBezSysQ := 1000

nNotationQ := 0

nKoordSysZ := 1

wBezSysZ := 1000

nNotationZ := 1

nStreifen := 0

l := coordtrans3(nKoordXQ,nKoordYQ,nKoordSysQ,wBezSysQ,nNotationQ,;

@nKoordXZ,@nKoordYZ,nKoordSysZ,wBezSysZ,nNotationZ,;

nStreifen)

? "coordtrans3() mit benutzerdefiniertem Bezugssystemwechsel:"

IF l

? "Laenge:", nKoordXZ

? "Breite:", nKoordYZ

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion meritrans() durchführen.

nKoordXQ := 2500000.0

nKoordYQ := 5500000.0

nKoordSysQ := 2

nEllipsoid := 1

nStreifen := 3

l := meritrans(nKoordXQ,nKoordYQ,@nKoordXZ,@nKoordYZ,nKoordSysQ,;

nEllipsoid,nStreifen)

? "meritrans():"

IF l

? "Rechtswert:", nKoordXZ

? "Hochwert:", nKoordYZ

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion distancegeo() durchführen.

nKoordXQ := 07.19

nKoordYQ := 51.33

nKoordXZ := 07.61

nKoordYZ := 51.19

nEllipsoid := 1

l := distancegeo(nKoordXQ,nKoordYQ,nKoordXZ,nKoordYZ,@nStrecke,;

nEllipsoid)

? "distancegeo():"

IF l

? "Entfernung:", nStrecke, "Meter"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion distanceutm() durchführen.

nKoordXQ := 32464554.3

nKoordYQ := 5133744.1

nKoordXZ := 31647128.5

nKoordYZ := 5278144.7

l := distanceutm(nKoordXQ,nKoordYQ,nKoordXZ,nKoordYZ,@nStrecke)

? "distanceutm():"

IF l

? "Entfernung:", nStrecke, "Meter"

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

ENDIF

inkey(3)

// Test der DLL-Funktion getcoordsys() durchführen.

wCoordSys := 18 // Deutsche Lambert mean Koordinaten

l := getcoordsys(wCoordSys,@pszText)

? "getcoordsys():"

IF l

? Psz2String(pszText)

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

? "Diese Funktion kann ausschließlich mit gültigen"

? "Freischaltschlüsseln ausgeführt werden!"

ENDIF

inkey(3)

// Test der DLL-Funktion getrefsys() durchführen.

wBezSysQ := 5 // MGI, Hermannskogel, Bessel (1841)

wBezSysZ := 8 // CH1903, Old Observatory Bern, Bessel (1841)

l := getrefsys(wBezSysQ,wBezSysZ,0,0,@pszText)

? "getrefsys():"

IF l

? Psz2String(pszText)

ELSE

geterrorcode(@pszText)

? Psz2String(pszText)

? "Diese Funktion kann ausschließlich mit gültigen"

? "Freischaltschlüsseln ausgeführt werden!"

ENDIF

inkey(3)

// Test der DLL-Funktion geterrorcode() durchführen.

? "geterrorcode():"

geterrorcode(@pszText)

? Psz2String(pszText)

inkey(30)

// Aufräumen für den Fall, dass setstringallocate(FALSE) gesetzt ist.

IF .not. pszText == NULL_PSZ

MemFree(pszText)

ENDIF

IF .not. pszKoordZ == NULL_PSZ

MemFree(pszKoordZ)

ENDIF

RETURN