layout.frm

mo的GPS例子程序

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form frmLayout 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Layout"
   ClientHeight    =   9000
   ClientLeft      =   7245
   ClientTop       =   480
   ClientWidth     =   7455
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9000
   ScaleWidth      =   7455
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdResetAspects 
      Caption         =   "Reset Frame Aspect Ratios"
      Height          =   495
      Left            =   6120
      TabIndex        =   20
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton cmdPrint 
      Caption         =   "Print Now"
      Height          =   255
      Left            =   6120
      TabIndex        =   19
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Frame fraComposePreview 
      BorderStyle     =   0  'None
      Height          =   735
      Left            =   6000
      TabIndex        =   16
      Top             =   480
      Width           =   1335
      Begin VB.OptionButton optComposePreview 
         Caption         =   "Preview"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   18
         Top             =   480
         Width           =   975
      End
      Begin VB.OptionButton optComposePreview 
         Caption         =   "Compose"
         Height          =   195
         Index           =   0
         Left            =   240
         TabIndex        =   17
         Top             =   240
         Value           =   -1  'True
         Width           =   975
      End
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Delete frame"
      Height          =   255
      Index           =   9
      Left            =   4200
      TabIndex        =   15
      Top             =   1200
      Width           =   1335
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Pan tool"
      Enabled         =   0   'False
      Height          =   255
      Index           =   1
      Left            =   240
      TabIndex        =   14
      Top             =   720
      Width           =   1455
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Select frame"
      Height          =   255
      Index           =   6
      Left            =   4200
      TabIndex        =   12
      Top             =   480
      Width           =   1335
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Resize frame"
      Height          =   255
      Index           =   8
      Left            =   4200
      TabIndex        =   10
      Top             =   960
      Width           =   1335
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Move frame"
      Height          =   255
      Index           =   7
      Left            =   4200
      TabIndex        =   8
      Top             =   720
      Width           =   1215
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Add north arrow"
      Height          =   255
      Index           =   5
      Left            =   2040
      TabIndex        =   7
      Top             =   1200
      Width           =   1575
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Add title"
      Height          =   255
      Index           =   4
      Left            =   2040
      TabIndex        =   6
      Top             =   960
      Width           =   1095
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Add legend"
      Height          =   255
      Index           =   3
      Left            =   2040
      TabIndex        =   5
      Top             =   720
      Width           =   1215
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Add map and scalebar"
      Height          =   255
      Index           =   2
      Left            =   2040
      TabIndex        =   4
      Top             =   480
      Width           =   1935
   End
   Begin VB.OptionButton optMouseAction 
      Caption         =   "Zoom tool"
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   3
      Top             =   480
      Value           =   -1  'True
      Width           =   1455
   End
   Begin MapObjects2.Map mapLayout 
      Height          =   7200
      Left            =   120
      TabIndex        =   0
      Top             =   1680
      Width           =   7200
      _Version        =   131072
      _ExtentX        =   12700
      _ExtentY        =   12700
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "layout.frx":0000
   End
   Begin VB.Label lblAddElement 
      Caption         =   "Navigate page"
      Height          =   255
      Index           =   2
      Left            =   240
      TabIndex        =   13
      Top             =   240
      Width           =   1455
   End
   Begin VB.Label lblAddElement 
      Caption         =   "Manipulate Frames"
      Height          =   255
      Index           =   1
      Left            =   4200
      TabIndex        =   11
      Top             =   240
      Width           =   1455
   End
   Begin VB.Label lblAddElement 
      Caption         =   "Create Frames"
      Height          =   255
      Index           =   0
      Left            =   2040
      TabIndex        =   9
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label lblYcoord 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Ycoord"
      Height          =   195
      Left            =   120
      TabIndex        =   2
      Top             =   1440
      Width           =   975
   End
   Begin VB.Label lblXcoord 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Xcoord"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1200
      Width           =   975
   End
End
Attribute VB_Name = "frmLayout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private tlPage As MapObjects2.TrackingLayer
Private mlyrPage As New MapObjects2.MapLayer
Private recsPage As MapObjects2.Recordset
Private geActive As MapObjects2.GeoEvent
Private tsym As New MapObjects2.TextSymbol
Private ptClick As MapObjects2.Point
Private strResizeSide As String
Private iMouseOption As Integer
Private mapLayout_hDC As Long
Private mc2page_offsetX As Single
Private mc2page_offsetY As Single
'
Private Const SRCCOPY = &HCC0020
'
Private Declare Function StretchBlt Lib "gdi32" _
                     (ByVal hDC As Long, _
                      ByVal X As Long, _
                      ByVal Y As Long, _
                      ByVal nWidth As Long, _
                      ByVal nHeight As Long, _
                      ByVal hSrcDC As Long, _
                      ByVal xSrc As Long, _
                      ByVal ySrc As Long, _
                      ByVal nSrcWidth As Long, _
                      ByVal nSrcHeight As Long, _
                      ByVal dwRop As Long) _
                      As Long
Private Declare Function GetDC Lib "user32" _
                     (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
                     (ByVal hwnd As Long, _
                      ByVal hDC As Long) As Long
'

Private Sub cmdPrint_Click()

Dim ge As MapObjects2.GeoEvent
Dim rectFrame As MapObjects2.Rectangle
Dim printer_frame_originX_pix, printer_frame_originY_pix As Integer
Dim printer_frame_width_pix, printer_frame_height_pix As Single
Dim screen_frame_originX_pix, screen_frame_originY_pix As Integer
Dim screen_frame_width_pix, screen_frame_height_pix As Single


'+++PREPARE THE PRINTER
Printer.Print


'+++SETUP THE MAP+++  (includes map, neatline, and scalebar)

'Get map frame
Set ge = tlPage.FindEvent("MAP")
If Not ge Is Nothing Then
  Set rectFrame = ge.Shape
  Set ge = Nothing

  'calc map dimensions.  The map and the scalebar share the
  'map frame.  This is so the graphic scalebar can remain in sync
  'with the size of the map.  The map itself takes up the top 84%
  'of the map frame.  The bottom 14% is for the scale bar.
  'The map and scalebar are separated by 2% of the frame height.
  printer_frame_originX_pix = ConvFrameInch2PrinterPix(rectFrame.Left, X_AXIS)
  printer_frame_originY_pix = ConvFrameInch2PrinterPix(rectFrame.Top, Y_AXIS) * -1
  printer_frame_width_pix = ConvFrameInch2PrinterPix(rectFrame.Width, X_AXIS)
  printer_frame_height_pix = ConvFrameInch2PrinterPix(rectFrame.Height * 0.84, Y_AXIS)

  'send map to printer buffer
  frmView.mapView.OutputMap2 Printer.hDC, _
                  printer_frame_originX_pix, _
                  printer_frame_originY_pix, _
                  printer_frame_width_pix, _
                  printer_frame_height_pix


'+++PRINT A NEATLINE AROUND THE MAP
  Printer.ScaleMode = vbPixels
  Printer.Line (printer_frame_originX_pix, _
                printer_frame_originY_pix)-Step(printer_frame_width_pix, _
                printer_frame_height_pix), _
                &H404040, B   'Medium gray color


'+++SETUP THE SCALEBAR+++

  'calc scalebar dimensions.  The map and the scalebar share the
  'map frame.  This is so the graphic scalebar can remain in sync
  'with the size of the map.  The map itself takes up the top 84%
  'of the map frame.  The bottom 14% is for the scale bar.
  'The map and scalebar are separated by 2% of the frame height.
  printer_frame_originX_pix = ConvFrameInch2PrinterPix(rectFrame.Left, X_AXIS)
  printer_frame_originY_pix = ConvFrameInch2PrinterPix((rectFrame.Top * -1) + (rectFrame.Height * 0.86), Y_AXIS)
  printer_frame_width_pix = ConvFrameInch2PrinterPix(rectFrame.Width, X_AXIS)
  printer_frame_height_pix = ConvFrameInch2PrinterPix(rectFrame.Height * 0.14, Y_AXIS)
  Set rectFrame = Nothing
  screen_frame_originX_pix = ConvTwips2Pix(Screen, frmView.sbMapView.Left, X_AXIS)
  screen_frame_originY_pix = ConvTwips2Pix(Screen, frmView.sbMapView.Top, Y_AXIS)
  screen_frame_width_pix = ConvTwips2Pix(Screen, frmView.sbMapView.Width, X_AXIS)
  screen_frame_height_pix = ConvTwips2Pix(Screen, frmView.sbMapView.Height, Y_AXIS)

  'send scalebar to printer buffer
  StretchBlt Printer.hDC, _
             printer_frame_originX_pix, _
             printer_frame_originY_pix, _
             printer_frame_width_pix, _
             printer_frame_height_pix, _
             frmView.hDC, _
             screen_frame_originX_pix, _
             screen_frame_originY_pix, _
             screen_frame_width_pix, _
             screen_frame_height_pix, _
             SRCCOPY

End If 'Not rectFrame Is Nothing


'+++SETUP THE LEGEND+++

'Get legend frame
Set ge = tlPage.FindEvent("LEGEND")
If Not ge Is Nothing Then
  Set rectFrame = ge.Shape
  Set ge = Nothing

  'chop off the left 280 twips and top 40 twips of the legend
  'frame to eliminate the check boxes and 3D appearance.

  'calc legend dimensions
  printer_frame_originX_pix = ConvFrameInch2PrinterPix(rectFrame.Left, X_AXIS)
  printer_frame_originY_pix = ConvFrameInch2PrinterPix(rectFrame.Top, Y_AXIS) * -1
  printer_frame_width_pix = ConvFrameInch2PrinterPix(rectFrame.Width, X_AXIS)
  printer_frame_height_pix = ConvFrameInch2PrinterPix(rectFrame.Height, Y_AXIS)
  Set rectFrame = Nothing
  screen_frame_originX_pix = ConvTwips2Pix(Screen, (frmView.legMapView.Left + 280), X_AXIS)
  screen_frame_originY_pix = ConvTwips2Pix(Screen, (frmView.legMapView.Top + 40), Y_AXIS)
  screen_frame_width_pix = ConvTwips2Pix(Screen, (frmView.legMapView.Width - 280), X_AXIS)
  screen_frame_height_pix = ConvTwips2Pix(Screen, (frmView.legMapView.Height - 40), Y_AXIS)
  
  'send legend to printer buffer
  StretchBlt Printer.hDC, _
             printer_frame_originX_pix, _
             printer_frame_originY_pix, _
             printer_frame_width_pix, _
             printer_frame_height_pix, _
             frmView.hDC, _
             screen_frame_originX_pix, _
             screen_frame_originY_pix, _
             screen_frame_width_pix, _
             screen_frame_height_pix, _
             SRCCOPY
             
End If 'Not rectFrame Is Nothing

               
'+++SETUP THE TEXTBOX+++

'Get textbox frame
Set ge = tlPage.FindEvent("TITLE")
If Not ge Is Nothing Then
  Set rectFrame = ge.Shape
  Set ge = Nothing
  
  'calc title box dimensions
  printer_frame_originX_pix = ConvFrameInch2PrinterPix(rectFrame.Left, X_AXIS)
  printer_frame_originY_pix = ConvFrameInch2PrinterPix(rectFrame.Top, Y_AXIS) * -1
  
  Dim fnt As New StdFont
  fnt.Name = "Arial"
  fnt.Size = CInt(rectFrame.Height * 72)  'page inches to font points
  fnt.Bold = True
  fnt.Underline = True
  Set rectFrame = Nothing

'  Printer.ScaleMode = vbInches
  Printer.CurrentX = printer_frame_originX_pix
  Printer.CurrentY = printer_frame_originY_pix
  Set Printer.Font = fnt

  Printer.Print frmView.txtTitle.Text

End If 'Not rectFrame Is Nothing