layout.frm

mo的GPS例子程序

Call frmView.ResetAspectRatios

Dim rect As MapObjects2.Rectangle
Dim ge As MapObjects2.GeoEvent

'Adjust aspect ratio of Map/Scalebar to match
'the Map/Scalebar on frmView.
Set ge = tlPage.FindEvent("MAP")
If Not ge Is Nothing Then
  Set rect = ge.Shape
  rect.Bottom = rect.Top - (rect.Width / frmView.map_aspect)
  Set ge.Shape = rect
End If

Set ge = Nothing
Set rect = Nothing

'Adjust aspect ratio of Legend to match
'the Legend on frmView.
Set ge = tlPage.FindEvent("LEGEND")
If Not ge Is Nothing Then
  Set rect = ge.Shape
  rect.Bottom = rect.Top - (rect.Width / frmView.legend_aspect)
  Set ge.Shape = rect
End If

'Adjust aspect ratio of North Arrow so
'that it is square.
Set ge = tlPage.FindEvent("ARROW")
If Not ge Is Nothing Then
  Set rect = ge.Shape
  rect.Bottom = rect.Top - rect.Width
  Set ge.Shape = rect
End If

End Sub

Private Sub PositionLayoutForm()

'Position the opening of the Layout form.
If frmView.Width + Me.Width < Screen.Width Then
  'Open just to the right of the View form...
  Me.Left = frmView.Left + frmView.Width
 Else
  '...unless that puts it off the screen.
  'In this case, put this form against the
  'right side of the screen.
  Me.Left = Screen.Width - Me.Width
End If

End Sub

Private Sub LoadBackgroundPage()

Dim dc As New MapObjects2.DataConnection
Dim gds As MapObjects2.GeoDataset

'Define rules for drawing background page
Dim vmr As New MapObjects2.ValueMapRenderer
vmr.Field = "Code"
vmr.ValueCount = 3
vmr.SymbolType = moFillSymbol
'...Shadow draws solid black
vmr.Value(0) = "SHADOW"
vmr.Symbol(0).SymbolType = moFillSymbol
vmr.Symbol(0).Style = moSolidFill
vmr.Symbol(0).Color = &H707070  'Very dark gray
vmr.Symbol(0).Outline = False
'...Paper draws solid white
vmr.Value(1) = "PAPER"
vmr.Symbol(1).SymbolType = moFillSymbol
vmr.Symbol(1).Style = moSolidFill
vmr.Symbol(1).Color = moWhite
'...Margin draws transparent, with blue outline
vmr.Value(2) = "MARGIN"
vmr.Symbol(2).SymbolType = moFillSymbol
vmr.Symbol(2).Style = moTransparentFill
vmr.Symbol(2).OutlineColor = moBlue

'Bail out And Unload the Layout form if the
'background page cannot be found.
dc.Database = App.Path & "\data"
If Not dc.Connect Then
  MsgBox "Cannot connect to:  " & App.Path & "\data"
  Unload Me
End If
Set gds = dc.FindGeoDataset("page")
If gds Is Nothing Then
  MsgBox "Cannot find " & App.Path & "\data\page.shp,shx,dbf"
  Unload Me
End If

'Load the background page MapLayer.
Set mlyrPage.GeoDataset = gds

'Set symbology to background page.
Set mlyrPage.Renderer = vmr

'Populate attribute table for the "page" shapefile,
'so that the size of the margin, paper, and shadow
'can be edited on-the-fly to reflect the printer
'page selection by the user.
Set recsPage = mlyrPage.Records

'Edit the background page so that its page size and
'margins reflect the current settings of the default
'Windows printer.
'Call AdjustBackgroundPage

'Add the background page MapLayer to the Layout map.
mapLayout.Layers.Add mlyrPage

'Zoom out a bit
Dim rect As MapObjects2.Rectangle
Set rect = mapLayout.FullExtent
rect.ScaleRectangle 1.1
Set mapLayout.FullExtent = rect
Set mapLayout.Extent = rect

End Sub

Private Sub InitializeSymbols()

'Populate TrackingLayer's Symbol array
Set tlPage = mapLayout.TrackingLayer
With tlPage
  .SymbolCount = 2
  .Symbol(0).SymbolType = moFillSymbol
  .Symbol(0).Style = moSolidFill
  .Symbol(0).Color = moRed
  .Symbol(1).SymbolType = moFillSymbol
  .Symbol(1).Style = moSolidFill
  .Symbol(1).Color = moGreen
End With

'Setup text symbol for frame labels
Dim fnt As New stdole.StdFont
fnt.Name = "Arial"
fnt.Bold = True
fnt.Size = 12
Set tsym.Font = fnt
tsym.HorizontalAlignment = moAlignCenter
tsym.VerticalAlignment = moAlignCenter

End Sub

Private Sub AdjustBackgroundPage()

Dim polyShadow As MapObjects2.Polygon
Dim polyPaper As MapObjects2.Polygon
Dim polyMargin As MapObjects2.Polygon
Dim ptsPage As MapObjects2.Points
Dim ptPage As MapObjects2.Point
Dim sHeight, sWidth, sLeftMar, sRightMar, sTopMar, sBottomMar As Single

sHeight = ConvPrinterPix2FrameInch(Printer.Height, X_AXIS) * -1
sWidth = ConvPrinterPix2FrameInch(Printer.Width, Y_AXIS)
sLeftMar = ConvPrinterPix2FrameInch(Printer.ScaleLeft, X_AXIS)
sRightMar = ConvPrinterPix2FrameInch(Printer.Width - Printer.ScaleWidth - Printer.ScaleLeft, X_AXIS)
sTopMar = ConvPrinterPix2FrameInch(Printer.ScaleTop, Y_AXIS) * -1
sBottomMar = ConvPrinterPix2FrameInch(Printer.Height - Printer.ScaleHeight - Printer.ScaleTop, Y_AXIS) * -1

'Edit paper polygon
Set polyPaper = New MapObjects2.Polygon
Set ptsPage = New MapObjects2.Points
Set ptPage = New MapObjects2.Point
ptPage.X = 0
ptPage.Y = 0
ptsPage.Add ptPage
ptPage.X = sWidth
ptPage.Y = 0
ptsPage.Add ptPage
ptPage.X = sWidth
ptPage.Y = sHeight
ptsPage.Add ptPage
ptPage.X = 0
ptPage.Y = sHeight
ptsPage.Add ptPage
ptPage.X = 0
ptPage.Y = 0
ptsPage.Add ptPage
polyPaper.Parts.Add ptsPage

'Edit margin polygon
Set polyMargin = New MapObjects2.Polygon
Set ptsPage = New MapObjects2.Points
Set ptPage = New MapObjects2.Point
ptPage.X = sLeftMar
ptPage.Y = sTopMar
ptsPage.Add ptPage
ptPage.X = sRightMar
ptPage.Y = sTopMar
ptsPage.Add ptPage
ptPage.X = sRightMar
ptPage.Y = sBottomMar
ptsPage.Add ptPage
ptPage.X = sLeftMar
ptPage.Y = sBottomMar
ptsPage.Add ptPage
ptPage.X = sLeftMar
ptPage.Y = sTopMar
ptsPage.Add ptPage
polyMargin.Parts.Add ptsPage

'Edit shadow polygon
Set polyShadow = New MapObjects2.Polygon
Set ptsPage = New MapObjects2.Points
Set ptPage = New MapObjects2.Point
ptPage.X = 0 + 0.25
ptPage.Y = 0 - 0.25
ptsPage.Add ptPage
ptPage.X = sWidth + 0.25
ptPage.Y = 0 - 0.25
ptsPage.Add ptPage
ptPage.X = sWidth + 0.25
ptPage.Y = sHeight - 0.25
ptsPage.Add ptPage
ptPage.X = 0 + 0.25
ptPage.Y = sHeight - 0.25
ptsPage.Add ptPage
ptPage.X = 0 + 0.25
ptPage.Y = 0 - 0.25
ptsPage.Add ptPage
polyShadow.Parts.Add ptsPage

'Add adjusted polygons to background page
With recsPage
  .Edit
  Set .Fields("Shape").Value = polyShadow
  .Update
  .MoveNext
  .Edit
  Set .Fields("Shape").Value = polyPaper
  .Update
  .MoveNext
  .Edit
  Set .Fields("Shape").Value = polyMargin
  .Update
  .StopEditing
End With
  
End Sub

Private Sub PreviewElements()

Dim geFrame As MapObjects2.GeoEvent
Dim rectFrame As MapObjects2.Rectangle
Dim ptPrev As New MapObjects2.Point
Dim xPrev As Single
Dim yPrev As Single
Dim widthPrev, heightPrev As Double
Dim tsymPrev As New MapObjects2.TextSymbol
Dim fntPrev As New stdole.StdFont
Dim ptTitle As New MapObjects2.Point

'+++PREVIEW TITLE

Set geFrame = tlPage.FindEvent("TITLE")
If Not geFrame Is Nothing Then
  Set rectFrame = geFrame.Shape
  'Text insertion point will be lower-left of Title Frame.
  ptTitle.X = rectFrame.Left
  ptTitle.Y = rectFrame.Top - rectFrame.Height
  fntPrev.Name = "Arial"
  fntPrev.Size = mapLayout.FromMapDistance(rectFrame.Height) / 20
  Set tsymPrev.Font = fntPrev
  tsymPrev.HorizontalAlignment = moAlignLeft
  mapLayout.DrawText frmView.txtTitle, ptTitle, tsymPrev
End If


'+++PREVIEW MAP
Set geFrame = tlPage.FindEvent("MAP")
If Not geFrame Is Nothing Then
  Set rectFrame = geFrame.Shape
  ptPrev.X = rectFrame.Left
  ptPrev.Y = rectFrame.Top
  mapLayout.FromMapPoint ptPrev, xPrev, yPrev
  widthPrev = mapLayout.FromMapDistance(rectFrame.Width)
  heightPrev = mapLayout.FromMapDistance(rectFrame.Height)
  
  'The map and scalebar are placed in the same frame.
  '...The map is in the top 84% of the frame
  '...The scalebar is in the bottom 14% of the frame.
  '...There is 2% space in between them.
  
  StretchBlt mapLayout_hDC, _
             ConvTwips2Pix(Screen, xPrev, X_AXIS), _
             ConvTwips2Pix(Screen, yPrev, Y_AXIS), _
             ConvTwips2Pix(Screen, widthPrev, X_AXIS), _
             ConvTwips2Pix(Screen, heightPrev * 0.84, Y_AXIS), _
             frmView.hDC, _
             ConvTwips2Pix(Screen, frmView.mapView.Left, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.mapView.Top, Y_AXIS), _
             ConvTwips2Pix(Screen, frmView.mapView.Width, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.mapView.Height, Y_AXIS), _
             SRCCOPY
End If

'+++PREVIEW SCALEBAR
Set geFrame = tlPage.FindEvent("MAP")
If Not geFrame Is Nothing Then
  Set rectFrame = geFrame.Shape
  ptPrev.X = rectFrame.Left
  ptPrev.Y = rectFrame.Top
  mapLayout.FromMapPoint ptPrev, xPrev, yPrev
  widthPrev = mapLayout.FromMapDistance(rectFrame.Width)
  heightPrev = mapLayout.FromMapDistance(rectFrame.Height)

  'The map and scalebar are placed in the same frame.
  '...The map is in the top 84% of the frame
  '...The scalebar is in the bottom 14% of the frame.
  '...There is 2% space in between them.
  
  StretchBlt mapLayout_hDC, _
             ConvTwips2Pix(Screen, xPrev, X_AXIS), _
             ConvTwips2Pix(Screen, yPrev + (heightPrev * 0.86), Y_AXIS), _
             ConvTwips2Pix(Screen, widthPrev, X_AXIS), _
             ConvTwips2Pix(Screen, heightPrev * 0.14, Y_AXIS), _
             frmView.hDC, _
             ConvTwips2Pix(Screen, frmView.sbMapView.Left, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.sbMapView.Top, Y_AXIS), _
             ConvTwips2Pix(Screen, frmView.sbMapView.Width, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.sbMapView.Height, Y_AXIS), _
             SRCCOPY
End If

'+++PREVIEW LEGEND
Set geFrame = tlPage.FindEvent("LEGEND")
If Not geFrame Is Nothing Then
  Set rectFrame = geFrame.Shape
  ptPrev.X = rectFrame.Left
  ptPrev.Y = rectFrame.Top
  mapLayout.FromMapPoint ptPrev, xPrev, yPrev
  widthPrev = mapLayout.FromMapDistance(rectFrame.Width)
  heightPrev = mapLayout.FromMapDistance(rectFrame.Height)
  
  'Chop 280 twips off the left side of the legend
  'to hide the check boxes.
  'Chop 40 twips off the top to eliminate the 3D
  'appearance of the legend.
  
  StretchBlt mapLayout_hDC, _
             ConvTwips2Pix(Screen, xPrev, X_AXIS), _
             ConvTwips2Pix(Screen, yPrev, Y_AXIS), _
             ConvTwips2Pix(Screen, widthPrev, X_AXIS), _
             ConvTwips2Pix(Screen, heightPrev, Y_AXIS), _
             frmView.hDC, _
             ConvTwips2Pix(Screen, frmView.legMapView.Left + 280, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.legMapView.Top + 40, Y_AXIS), _
             ConvTwips2Pix(Screen, frmView.legMapView.Width - 280, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.legMapView.Height - 40, Y_AXIS), _
             SRCCOPY
End If

'+++PREVIEW NORTH ARROW
Set geFrame = tlPage.FindEvent("ARROW")
If Not geFrame Is Nothing Then
  Set rectFrame = geFrame.Shape
  ptPrev.X = rectFrame.Left
  ptPrev.Y = rectFrame.Top
  mapLayout.FromMapPoint ptPrev, xPrev, yPrev
  widthPrev = mapLayout.FromMapDistance(rectFrame.Width)
  heightPrev = mapLayout.FromMapDistance(rectFrame.Height)

  StretchBlt mapLayout_hDC, _
             ConvTwips2Pix(Screen, xPrev, X_AXIS), _
             ConvTwips2Pix(Screen, yPrev, Y_AXIS), _
             ConvTwips2Pix(Screen, widthPrev, X_AXIS), _
             ConvTwips2Pix(Screen, heightPrev, Y_AXIS), _
             frmView.hDC, _
             ConvTwips2Pix(Screen, frmView.picArrow.Left, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.picArrow.Top, Y_AXIS), _
             ConvTwips2Pix(Screen, frmView.picArrow.Width, X_AXIS), _
             ConvTwips2Pix(Screen, frmView.picArrow.Height, Y_AXIS), _
             SRCCOPY
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Release Layout page device context handle.
ReleaseDC mapLayout.hwnd, mapLayout_hDC

'Unload globals
Set tlPage = Nothing
Set mlyrPage = Nothing
Set recsPage = Nothing
Set geActive = Nothing
Set tsym = Nothing
Set ptClick = Nothing

End Sub