📄 ezprojections.pas
字号:
TEzProjector = Class( TComponent )
Private
FGC: TEzGeoConvert; (* the conversion object *)
FParams: TStrings; (* the params for conversion *)
Procedure SetParams( Value: TStrings );
function GetAbout: TEzAbout;
procedure SetAbout(const Value: TEzAbout);
Public
Constructor Create( AOwner: TComponent ); Override;
Destructor Destroy; Override;
Procedure CoordSysInit;
Procedure InitDefault;
Function CheckDefaultParams: Boolean;
Procedure LoadFromStream( Stream: TStream );
Procedure SaveToStream( Stream: TStream );
Procedure LoadFromFile( Const FileName: String );
Procedure SaveToFile( Const FileName: String );
Procedure CoordSysFromLatLong( Const Long, Lat: double; Var X, Y: double );
Procedure CoordSysToLatLong( Const X, Y: double; Var Long, Lat: double );
Function HasProjection: Boolean;
Class Function dmstor( Const ins: String ): double;
{calculate distance from (long1,lat1) to (long2,lat2)
geodetic inverse problem is used}
Function GeoDistance( Const Long1, Lat1, Long2, Lat2: double ): double;
Property GC: TEzGeoConvert Read FGC;
Published
Property Params: TStrings Read FParams Write SetParams;
Property About: TEzAbout read GetAbout write SetAbout;
End;
Const
{ As projections are implemented, they will be uncommented }
pj_list: Array[TEzProjectionCode] Of TPJ_LIST = (
( {id:'aea'; } descr: 'Albers Equal Area'; proj: Nil ),
//(id:'aeqd'; descr:'Azimuthal Equidistant' ; proj:nil),
( {id:'airy'; } descr: 'Airy'; proj: Nil ),
//(id:'aitoff'; descr:'Aitoff' ; proj:nil),
//(id:'alsk'; descr:'Mod. Stererographics of Alaska' ; proj:nil),
//(id:'apian'; descr:'Apian Globular I' ; proj:nil),
//(id:'august'; descr:'August Epicycloidal' ; proj:nil),
//(id:'bacon'; descr:'Bacon Globular' ; proj:nil),
//(id:'bipc'; descr:'Bipolar conic of western hemisphere' ; proj:nil),
//(id:'boggs'; descr:'Boggs Eumorphic' ; proj:nil),
( {id:'bonne'; } descr: 'Bonne (Werner lat_1=90)'; proj: Nil ),
( {id:'cass'; } descr: 'Cassini'; proj: Nil ),
( {id:'cc'; } descr: 'Central Cylindrical'; proj: Nil ),
( {id:'cea'; } descr: 'Equal Area Cylindrical'; proj: Nil ),
//(id:'chamb'; descr:'Chamberlin Trimetric' ; proj:nil),
//(id:'collg'; descr:'Collignon' ; proj:nil),
//(id:'crast'; descr:'Craster Parabolic (Putnins P4)' ; proj:nil),
//(id:'denoy'; descr:'Denoyer Semi-Elliptical' ; proj:nil),
//(id:'eck1'; descr:'Eckert I' ; proj:nil),
//(id:'eck2'; descr:'Eckert II' ; proj:nil),
//(id:'eck3'; descr:'Eckert III' ; proj:nil),
( {id:'eck4'; } descr: 'Eckert IV'; proj: Nil ),
( {id:'eck5'; } descr: 'Eckert V'; proj: Nil ),
( {id:'eck6'; } descr: 'Eckert VI'; proj: Nil ),
//(id:'eqc'; descr:'Equidistant Cylindrical (Plate Caree)' ; proj:nil),
//(id:'eqdc'; descr:'Equidistant Conic' ; proj:nil),
//(id:'euler'; descr:'Euler' ; proj:nil),
//(id:'fahey'; descr:'Fahey' ; proj:nil),
//(id:'fouc'; descr:'Foucaut' ; proj:nil),
//(id:'fouc_s'; descr:'Foucaut Sinusoidal' ; proj:nil),
//(id:'gall'; descr:'Gall (Gall Stereographic)' ; proj:nil),
//(id:'gins8'; descr:'Ginsburg VIII (TsNIIGAiK)' ; proj:nil),
( {id:'gn_sinu';} descr: 'General Sinusoidal Series'; proj: Nil ),
//(id:'gnom'; descr:'Gnomonic' ; proj:nil),
//(id:'goode'; descr:'Goode Homolosine' ; proj:nil),
//(id:'gs48'; descr:'Mod. Stererographics of 48 U.S.' ; proj:nil),
//(id:'gs50'; descr:'Mod. Stererographics of 50 U.S.' ; proj:nil),
//(id:'hammer'; descr:'Hammer & Eckert-Greifendorff' ; proj:nil),
//(id:'hatano'; descr:'Hatano Asymmetrical Equal Area' ; proj:nil),
( {id:'imw_p'; } descr: 'Internation Map of the World Polyconic'; proj: Nil ),
//(id:'kav5'; descr:'Kavraisky V' ; proj:nil),
//(id:'kav7'; descr:'Kavraisky VII' ; proj:nil),
//(id:'labrd'; descr:'Laborde' ; proj:nil),
( {id:'laea'; } descr: 'Lambert Azimuthal Equal Area'; proj: Nil ),
//(id:'lagrng'; descr:'Lagrange' ; proj:nil),
//(id:'larr'; descr:'Larrivee' ; proj:nil),
//(id:'lask'; descr:'Laskowski' ; proj:nil),
( {id:'lcc'; } descr: 'Lambert Conformal Conic'; proj: Nil ),
( {id:'leac'; } descr: 'Lambert Equal Area Conic'; proj: Nil ),
//(id:'lee_os'; descr:'Lee Oblated Stereographic' ; proj:nil),
//(id:'loxim'; descr:'Loximuthal' ; proj:nil),
//(id:'lsat'; descr:'Space oblique for LANDSAT' ; proj:nil),
//(id:'mbt_s'; descr:'McBryde-Thomas Flat-Polar Sine' ; proj:nil),
//(id:'mbt_fps';descr:'McBryde-Thomas Flat-Pole Sine (No. 2)' ; proj:nil),
//(id:'mbtfpp'; descr:'McBride-Thomas Flat-Polar Parabolic' ; proj:nil),
//(id:'mbtfpq'; descr:'McBryde-Thomas Flat-Polar Quartic' ; proj:nil),
( {id:'mbtfps'; } descr: 'McBryde-Thomas Flat-Polar Sinusoidal'; proj: Nil ),
( {id:'merc'; } descr: 'Mercator'; proj: Nil ),
//(id:'mil_os'; descr:'Miller Oblated Stereographic' ; proj:nil),
( {id:'mill'; } descr: 'Miller Cylindrical'; proj: Nil ),
//(id:'mpoly'; descr:'Modified Polyconic' ; proj:nil),
( {id:'moll'; } descr: 'Mollweide'; proj: Nil ),
//(id:'murd1'; descr:'Murdoch I' ; proj:nil),
//(id:'murd2'; descr:'Murdoch II' ; proj:nil),
//(id:'murd3'; descr:'Murdoch III' ; proj:nil),
//(id:'nell'; descr:'Nell' ; proj:nil),
//(id:'nell_h'; descr:'Nell-Hammer' ; proj:nil),
//(id:'nicol'; descr:'Nicolosi Globular' ; proj:nil),
//(id:'nsper'; descr:'Near-sided perspective' ; proj:nil),
//(id:'nzmg'; descr:'New Zealand Map Grid' ; proj:nil),
//(id:'ob_tran';descr:'General Oblique Transformation' ; proj:nil),
//(id:'ocea'; descr:'Oblique Cylindrical Equal Area' ; proj:nil),
//(id:'oea'; descr:'Oblated Equal Area' ; proj:nil),
( {id:'omerc'; } descr: 'Oblique Mercator'; proj: Nil ),
//(id:'ortel'; descr:'Ortelius Oval' ; proj:nil),
( {id:'ortho'; } descr: 'Orthographic'; proj: Nil ),
//(id:'pconic'; descr:'Perspective Conic' ; proj:nil),
( {id:'poly'; } descr: 'Polyconic (American)'; proj: Nil ),
//(id:'putp1'; descr:'Putnins P1' ; proj:nil),
//(id:'putp2'; descr:'Putnins P2' ; proj:nil),
//(id:'putp3'; descr:'Putnins P3' ; proj:nil),
//(id:'putp3p'; descr:'Putnins P3''' ; proj:nil),
//(id:'putp4p'; descr:'Putnins P4''' ; proj:nil),
//(id:'putp5'; descr:'Putnins P5' ; proj:nil),
//(id:'putp5p'; descr:'Putnins P5''' ; proj:nil),
//(id:'putp6'; descr:'Putnins P6' ; proj:nil),
//(id:'putp6p'; descr:'Putnins P6''' ; proj:nil),
//(id:'qua_aut';descr:'Quartic Authalic' ; proj:nil),
//(id:'robin'; descr:'Robinson' ; proj:nil),
//(id:'rpoly'; descr:'Rectangular Polyconic' ; proj:nil),
( {id:'sinu'; } descr: 'Sinusoidal (Sanson-Flamsteed)'; proj: Nil ),
//(id:'somerc'; descr:'Swiss. Obl. Mercator' ; proj:nil),
( {id:'stere'; } descr: 'Stereographic'; proj: Nil ),
//(id:'tcc'; descr:'Transverse Central Cylindrical' ; proj:nil),
( {id:'tcea'; } descr: 'Transverse Cylindrical Equal Area'; proj: Nil ),
//(id:'tissot'; descr:'Tissot Conic' ; proj:nil),
( {id:'tmerc'; } descr: 'Transverse Mercator'; proj: Nil ),
( {id:'tpeqd'; } descr: 'Two Point Equidistant'; proj: Nil ),
//(id:'tpers'; descr:'Tilted perspective' ; proj:nil),
( {id:'ups'; } descr: 'Universal Polar Stereographic'; proj: Nil ),
//(id:'urm5'; descr:'Urmaev V' ; proj:nil),
//(id:'urmfps'; descr:'Urmaev Flat-Polar Sinusoidal' ; proj:nil),
( {id:'utm'; } descr: 'Universal Transverse Mercator (UTM)'; proj: Nil ),
//(id:'vandg'; descr:'van der Grinten (I)' ; proj:nil),
//(id:'vandg2'; descr:'van der Grinten II' ; proj:nil),
//(id:'vandg3'; descr:'van der Grinten III' ; proj:nil),
( {id:'vandg4'; } descr: 'van der Grinten IV'; proj: Nil ),
//(id:'vitk1'; descr:'Vitkovsky I' ; proj:nil),
//(id:'wag1'; descr:'Wagner I (Kavraisky VI)' ; proj:nil),
//(id:'wag2'; descr:'Wagner II' ; proj:nil),
//(id:'wag3'; descr:'Wagner III' ; proj:nil),
( {id:'wag4'; } descr: 'Wagner IV'; proj: Nil ),
( {id:'wag5'; } descr: 'Wagner V'; proj: Nil ),
//(id:'wag6'; descr:'Wagner VI' ; proj:nil),
( {id:'wag7'; } descr: 'Wagner VII'; proj: Nil )
//(id:'weren'; descr:'Werenskiold I' ; proj:nil),
//(id:'wink1'; descr:'Winkel I' ; proj:nil),
//(id:'wink2'; descr:'Winkel II' ; proj:nil),
//(id:'wintri'; descr:'Winkel Tripel' ; proj:nil)
);
{ NOTE: pj_units[] const array changed to unit ambase.pas }
{ ellipsoid data }
pj_ellps: Array[TEzEllipsoidCode] Of TPJ_ELLPS = (
( {id:'MERIT'; } major: 'a=6378137.0'; ell: 'rf=298.257'; name: 'MERIT 1983'; ),
( {id:'SGS85'; } major: 'a=6378136.0'; ell: 'rf=298.257'; name: 'Soviet Geodetic System 85'; ),
( {id:'GRS80'; } major: 'a=6378137.0'; ell: 'rf=298.257222101'; name: 'GRS 1980(IUGG, 1980)'; ),
( {id:'IAU76'; } major: 'a=6378140.0'; ell: 'rf=298.257'; name: 'IAU 1976'; ),
( {id:'airy'; } major: 'a=6377563.396'; ell: 'b=6356256.910'; name: 'Airy 1830'; ),
( {id:'APL4.9'; } major: 'a=6378137.0.'; ell: 'rf=298.25'; name: 'Appl. Physics. 1965'; ),
( {id:'NWL9D'; } major: 'a=6378145.0.'; ell: 'rf=298.25'; name: 'Naval Weapons Lab., 1965'; ),
( {id:'mod_airy'; } major: 'a=6377340.189'; ell: 'b=6356034.446'; name: 'Modified Airy'; ),
( {id:'andrae'; } major: 'a=6377104.43'; ell: 'rf=300.0'; name: 'Andrae 1876 (Den., Iclnd.)'; ),
( {id:'aust_SA'; } major: 'a=6378160.0'; ell: 'rf=298.25'; name: 'Australian Natl & S. Amer. 196'; ),
( {id:'GRS67'; } major: 'a=6378160.0'; ell: 'rf=298.2471674270'; name: 'GRS 67(IUGG 1967)'; ),
( {id:'bessel'; } major: 'a=6377397.155'; ell: 'rf=299.1528128'; name: 'Bessel 1841'; ),
( {id:'bess_nam'; } major: 'a=6377483.865'; ell: 'rf=299.1528128'; name: 'Bessel 1841 (Namibia)'; ),
( {id:'clrk66'; } major: 'a=6378206.4'; ell: 'b=6356583.8'; name: 'Clarke 1866 (NAD-27)'; ),
( {id:'clrk80'; } major: 'a=6378249.145'; ell: 'rf=293.4663'; name: 'Clarke 1880 mod.'; ),
( {id:'CPM'; } major: 'a=6375738.7'; ell: 'rf=334.29'; name: 'Comm. des Poids et Mesures 179'; ),
( {id:'delmbr'; } major: 'a=6376428.'; ell: 'rf=311.5'; name: 'Delambre 1810 (Belgium)'; ),
( {id:'engelis'; } major: 'a=6378136.05'; ell: 'rf=298.2566'; name: 'Engelis 1985'; ),
( {id:'evrst30'; } major: 'a=6377276.345'; ell: 'rf=300.8017'; name: 'Everest 1830'; ),
( {id:'evrst48'; } major: 'a=6377304.063'; ell: 'rf=300.8017'; name: 'Everest 1948'; ),
( {id:'evrst56'; } major: 'a=6377301.243'; ell: 'rf=300.8017'; name: 'Everest 1956'; ),
( {id:'evrst69'; } major: 'a=6377295.664'; ell: 'rf=300.8017'; name: 'Everest 1969'; ),
( {id:'evrstSS'; } major: 'a=6377298.556'; ell: 'rf=300.8017'; name: 'Everest (Sabah & Sarawak)'; ),
( {id:'fschr60'; } major: 'a=6378166.'; ell: 'rf=298.3'; name: 'Fischer (Mercury Datum) 1960'; ),
( {id:'fschr60m'; } major: 'a=6378155.'; ell: 'rf=298.3'; name: 'Modified Fischer 1960'; ),
( {id:'fschr68'; } major: 'a=6378150.'; ell: 'rf=298.3'; name: 'Fischer 1968'; ),
( {id:'helmert'; } major: 'a=6378200.'; ell: 'rf=298.3'; name: 'Helmert 1906'; ),
( {id:'hough'; } major: 'a=6378270.0'; ell: 'rf=297.'; name: 'Hough'; ),
( {id:'intl'; } major: 'a=6378388.0'; ell: 'rf=297.'; name: 'International 1909 (Hayford)'; ),
( {id:'krass'; } major: 'a=6378245.0'; ell: 'rf=298.3'; name: 'Krassovsky, 1942'; ),
( {id:'kaula'; } major: 'a=6378163.'; ell: 'rf=298.24'; name: 'Kaula 1961'; ),
( {id:'lerch'; } major: 'a=6378139.'; ell: 'rf=298.257'; name: 'Lerch 1979'; ),
( {id:'mprts'; } major: 'a=6397300.'; ell: 'rf=191.'; name: 'Maupertius 1738'; ),
( {id:'new_intl'; } major: 'a=6378157.5'; ell: 'b=6356772.2'; name: 'New International 1967'; ),
( {id:'plessis'; } major: 'a=6376523.'; ell: 'b=6355863.'; name: 'Plessis 1817 (France)'; ),
( {id:'SEasia'; } major: 'a=6378155.0'; ell: 'b=6356773.3205'; name: 'Southeast Asia'; ),
( {id:'walbeck'; } major: 'a=6376896.0'; ell: 'b=6355834.8467'; name: 'Walbeck'; ),
( {id:'WGS60'; } major: 'a=6378165.0'; ell: 'rf=298.3'; name: 'WGS 60'; ),
( {id:'WGS66'; } major: 'a=6378145.0'; ell: 'rf=298.25'; name: 'WGS 66'; ),
( {id:'WGS72'; } major: 'a=6378135.0'; ell: 'rf=298.26'; name: 'WGS 72'; ),
( {id:'WGS84'; } major: 'a=6378137.0'; ell: 'rf=298.257223563'; name: 'WGS 84'; ),
( {id:'ITRFMEX'; } major: 'a=6378137'; ell: 'b=6356752.3141'; name: 'ITRF (Mexico)' ) );
Function ProjCodeFromID( Const id: String; Var found: boolean ): TEzProjectionCode;
Function EllpsCodeFromID( Const id: String ): TEzEllipsoidCode;
//function UnitCodeFromName(const name:String) : TEzCoordsUnits;
Procedure LatLonFromXYOffset( gc: TEzGeoConvert;
Const Lat, Lon: double;
Var Dy, Dx: double );
Implementation
Uses
EzProjimpl, TypInfo, ezsystem, ezconsts, fProj, Math;
//---------------------------------------------------------------------//
Procedure LatLonFromXYOffset( gc: TEzGeoConvert;
Const Lat, Lon: Double;
Var Dy, Dx: Double );
Var
X, Y: double;
NewLat, NewLon: double;
Begin
(* transform to XY *)
gc.Geo_CoordSysFromLatLong( Lon, Lat, X, Y );
(* offset the specified distance *)
X := X + Dx;
Y := Y + Dy;
(* and reset back to lat/lon *)
gc.Geo_CoordSysToLatLong( X, Y, NewLon, NewLat );
Dy := ( NewLat - Lat );
Dx := ( NewLon - Lon );
End;
{ Implements TEzProjector object }
Constructor TEzProjector.Create( AOwner: TComponent );
Begin
Inherited Create( AOwner );
FGC := TEzGeoConvert.Create;
FParams := TStringList.Create;
CheckDefaultParams;
End;
Destructor TEzProjector.Destroy;
Begin
FGC.Free;
FParams.Free;
Inherited Destroy;
End;
function TEzProjector.GetAbout: TEzAbout;
begin
Result:= SEz_GisVersion;
end;
procedure TEzProjector.SetAbout(const Value: TEzAbout);
begin
end;
Function TEzProjector.GeoDistance( Const Long1, Lat1, Long2, Lat2: double ): double;
Begin
result := FGC.Geo_Distance( Long1, Lat1, Long2, Lat2 );
End;
Procedure TEzProjector.LoadFromStream( Stream: TStream );
Begin
FParams.Clear;
FParams.LoadFromStream( Stream );
CheckDefaultParams;
FGC.Geo_CoordSysInit( TStringList( FParams ) );
End;
Procedure TEzProjector.SaveToStream( Stream: TStream );
Begin
CheckDefaultParams;
FParams.SaveToStream( Stream );
End;
Procedure TEzProjector.LoadFromFile( Const FileName: String );
Var
Stream: TStream;
Begin
If Not FileExists( FileName ) Then
Exit;
Stream := TFileStream.Create( FileName, fmOpenRead Or fmShareDenyNone );
Try
Self.LoadFromStream( Stream );
Finally
Stream.free;
End;
End;
Procedure TEzProjector.SaveToFile( Const FileName: String );
Var
Stream: TStream;
Begin
If Not FileExists( FileName ) Then
Exit;
Stream := TFileStream.Create( FileName, fmCreate );
Try
Self.SaveToStream( Stream );
Finally
Stream.free;
End;
End;
Procedure TEzProjector.InitDefault;
Begin
FParams.Clear;
CheckDefaultParams;
CoordSysInit;
End;
Procedure TEzProjector.CoordSysInit;
Begin
FGC.Geo_CoordSysInit( TStringList( FParams ) );
End;
Function TEzProjector.HasProjection: Boolean;
Begin
result := FGC.fwd <> Nil;
End;
Function TEzProjector.CheckDefaultParams: Boolean;
Begin
Result := True;
If FParams.IndexOfName( 'units' ) < 0 Then
Begin
FParams.Insert( 0, 'units=m' );
Result := False;
End;
If FParams.IndexOfName( 'ellps' ) < 0 Then
Begin
FParams.Insert( 0, 'ellps=WGS84' );
Result := False;
End;
If FParams.IndexOfName( 'proj' ) < 0 Then
Begin
FParams.Insert( 0, 'proj=utm' );
If FParams.IndexOfName( 'zone' ) < 0 Then
FParams.Add( 'zone=12' ); // our zone :-)
Result := False;
End;
End;
Procedure TEzProjector.CoordSysFromLatLong( Const Long, Lat: double; Var X, Y: double );
Begin
FGC.Geo_CoordSysFromLatLong( Long, Lat, X, Y );
End;
Procedure TEzProjector.CoordSysToLatLong( Const X, Y: double; Var Long, Lat: double );
Begin
FGC.Geo_CoordSysToLatLong( X, Y, Long, Lat );
End;
Procedure TEzProjector.SetParams( Value: TStrings );
Begin
FParams.Assign( Value );
End;
{ Convert DMS string to radians }
Class Function TEzProjector.dmstor( Const ins: String ): double;
Const
sym = 'NnEeSsWw';
Var
i, p, nl, last, code: integer;
sign: char;
work, temp: String;
v, tv: double;
Begin
result := 0;
work := Trim( UpperCase( ins ) );
If length( work ) = 0 Then Exit; //+46.65d57'8.660"N
val( work, v, code );
If code = 0 Then
Begin
result := v;
exit;
End;
If ( length( work ) > 1 ) And ( work[length( work )] = 'R' ) Then
Begin
val( copy( work, 1, length( work ) - 1 ), v, code );
If code = 0 Then
Begin
result := v;
exit;
End;
End;
sign := work[1];
If Not ( sign In ['+', '-'] ) Then
sign := '+';
i := 1;
last := i;
v := 0;
nl := 0;
// +46.65d57'8.660"N
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -