⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.frm

📁 This sample demonstrates the use of the projection objects ProjCoordSys and GeoCoordSys, and the C
💻 FRM
📖 第 1 页 / 共 2 页
字号:
  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 + -