|
Sample program in Visual Objects |
|
/************************************************************************/ /* Sample program in Visual Objects */ /* */ /* Author: Killet GeoSoftware Ing.-GbR */ /* */ /* VO demonstration program for using geodetic GeoDLL functions */ /* */ /* In the calling directory of the program the files geodll32.dll */ /* and geodllbn.bin must be present. */ /************************************************************************/
FUNCTION Start() // Program for testing some functions of the Dynamic Link Library GeoDLL // from Killet GeoSoftware Ing.-GbR. To make the program executable, // still the prototypes of the DLL functions from the function // descriptions in the manual GeoDLL_e.chm must be bound.
// Variables: LOCAL nCoordXS,nCoordYS,nCoordXT,nCoordYT,nDistance AS REAL8 LOCAL nHalfAxLargeS,nHalfAxSmallS,nHalfAxLargeT,nHalfAxSmallT,nTranslatX,; nTranslatY,nTranslatZ,nRotatX,nRotatY,nRotatZ,nScale AS REAL8 LOCAL nEllipsoid,nCoordSysS,nCoordSysT,wRefSysS,wRefSysT,nStrip,; nNotationS,nNotationT,wCoordSys AS WORD LOCAL pszCoordS,pszCoordT,pszCoordT2,pszText AS PSZ LOCAL l AS LOGIC
// For testing: If the three lines are not out-commented, the test // routine independently administers the memory for strings returned by // GeoDLL functions. Otherwise the memory management is accomplished // within the DLL. setstringallocate(FALSE) pszText := MemAlloc(1000) pszCoordT := MemAlloc(20)
// Remark. ? " Press any key to continue faster!" ?
// Test of the DLL function setunlockcode(). // This unlock parameters do not work! // The originals must be acquired from Killet GeoSoftware Ing.-GbR! // Full version: Unlock parameters must be correct at the first input! // Test version: Function may not be called! // The test version without unlocking works per program run a short // time only!
*? "Unlocking:" *l := setunlockcode(string2psz("123456789-987654321"),; * string2Psz("MicroModia GmbH")) *? "setunlockcode():" *if l * ? "Group 'Coordinate Transformations': unlocked!" *else * geterrorcode(@pszText) * ? Psz2String(pszText) *endif
*l := setunlockcode(string2psz("234567890-0987654332"),; * string2psz("MicroModia GmbH")) *? "setunlockcode():" *IF l * ? "Group 'User definitions': unlocked!" *ELSE * geterrorcode(@pszText) * ? Psz2String(pszText) *ENDIF
*l := setunlockcode(string2psz("345678901-109876543"),; * string2psz("MicroModia GmbH")) *? "setunlockcode():" *if l * ? "Group 'Distance calculations': unlocked!" *else * geterrorcode(@pszText) * ? Psz2String(pszText) *endif
*l := setunlockcode(string2psz("456789012-210987654"),; * string2psz("MicroModia GmbH")) *? "setunlockcode():" *if l * ? "Group 'Parameter determinations': unlocked!" *else * geterrorcode(@pszText) * ? Psz2String(pszText) *endif
*l := setunlockcode(string2psz("567890123-321098765"),; * string2psz("MicroModia GmbH")) *? "setunlockcode():" *if l * ? "Group 'Notation calculations': unlocked!" *else * geterrorcode(@pszText) * ? Psz2String(pszText) *endif
*l := setunlockcode(string2psz("678901234-432109876"),; * string2psz("MicroModia GmbH")) *? "setunlockcode():" *if l * ? "Group 'Map calculations': unlockedt!" *else * geterrorcode(@pszText) * ? Psz2String(pszText) *endif *?
// Test of the DLL function getdllversion(). getdllversion(@pszText) ? "getdllversion():" ? "DLL version:", Psz2String(pszText) ? inkey(3)
// Test of the DLL function getauthor(). getauthor(@pszText) ? "getauthor():" ? Psz2String(pszText) ? inkey(3)
// Test of the DLL function getlicensee(). getlicensee(@pszText) ? "getlicensee():" ? Psz2String(pszText) ? inkey(3)
// Switch range validation on. l := setcoordarea(TRUE) ? "setcoordarea():" IF l ? "OK!" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function coordtrans(). // Gauß-Krüger -> UTMref nCoordXS := 2500000.0 nCoordYS := 5500000.0 nCoordSysS := 2 wRefSysS := 1 nCoordSysT := 51 wRefSysT := 2 nStrip := 0 l := coordtrans(nCoordXS,nCoordYS,pszCoordS,nCoordSysS,wRefSysS,; @nCoordXT,@nCoordYT,@pszCoordT,nCoordSysT,wRefSysT,; nStrip) ? "coordtrans():" IF l ? "UTMref:", Psz2String(pszCoordT) ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function coordtrans2(). // UTMref -> QTH (Maidenhead) pszCoordS := pszCoordT nCoordSysS := 51 wRefSysS := 2 pszCoordT2 := MemAlloc(16) nCoordSysT := 52 wRefSysT := 10 nStrip := 0 l := coordtrans2(nCoordXS,nCoordYS,pszCoordS,nCoordSysS,wRefSysS,; @nCoordXT,@nCoordYT,pszCoordT2,nCoordSysT,wRefSysT,; nStrip) ? "coordtrans2():" IF l ? "QTH (Maidenhead):", Psz2String(pszCoordT2) ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF MemFree(pszCoordT2) ? inkey(3)
// Test of the DLL function coordtrans3(). // Gauss-Krueger -> Longitude / Latitude nCoordXS := 2500000.0 nCoordYS := 5500000.0 nCoordSysS := 2 wRefSysS := 1 nNotationS := 0 nCoordSysT := 1 wRefSysT := 2 nNotationT := 1 nStrip := 0 l := coordtrans3(nCoordXS,nCoordYS,nCoordSysS,wRefSysS,nNotationS,; @nCoordXT,@nCoordYT,nCoordSysT,wRefSysT,nNotationT,; nStrip) ? "coordtrans3():" IF l ? "Longitude:", nCoordXT ? "Latitude:", nCoordYT ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function setuserrefsys(). // Translations, rotations, scale factor (ppm). nTranslatX := REAL8(-128.0) nTranslatY := REAL8(311.0) nTranslatZ := REAL8(-222.5) nRotatX := REAL8(2.43) nRotatY := REAL8(-3.15) nRotatZ := REAL8(4.14) nScale := REAL8(8.6) l := setuserrefsys(1,nTranslatX, nTranslatY, nTranslatZ,; nRotatX, nRotatY, nRotatZ,; nScale) ? "setuserrefsys():" IF l ? "OK!" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function setuserellsource(). // Ellipsoid semi axes. nHalfAxLargeS := REAL8(6379900.0) nHalfAxSmallS := REAL8(6377700.0) l := setuserellsource(1000,nHalfAxLargeS, nHalfAxSmallS) ? "setuserellsource():" IF l ? "OK!" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function setuserelltarget(). // Ellipsoid semi axes. nHalfAxLargeT := REAL8(6378200.0) nHalfAxSmallT := REAL8(6375500.0) l := setuserelltarget(1000,nHalfAxLargeT, nHalfAxSmallT) ? "setuserelltarget():" IF l ? "OK!" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test the user defined Reference System and ellipsoids with the // function coordtrans3(). nCoordXS := 2500000.0 nCoordYS := 5500000.0 nCoordSysS := 2 wRefSysS := 1000 nNotationS := 0 nCoordSysT := 1 wRefSysT := 1000 nNotationT := 1 nStrip := 0 l := coordtrans3(nCoordXS,nCoordYS,nCoordSysS,wRefSysS,nNotationS,; @nCoordXT,@nCoordYT,nCoordSysT,wRefSysT,nNotationT,; nStrip) ? "coordtrans3() with user defined Reference System Transition:" IF l ? "Longitude:", nCoordXT ? "Latitude:", nCoordYT ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function meritrans(). nCoordXS := 2500000.0 nCoordYS := 5500000.0 nCoordSysS := 2 nEllipsoid := 1 nStrip := 3 l := meritrans(nCoordXS,nCoordYS,@nCoordXT,@nCoordYT,nCoordSysS,; nEllipsoid,nStrip) ? "meritrans():" IF l ? "Easting:", nCoordXT ? "Northing:", nCoordYT ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function distancegeo(). nCoordXS := 07.19 nCoordYS := 51.33 nCoordXT := 07.61 nCoordYT := 51.19 nEllipsoid := 1 l := distancegeo(nCoordXS,nCoordYS,nCoordXT,nCoordYT,@nDistance,; nEllipsoid) ? "distancegeo():" IF l ? "Distance:", nDistance, "meters" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function distanceutm(). nCoordXS := 32464554.3 nCoordYS := 5133744.1 nCoordXT := 31647128.5 nCoordYT := 5278144.7 l := distanceutm(nCoordXS,nCoordYS,nCoordXT,nCoordYT,@nDistance) ? "distanceutm():" IF l ? "Distance:", nDistance, "meters" ELSE geterrorcode(@pszText) ? Psz2String(pszText) ENDIF ? inkey(3)
// Test of the DLL function getcoordsys(). wCoordSys := 18 // German Lambert mean coordinates l := getcoordsys(wCoordSys,@pszText) ? "getcoordsys():" IF l ? Psz2String(pszText) ELSE geterrorcode(@pszText) ? Psz2String(pszText) ? "An output of this function is only possible" ? "with valid unlock parameters!" ENDIF ? inkey(3)
// Test of the DLL function getrefsys(). wRefSysS := 5 // MGI, Hermannskogel, Bessel (1841) wRefSysT := 8 // CH1903, Old Observatory Bern, Bessel (1841) l := getrefsys(wRefSysS,wRefSysT,0,0,@pszText) ? "getrefsys():" IF l ? Psz2String(pszText) ELSE geterrorcode(@pszText) ? Psz2String(pszText) ? "An output of this function is only possible" ? "with valid unlock parameters!" ENDIF ? inkey(3)
// Test of the DLL function geterrorcode(). ? "geterrorcode():" geterrorcode(@pszText) ? Psz2String(pszText) ? inkey(30)
// Release memory if setstringallocate(FALSE) was set. IF .not. pszText == NULL_PSZ MemFree(pszText) ENDIF IF .not. pszCoordT == NULL_PSZ MemFree(pszCoordT) ENDIF RETURN
|