Attribute VB_Name = "modExportFromMapObject"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExportFromMapObject.bas
'
'
' References:
'  esriCarto.olb           ESRI Carto Object Library
'  esriDataSourcesFile.olb ESRI DataSourcesFile Object Library
'  esriDisplay.olb         ESRI Display Object Library
'  esriGeometry.olb        ESRI Geometry Object Library
'  esriOutput.olb          ESRI Output Object Library
'  esriGeoDatabase.olb     ESRI GeoDatabase Object Library
'  esriSystem.olb          ESRI System Object Library
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Option Explicit

' these Win32 API definitions will be used to read the display resolution
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

' global variable for license management
Public m_pAoInitialize As IAoInitialize


Sub Main()

  ' Because this is a stand-alone app, we'll need to manage
  '  our own license.  Exit app if we can't get a valid license
  If (InitializeLicense() = False) Then Exit Sub

  ExportMap
  ExportPageLayout
  
  ' Check the license back in.
  m_pAoInitialize.Shutdown
  
End Sub

Private Sub ExportMap()
  
  Dim pActiveView As IActiveView
  Dim pWorkspaceFactory As IWorkspaceFactory
  Dim pFeatureWorkspace As IFeatureWorkspace
  Dim pFeatureLayer As IFeatureLayer
  Dim pMap As IMap
  Dim pGeoFeatureLayer As IGeoFeatureLayer
  Dim deviceFrameRect As tagRECT
  
  Set pMap = New Map
  Set pActiveView = pMap
  
  ' load a layer from shapefile
  Set pWorkspaceFactory = New ShapefileWorkspaceFactory
  Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile("C:\Program Files\ArcGIS\Bin\TemplateData\USA", 0)
  Set pFeatureLayer = New FeatureLayer
  Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass("states")
  pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
  pMap.AddLayer pFeatureLayer
  
  Set pWorkspaceFactory = Nothing
  Set pFeatureWorkspace = Nothing
  Set pFeatureLayer = Nothing

  ' turn labeling on
  Set pGeoFeatureLayer = pMap.Layer(0)
  pGeoFeatureLayer.DisplayAnnotation = True
  Set pGeoFeatureLayer = Nothing
    
  ' set a reference scale so the labels will be scaled to a reasonable size
  pMap.ReferenceScale = 10000000
  
  ' because the Map view is not connected to a hWnd, we must explicitly
  '  change the Map's DeviceFrame dimensions from "0 x 0" to something
  '  larger.  "800 x 600" should work well for our purposes here.
  With deviceFrameRect
    .Left = 0
    .Right = 800
    .Top = 0
    .Bottom = 600
  End With
  pActiveView.ScreenDisplay.DisplayTransformation.DeviceFrame = deviceFrameRect
  
  ' export the map
  Dim pExport As IExport
  Dim iScreenResolution As Integer
  Dim iOutputResolution As Integer
  Dim exportRECT As tagRECT
  Dim pPixelBoundsEnv As IEnvelope
  Dim hdc As Long
  
  Set pExport = New ExportPDF
  
  pExport.ExportFileName = "c:\ExportMap.pdf"
  
  Dim tmpDC As Long
  tmpDC = GetDC(0)
  iScreenResolution = GetDeviceCaps(tmpDC, 88)  '88 is Win32 constant for LOGPIXELSX
  ReleaseDC 0, tmpDC
  iOutputResolution = 1200
  pExport.Resolution = iOutputResolution
  
  With exportRECT
   .Left = pActiveView.ExportFrame.Left * (iOutputResolution / iScreenResolution)
   .Top = pActiveView.ExportFrame.Top * (iOutputResolution / iScreenResolution)
   .Right = pActiveView.ExportFrame.Right * (iOutputResolution / iScreenResolution)
   .Bottom = pActiveView.ExportFrame.Bottom * (iOutputResolution / iScreenResolution)
  End With

  Set pPixelBoundsEnv = New Envelope
  pPixelBoundsEnv.PutCoords exportRECT.Left, exportRECT.Top, exportRECT.Right, exportRECT.Bottom
  pExport.PixelBounds = pPixelBoundsEnv
  
  hdc = pExport.StartExporting
  pActiveView.Output hdc, iOutputResolution, exportRECT, Nothing, Nothing
  pExport.FinishExporting
  
  Set pMap = Nothing
  Set pActiveView = Nothing
  Set pExport = Nothing
  Set pPixelBoundsEnv = Nothing

End Sub


Private Sub ExportPageLayout()
  
  Dim pActiveView As IActiveView
  Dim pWorkspaceFactory As IWorkspaceFactory
  Dim pFeatureWorkspace As IFeatureWorkspace
  Dim pFeatureLayer As IFeatureLayer
  Dim pMap As IMap
  Dim pGeoFeatureLayer As IGeoFeatureLayer
  Dim deviceFrameRect As tagRECT
  Dim pPageLayout As IPageLayout
  Dim pMapFrame As IMapFrame
  Dim pGraphicsContainer As IGraphicsContainer
  Dim pMapElement As IElement
  Dim pGeoExt As IGeometry
  Dim pMapExt As IEnvelope
  
  Set pPageLayout = New PageLayout
  Set pActiveView = pPageLayout
  
  ' change the Page to Letter size, Landscape orientation
  pPageLayout.Page.FormID = esriPageFormLetter
  pPageLayout.Page.Orientation = 2

  
  ' add a 6.5 X 9 inch dataframe (Map object wrapped in a MapFrame)
  '  to the PageLayout
  Set pGraphicsContainer = pPageLayout
  Set pMap = New Map
  Set pMapFrame = New MapFrame
  Set pMapExt = New Envelope
  pMapExt.XMin = 1
  pMapExt.YMin = 1
  pMapExt.XMax = 10
  pMapExt.YMax = 7.5
  Set pGeoExt = pMapExt
  Set pMapFrame.Map = pMap
  Set pMapElement = pMapFrame
  pMapElement.Geometry = pGeoExt
  pGraphicsContainer.AddElement pMapElement, 0
  Set pGeoExt = Nothing
  Set pMapFrame = Nothing
  Set pMapElement = Nothing
  Set pGraphicsContainer = Nothing
  Set pPageLayout = Nothing
    
  ' load a layer from shapefile
  Set pWorkspaceFactory = New ShapefileWorkspaceFactory
  Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile("C:\Program Files\ArcGIS\Bin\TemplateData\USA", 0)
  Set pFeatureLayer = New FeatureLayer
  Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass("states")
  pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName
  pMap.AddLayer pFeatureLayer
  
  Set pWorkspaceFactory = Nothing
  Set pFeatureWorkspace = Nothing
  Set pFeatureLayer = Nothing
  
  ' turn labeling on
  Set pGeoFeatureLayer = pMap.Layer(0)
  pGeoFeatureLayer.DisplayAnnotation = True
  Set pGeoFeatureLayer = Nothing
  
  ' set a reference scale so the labels will be scaled to a reasonable size
  pMap.ReferenceScale = 10000000
  
  Set pMap = Nothing
  
  ' because the PageLayout view is not connected to a hWnd, we must explicitly
  '  change the PageLayout's DeviceFrame dimensions from "0 x 0" to something
  '  larger.  "800 x 600" should work well for our purposes here.
  With deviceFrameRect
    .Left = 0
    .Right = 800
    .Top = 0
    .Bottom = 600
  End With
  pActiveView.ScreenDisplay.DisplayTransformation.DeviceFrame = deviceFrameRect

  ' export the map
  Dim pExport As IExport
  Dim iScreenResolution As Integer
  Dim iOutputResolution As Integer
  Dim exportRECT As tagRECT
  Dim pPixelBoundsEnv As IEnvelope
  Dim hdc As Long
  
  Set pExport = New ExportPDF
  
  pExport.ExportFileName = "c:\ExportPageLayout.pdf"
  
  Dim tmpDC As Long
  tmpDC = GetDC(0)
  iScreenResolution = GetDeviceCaps(tmpDC, 88)  '88 is Win32 LOGPIXELSX constant
  ReleaseDC 0, tmpDC
  iOutputResolution = 1200
  pExport.Resolution = iOutputResolution
  
  With exportRECT
   .Left = pActiveView.ExportFrame.Left * (iOutputResolution / iScreenResolution)
   .Top = pActiveView.ExportFrame.Top * (iOutputResolution / iScreenResolution)
   .Right = pActiveView.ExportFrame.Right * (iOutputResolution / iScreenResolution)
   .Bottom = pActiveView.ExportFrame.Bottom * (iOutputResolution / iScreenResolution)
  End With

  Set pPixelBoundsEnv = New Envelope
  pPixelBoundsEnv.PutCoords exportRECT.Left, exportRECT.Top, exportRECT.Right, exportRECT.Bottom
  pExport.PixelBounds = pPixelBoundsEnv
  
  hdc = pExport.StartExporting
  pActiveView.Output hdc, iOutputResolution, exportRECT, Nothing, Nothing
  pExport.FinishExporting

  Set pActiveView = Nothing
  Set pExport = Nothing
  Set pPixelBoundsEnv = Nothing

End Sub

Private Function InitializeLicense() As Boolean

  Dim licenseStatus As esriLicenseStatus
  Dim bSuccess As Boolean
  
  bSuccess = True
  
  'Check for an Engine License
  licenseStatus = CheckOutLicenses(esriLicenseProductCodeEngine)
  If (licenseStatus = esriLicenseNotLicensed) Then
    'Next try Desktop ArcView
    licenseStatus = CheckOutLicenses(esriLicenseProductCodeArcView)
  End If
  
  If (licenseStatus = esriLicenseNotLicensed) Then
    MsgBox "You are not licensed to run this product"
    bSuccess = False
  ElseIf (licenseStatus = esriLicenseUnavailable) Then
    MsgBox "There are insufficient licenses to run"
    bSuccess = False
  ElseIf (licenseStatus = esriLicenseFailure) Then
    MsgBox "Unexpected license failure. Please contact your administrator"
    bSuccess = False
  End If
  
  InitializeLicense = bSuccess

End Function

Private Function CheckOutLicenses(productCode As esriLicenseProductCode) As esriLicenseStatus
  
  Dim licenseStatus As esriLicenseStatus
  Set m_pAoInitialize = New AoInitialize
  CheckOutLicenses = esriLicenseUnavailable

  licenseStatus = m_pAoInitialize.IsProductCodeAvailable(productCode)
  If licenseStatus = esriLicenseAvailable Then
        licenseStatus = m_pAoInitialize.Initialize(productCode)
  End If
  CheckOutLicenses = licenseStatus
  
End Function