projections.bas

This sample demonstrates the use of the projection objects ProjCoordSys and GeoCoordSys, and the C

Attribute VB_Name = "basProjections"
Option Explicit

Public Sub Mercator_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_Mercator
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
'      .Left = -20100000
'      .Bottom = -30100000
'      .Top = 30080000
'      .Right = 201000000
      .Left = -20100000
      .Bottom = -20000000
      .Top = 20000000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub Miller_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_MillerCylindrical
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub EquidistantCyl_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_EquidistantCylindrical
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub Polyconic_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_Polyconic
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
'      .Left = -8000000
'      .Bottom = -8000000
'      .Top = 8000000
'      .Right = 10000000
      .Left = -9000000
      .Bottom = -9000000
      .Top = 9000000
      .Right = 9000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub EquidistantConic_World_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_EquidistantConic
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
       .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With


  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub
Public Sub EquidistantConic_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_EquidistantConic
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
       .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With


  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub


Public Sub Albers_proj(mapThe As MapObjects2.Map)


  Dim pcs As New MapObjects2.Projection
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjection_Albers
 
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
       .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With


  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault
End Sub
Public Sub Sinusoidal_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_Sinusoidal
  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub
Public Sub Mollweide_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_Mollweide

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub


Public Sub EckertVI_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_EckertVI

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub


Public Sub Stereographic_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_Stereographic

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
'       .Left = -20100000
'       .Bottom = -30100000
'       .Top = 30080000
'       .Right = 201000000
       .Left = -12010000
       .Bottom = -12010000
       .Top = 12000000
       .Right = 12000000

  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub QuarticAuthalic_Sphere_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_QuarticAuthalic

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub VanderGrintenI_World_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_VanderGrintenI

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
'      .Left = -20100000
'      .Bottom = -30100000
'      .Top = 30080000
'      .Right = 201000000
      .Left = -19100000
      .Bottom = -15000000
      .Top = 15000000
      .Right = 19000000

  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub

Public Sub AzimuthalEquidistant_World_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_Sphere_AzimuthalEquidistant

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
'      .Left = -20100000
'      .Bottom = -30100000
'      .Top = 30080000
'      .Right = 201000000
      .Left = -10500000
      .Bottom = -10500000
      .Top = 10500000
      .Right = 10500000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub
Public Sub GallStereographic_World_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_GallStereographic

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub
Public Sub Robinson_World_proj(mapThe As MapObjects2.Map)

  Dim pcs As New MapObjects2.ProjCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moProjCS_World_Robinson

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -20100000
      .Bottom = -30100000
      .Top = 30080000
      .Right = 201000000
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault

End Sub
Public Sub Geographic_proj(mapThe As MapObjects2.Map)
  Dim pcs As New MapObjects2.GeoCoordSys
  Dim FullExtRect As New MapObjects2.Rectangle
  
  Screen.MousePointer = vbHourglass
  pcs.Type = moGeoCS_Clarke1866

  mapThe.CoordinateSystem = pcs
  
  With FullExtRect
      .Left = -180
      .Bottom = -90
      .Top = 90
      .Right = 180
  End With
  
  
  mapThe.Extent = FullExtRect
  Screen.MousePointer = vbDefault
End Sub