'
把地图保存为图片
CommonDialog1.FileName = ""
CommonDialog1.Filter = "JPG 图片(*.JPG)|*.jpg"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Dim lScrRes As Long
lScrRes =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.Resolution
Dim pExporter As IExporter
Set pExporter = New JpegExporter
pExporter.ExportFileName = CommonDialog1.FileName
pExporter.Resolution = lScrRes
Dim deviceRECT As tagRECT
deviceRECT =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.DeviceFrame
Dim pDriverBounds As IEnvelope
Set pDriverBounds = New Envelope
pDriverBounds.PutCoords deviceRECT.Left, deviceRECT.bottom,deviceRECT.Right, deviceRECT.Top
pExporter.PixelBounds = pDriverBounds
Dim pCancel As ITrackCancel
Set pCancel = New CancelTracker
Me.MapControl1.ActiveView.Output pExporter.StartExporting, lScrRes,deviceRECT, Me.MapControl1.ActiveView.Extent, pCancel
pExporter.FinishExporting
End If
当时做这一步的时候出了点小问题,Set pDriverBounds = New Envelope 这句老是编译出错,提示“无效使用New 关键字”。后来通过QQ 群的高手提醒,说可能是引用有冲突,只要在Envelope 前面加上esriGeometry 就可以了,即:
Dim pDriverBounds As esriGeometry.Envelope
Set pDriverBounds = NewesriGeometry.Envelope
果然这样就好了。
CommonDialog1.FileName = ""
CommonDialog1.Filter = "JPG 图片(*.JPG)|*.jpg"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Dim lScrRes As Long
lScrRes =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.Resolution
Dim pExporter As IExporter
Set pExporter = New JpegExporter
pExporter.ExportFileName = CommonDialog1.FileName
pExporter.Resolution = lScrRes
Dim deviceRECT As tagRECT
deviceRECT =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.DeviceFrame
Dim pDriverBounds As IEnvelope
Set pDriverBounds = New Envelope
pDriverBounds.PutCoords deviceRECT.Left, deviceRECT.bottom,deviceRECT.Right, deviceRECT.Top
pExporter.PixelBounds = pDriverBounds
Dim pCancel As ITrackCancel
Set pCancel = New CancelTracker
Me.MapControl1.ActiveView.Output pExporter.StartExporting, lScrRes,deviceRECT, Me.MapControl1.ActiveView.Extent, pCancel
pExporter.FinishExporting
End If
当时做这一步的时候出了点小问题,Set pDriverBounds = New Envelope 这句老是编译出错,提示“无效使用New 关键字”。后来通过QQ 群的高手提醒,说可能是引用有冲突,只要在Envelope 前面加上esriGeometry 就可以了,即:
Dim pDriverBounds As esriGeometry.Envelope
Set pDriverBounds = NewesriGeometry.Envelope
果然这样就好了。