' Export_Map_to_PDF_Using_OOo.bas
'
' MapViewer 6 has the ability to export a map to a PDF file,
' but the map is stored as a bitmap within a PDF, so the file
' size is rather large.  This script uses the OpenOffice.org
' application to create the PDF.  It is done in a vector
' format, so the PDF is much smaller.
'
' This script requires that you have the free OpenOffice.org
' application.  It is available from http://www.openoffice.org/.
'
' This script has been tested with MapViewer 6 and 
' OpenOffice.org 1.1.2.  It may or may not work with other
' versions.
'
' To use this script, have MapViewer running with the map
' you want to export loaded as the active document, then
' run this script from within Scripter.
'
' Mike Blessing, Golden Software, 22-Jul-2004
' mapviewersupport@goldensoftware.com
'
Option Explicit
Sub Main
  Dim oServiceManager As Object
  Dim oDesktop As Object
  Dim oDocument As Object
  Dim oDispatcher As Object
  Dim strFile, strURL, strDir, strName, strFull As String
  Dim mvApp, plot As Object
  Dim i,j,ln As Integer

  ' Start the OOo ServiceManager.
  ' Issue an error message and quit if it fails.
  On Error GoTo NeedOOo
  Set oServiceManager= CreateObject("com.sun.star.ServiceManager")
  On Error GoTo 0

  ' Find MapViewer and create a pointer to the application object
  Set mvApp = GetObject(,"MapViewer.Application")
  Set plot = mvApp.ActiveDocument
  ' Copy the map
  plot.CopyAllLayers()

  ' Get output file name from user
  ' Default to GSM name/loc w diff extension
  strFull = plot.FullName
  ln = Len(strFull)

  i = InStrRev(strFull,"\")
  If i = 0 Then
    strDir = "C:\"
  Else
    strDir = Left(strFull,i)
  End If

  j = InStrRev(strFull,".")
  If j = 0 Then
    strName = Right(strFull,ln-i) + ".pdf"
  Else
    strName = Mid(strFull,i+1,j-i) + "pdf"
  End If

  strFile = GetFilePath(strName,"pdf",strDir,"Save PDF As",3)
  ' Need to handle cancel from file dialog
  If strFile = "" Then Exit Sub
  ' Convert to URL format
  strURL = "file:///" + Replace(strFile,"\","/")

  ' Create the desktop and an empty writer document
  Set oDesktop= oServiceManager.createInstance("com.sun.star.frame.Desktop")
  Set oDocument= oDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Array(MakePropertyValue("Hidden",False)))

  ' Create the dispatcher and paste the clipboard contents to the document
  Set oDispatcher = oServiceManager.createInstance("com.sun.star.frame.DispatchHelper")
  oDispatcher.executeDispatch(oDocument.CurrentController.Frame, ".uno:Paste", "", 0, Array())

  ' Save document in PDF
  Call oDocument.storeToURL(strURL, Array(MakePropertyValue("FilterName", "writer_pdf_Export")))
  Call oDocument.Close(True)
  Exit Sub

NeedOOo:
  MsgBox "This script requires that you have the" + vbCrLf + "OpenOffice.org application suite installed." + vbCrLf + "It is available from http://www.openoffice.org/ ."

End Sub

Function MakePropertyValue(cName, uValue) As Object
  Dim oServiceManager As Object
  Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
  Dim oStruct
  Set oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
  oStruct.Name = cName
  oStruct.Value = uValue
  Set MakePropertyValue = oStruct
End Function