mapexport.bas

一个交通专用的gis-T系统

Attribute VB_Name = "modMapExport"
'*********************************************************************
'*
'*                本源码完全免费，共交通同仁学习参考                 *
'*                      www.tranbbs.com                              *
'*                   Developed by Yang Ming                          *
'*       Nanjing Institute of City Transportation Planning           *
'*                 请保留本版权信息，谢谢合作                        *
'*                      中国交通技术论坛                             *
'*                                                                   *
'*                                                                   *
'*********************************************************************
Option Explicit

Public Sub ExportMap(frmMap As Form)
Dim iFormat As Integer

With Main.CdlExportMap
    .Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNNoChangeDir + cdlOFNExtensionDifferent
    .InitDir = App.Path
    .FileName = ""
    .Filter = "元文件(*.wmf)|*.wmf|位图(*.bmp)|*.bmp|JPG图像(*.jpg)|*.jpg|TIF图像(*.tif)|*.tif|GIF图像(*.gif)|*.gif|便携网络图形(*.png)|*.png|PhotoShop图像(*.psd)|*.psd"
    .FilterIndex = 3
    .ShowSave
    If .FileName <> "" Then
        Select Case .FilterIndex
            Case 1
                iFormat = miFormatWMF
            Case 2
                iFormat = miFormatBMP
            Case 3
                iFormat = miFormatJPEG
            Case 4
                iFormat = miFormatTIF
            Case 5
                iFormat = miFormatGIF
            Case 6
                iFormat = miFormatPNG
            Case 7
                iFormat = miFormatPSD
        End Select
        
        Main.Mapshow.ExportSelection = True  '选中的突出显示一起输出
        Main.Mapshow.ExportMap .FileName, iFormat
       
    End If
End With

End Sub

Public Sub PrintMap(frmMap As Form, ByVal bZoomAsWindow As Boolean, ByVal iCopies As Integer)
'打印地图
'frmMap: Map Window, bZoomAsWindow: Zoom as window or as paper, iCopies: Copies to print
Dim i As Integer
Dim lWidth As Long
Dim lHeight As Long

     On Error GoTo ErrorHandler  ' Set up error handler.

     Main.ScaleMode = 6  'set mode to mm
     ' there is no Printer.StartDoc method, it seems it is done
     ' implicitly when you use one of the printer.print methods
     ' so we need to print something before we print our map
     ' to start the page
     
     'vbPRORPortrait 1 文档打印以纸的窄边作顶部
     'vbPRORLandscape
'     MsgBox "Printer:" & Printer.DeviceName
'     MsgBox "Orientation:" & Printer.Orientation
'    ' MsgBox "Dialog Orientation:" & CdlExportMap.Orientation
'     MsgBox "Size:" & Printer.PaperSize
'     MsgBox "Height & Width:" & Printer.Height / 567 & " " & Printer.Width / 567

     For i = 1 To iCopies '打印份数
        Printer.CurrentX = 0
        Printer.CurrentY = 0
        Printer.Print " "
        If bZoomAsWindow Then '根据窗口大小打印
            lWidth = Main.Mapshow.Width * 100
            lHeight = Main.Mapshow.Height * 100
        Else  '根据打印纸张大小打印,设置了方向之后，纸张的高度、宽度会自动调整好
'            If Printer.Orientation = vbPRORPortrait Then  '直打
                lWidth = Printer.Width / 567 * 1000  ' Printer.Width 以缇为单位，1缇=1/567cm,需转换为0.01mm
                lHeight = lWidth * Main.Mapshow.Height / Main.Mapshow.Width
'            Else  '横打
'                lWidth = Printer.Height / 567 * 1000
'                lHeight = lWidth * frmMapWindow.Map1.Height / frmMapWindow.Map1.Width
'            End If
        End If
        Main.Mapshow.PrintMap Printer.hDC, 0, 0, lWidth, lHeight
        Printer.NewPage ' Send new page.
    Next i
        
     'Me.Hide
     Printer.EndDoc  'Printing is finished.
     'Unload Me
     Exit Sub

ErrorHandler:
    If Err.Number <> cdlCancel Then  '取消
          MsgBox "打印机存在错误，请更正后重试。错误号：" + (Str(Err.Number)), , "打印失败"
    End If
    'Unload Me
End Sub