📄 main.frm
字号:
mapThe.Layers.Add lyrTrajedy
' Add layers to the reference map
Dim lyrLatLong30 As New MapObjects2.MapLayer
Set lyrLatLong30.GeoDataset = dcData.FindGeoDataset(LATLONG30_LAYER)
With lyrLatLong30
.Name = LATLONG30_LAYER_NAME
.Symbol.Color = moGray
.Symbol.Size = 1
.CoordinateSystem = gcsGeo
End With
mapRef.Layers.Add lyrCont
mapRef.Layers.Add lyrLatLong30
' Add the Masks to the reference map
Dim lyrComedyRef As New MapObjects2.MapLayer
Set lyrComedyRef.GeoDataset = dcData.FindGeoDataset(COMEDY_LAYER)
With lyrComedyRef
.Name = COMEDY_LAYER_NAME
.Symbol.Color = moRed
.Symbol.Size = 2
.CoordinateSystem = gcsGeo
.Visible = False
End With
Dim lyrTrajedyRef As New MapObjects2.MapLayer
Set lyrTrajedyRef.GeoDataset = dcData.FindGeoDataset(TRAJEDY_LAYER)
With lyrTrajedyRef
.Name = TRAJEDY_LAYER_NAME
.Symbol.Color = moBlue
.Symbol.Size = 2
.CoordinateSystem = gcsGeo
.Visible = False
End With
mapRef.Layers.Add lyrComedyRef
mapRef.Layers.Add lyrTrajedyRef
End Sub
Private Sub Command1_Click()
End Sub
Private Sub cboProjClass_Click()
Dim sProjClass As String
sProjClass = cboProjClass.Text
cboProjTypes.Clear
Select Case sProjClass
Case "Geographic"
cboProjTypes.AddItem " "
cboProjTypes.Enabled = False
lblSelProjection.ForeColor = moGray
Geographic_proj mapMain
Case "Cylindrical"
lblSelProjection.ForeColor = &HFFFF&
imgGlobe.Picture = LoadPicture(g_ImageDir & "\cyl.bmp")
imgGlobe.Visible = True
cboProjTypes.AddItem "Mercator"
cboProjTypes.AddItem "Miller"
cboProjTypes.AddItem "Equidistant Cylindrical"
cboProjTypes.AddItem "EckertVI"
cboProjTypes.Enabled = True
Case "Planar"
lblSelProjection.ForeColor = &HFFFF&
imgGlobe.Picture = LoadPicture(g_ImageDir & "\flat.bmp")
imgGlobe.Visible = True
cboProjTypes.AddItem "Stereographic"
cboProjTypes.AddItem "Azimuthal Equidistant"
cboProjTypes.Enabled = True
Case "Conic"
lblSelProjection.ForeColor = &HFFFF&
imgGlobe.Visible = True
imgGlobe.Picture = LoadPicture(g_ImageDir & "\cone.bmp")
cboProjTypes.AddItem "Polyconic"
'cboProjTypes.AddItem "Albers"
'cboProjTypes.AddItem "Equidistant Conic"
cboProjTypes.Enabled = True
Case "Miscellaneous"
lblSelProjection.ForeColor = &HFFFF&
imgGlobe.Visible = False
cboProjTypes.AddItem "Robinson"
cboProjTypes.AddItem "Sinusoidal"
cboProjTypes.AddItem "Mollweide"
cboProjTypes.AddItem "Gall Stereographic"
'cboProjTypes.AddItem "QuarticAuthalic"
cboProjTypes.AddItem "Van der Grinten"
cboProjTypes.Enabled = True
End Select
cboProjTypes.ListIndex = 0
End Sub
Private Sub cboProjTypes_Click()
txtProjDesc.Text = ""
txtProjDesc.Visible = False
Select Case cboProjTypes.Text
Case "Mercator"
Mercator_proj mapMain
lblMainMap.Caption = "Mercator"
txtProjDesc.Text = "Used for navigation or maps of equatorial regions. " _
& "Any straight line on Mercator is a rhumb line (line of constant " _
& "direction). Directions along a rhumb line are true between any two " _
& "points, but a rhumb line is usually not the shortest distance " _
& "between two points." & vbCrLf & "Distances are true only along the " _
& "equator, but are reasonably correct within 15 degrees of the Equator." _
& vbCrLf & "Areas and shapes of large area are distorted. Distortion " _
& "increases away from the Equator and is extreme in polar regions." _
& "The map is conformal in that angles and shapes within a small area " _
& "are essentially true."
txtProjDesc.Visible = True
Case "Miller"
Miller_proj mapMain
lblMainMap.Caption = "Miller Cylindrical"
txtProjDesc.Text = "Used to represent the entire Earth in a " _
& "rectangular frame. The Miller projection avoids some of the " _
& "scale exagerations of the Mercator but shows distorted shapes " _
& "and areas." & vbCrLf & "Direction and distance are true only " _
& "along the equator."
txtProjDesc.Visible = True
Case "Equidistant Cylindrical"
EquidistantCyl_proj mapMain
lblMainMap.Caption = "Equidistant Cylindrical"
txtProjDesc.Text = "Used for the world or large regions. " _
& "This projection was more common in the past as it easy to contruct." _
& "The polar regions are less distorted in scale and area than the " _
& "Mercator." & vbCrLf _
& "Meridians and parallels are equidistant straight lines."
txtProjDesc.Visible = True
Case "Polyconic"
Polyconic_proj mapMain
lblMainMap.Caption = "Polyconic"
txtProjDesc.Text = "Used almost exclusively for large scale mapping in " _
& "the United States unil the 1950's. Best suited for areas oriented " _
& "north-south." & vbCrLf _
& "Directions are true only along the central meridian. " _
& "Distances are true only along each parallel and along central meridian. " _
& vbCrLf & "Shapes and areas true only along central meridian and distortion " _
& "increases away from the central meridian."
txtProjDesc.Visible = True
Case "Equidistant Conic"
EquidistantConic_Sphere_proj mapMain
lblMainMap.Caption = "Equidistant Conic"
Case "Sinusoidal"
Sinusoidal_Sphere_proj mapMain
lblMainMap.Caption = "Sinusoidal"
txtProjDesc.Text = "Used in atlases to show distortion and large areas of " _
& "north-south extent. It has also been used to show hydrocarbon provinces" _
& " and sedimentary basins of the world." & vbCrLf _
& "Graticule spacing retains property of equivalence of area. " _
& "Distances are correct along all parallels and the central meridian(s). " _
& vbCrLf & "Areas are proportional to same areas on the Earth. " _
& "Shapes are increasingly distorted away from the central meridian(s) and" _
& " near the poles" _
& vbCrLf & "Not conformal, equidistant or perpective."
txtProjDesc.Visible = True
Case "Mollweide"
Mollweide_Sphere_proj mapMain
lblMainMap.Caption = "Mollweide"
Case "QuarticAuthalic"
QuarticAuthalic_Sphere_proj mapMain
lblMainMap.Caption = "QuarticAuthalic"
Case "Van der Grinten"
VanderGrintenI_World_proj mapMain
lblMainMap.Caption = "Van der Grinten"
Case "Azimuthal Equidistant"
AzimuthalEquidistant_World_proj mapMain
lblMainMap.Caption = "Azimuthal Equidistant"
txtProjDesc.Text = "Useful for showing airline distances from center point " _
& "of projection as well as for seismic and radio work. " _
& vbCrLf & "Directions true only from center point of projection. Distances " & vbCrLf _
& " correct between points along straight line through the center." _
& "Scale increases away from center point. Any Straight line through center " _
& "point is a great circle. Distortion increases away from the center point."
txtProjDesc.Visible = True
Case "Gall Stereographic"
GallStereographic_World_proj mapMain
lblMainMap.Caption = "Gall Stereographic"
Case "Robinson"
Robinson_World_proj mapMain
lblMainMap.Caption = "Robinson"
txtProjDesc.Text = "Uses tabular coordinates rather than mathematical " _
& "formulas to get the 'right look'. Better balance of size and shape " _
& "of high latitude lands than Mercator, Van der Grinten or Mollweide." & vbCrLf _
& "Directions are true along parallels and central meridian. " _
& "Distances constant along equator and other parallels, but scales vary. " _
& vbCrLf & "All areas show some distortion but very low along Equator and " _
& "within 45 degrees of center." _
& vbCrLf & "Not conformal, equal area, equidistant or perpective."
txtProjDesc.Visible = True
Case "Albers"
Albers_proj mapMain
lblMainMap.Caption = "Albers"
Case "EckertVI"
EckertVI_Sphere_proj mapMain
lblMainMap.Caption = "EckertVI"
Case "Stereographic"
Stereographic_Sphere_proj mapMain
lblMainMap.Caption = "Stereographic"
txtProjDesc.Text = "Frequently use for maps of polar regions as well as " _
& "continental sized areas where the extent is similar in all directions. " _
& vbCrLf & "Directions true only from center point of projection." & vbCrLf _
& "Scale increases away from center point. Any Straight line through center " _
& "point is a great circle. Distortion increases away from the center point." _
& vbCrLf & "Map is conformal and perspective but not equal area or equidistant."
txtProjDesc.Visible = True
End Select
chkFaceToggle.Value = 0
End Sub
Private Sub chkFaceToggle_Click()
mapMain.Layers(COMEDY_LAYER_NAME).Visible = chkFaceToggle.Value
mapMain.Layers(TRAJEDY_LAYER_NAME).Visible = chkFaceToggle.Value
mapRef.Layers(COMEDY_LAYER_NAME).Visible = chkFaceToggle.Value
mapRef.Layers(TRAJEDY_LAYER_NAME).Visible = chkFaceToggle.Value
mapMain.Refresh
mapRef.Refresh
End Sub
Private Sub Form_Load()
'add the layers to the map
Add_Layers frmMain.mapMain, frmMain.mapRef
' Populate the Projection class ComboBox
cboProjClass.AddItem "Geographic"
cboProjClass.AddItem "Cylindrical"
cboProjClass.AddItem "Conic"
cboProjClass.AddItem "Planar"
cboProjClass.AddItem "Miscellaneous"
cboProjClass.ListIndex = 0
' set label captions
lblSelProjClass.Caption = "Select Projection Class:"
lblSelProjection.Caption = "Select Projection:"
lblMainMap.Caption = "Geographic Coordinates"
' image box
imgGlobe.Visible = False
chkFaceToggle.Value = 0
End Sub
Private Sub mapMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
mapMain.Extent = mapMain.TrackRectangle
Else
mapMain.Pan
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -