frmoptions.frm

这是我的一个课题：我省农业分布调查咨询系统。课题是和省农业厅合作的。源代码完整

VERSION 5.00
Begin VB.Form frmOptions 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "测量设置"
   ClientHeight    =   3105
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4680
   Icon            =   "frmOptions.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton btnDefaults 
      Caption         =   "默认"
      Height          =   375
      Left            =   3360
      TabIndex        =   15
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3360
      TabIndex        =   16
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   3360
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "打印和输出选项"
      Height          =   1335
      Left            =   120
      TabIndex        =   6
      Top             =   1680
      Width           =   4335
      Begin VB.ComboBox FormatCombo 
         Height          =   300
         ItemData        =   "frmOptions.frx":0442
         Left            =   1080
         List            =   "frmOptions.frx":045B
         Style           =   2  'Dropdown List
         TabIndex        =   12
         Top             =   960
         Width           =   3135
      End
      Begin VB.TextBox WidthText 
         Height          =   285
         Left            =   1080
         TabIndex        =   8
         Top             =   600
         Width           =   1935
      End
      Begin VB.TextBox HeightText 
         Height          =   285
         Left            =   1080
         TabIndex        =   7
         Top             =   240
         Width           =   1935
      End
      Begin VB.Label Label7 
         Caption         =   "英寸"
         Height          =   255
         Left            =   3120
         TabIndex        =   14
         Top             =   600
         Width           =   495
      End
      Begin VB.Label Label6 
         Caption         =   "英寸"
         Height          =   255
         Left            =   3120
         TabIndex        =   13
         Top             =   240
         Width           =   495
      End
      Begin VB.Label Label5 
         Caption         =   "输出样式:"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   1000
         Width           =   1095
      End
      Begin VB.Label Label4 
         Caption         =   "高度:"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   270
         Width           =   495
      End
      Begin VB.Label Label3 
         Caption         =   "宽度:"
         Height          =   255
         Left            =   120
         TabIndex        =   9
         Top             =   640
         Width           =   495
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "测量方式选项"
      Height          =   1455
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   3135
      Begin VB.ComboBox UnitCombo 
         Height          =   300
         ItemData        =   "frmOptions.frx":0508
         Left            =   600
         List            =   "frmOptions.frx":051E
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   960
         Width           =   2295
      End
      Begin VB.OptionButton PolyOption 
         Caption         =   "测量多点距离"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   600
         Width           =   2775
      End
      Begin VB.OptionButton LineOption 
         Caption         =   "测量两点间距"
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label Label1 
         Caption         =   "单位"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   1000
         Width           =   495
      End
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Private Sub btnDefaults_Click()
    PolyOption.Value = False
    LineOption.Value = True
    HeightText.Text = fMainForm.Map1.MapPaperHeight
    WidthText.Text = fMainForm.Map1.MapPaperWidth
    FormatCombo.ListIndex = 1
    UnitCombo.ListIndex = 0
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    If UsePolyRuler = True Then
        PolyOption.Value = True
    Else
        LineOption.Value = True
    End If
    
    fMainForm.Map1.PaperUnit = miPaperUnitInch
    ' Set the height and width text boxes to the correct values
    ' If the user hasn't set values yet, use the defaults (the Map size)
    If ExportHeight = 0 Or ExportWidth = 0 Then
        HeightText.Text = fMainForm.Map1.MapPaperHeight
        WidthText.Text = fMainForm.Map1.MapPaperWidth
    Else
        HeightText.Text = ExportHeight
        WidthText.Text = ExportWidth
    End If
    
    ' Set the format combo box to the correct format
    Select Case ExportFormat
        Case miFormatWMF
            FormatCombo.ListIndex = 0
        Case miFormatBMP
            FormatCombo.ListIndex = 1
        Case miFormatGIF
            FormatCombo.ListIndex = 2
        Case miFormatJPEG
            FormatCombo.ListIndex = 3
        Case miFormatTIF
            FormatCombo.ListIndex = 4
        Case miFormatPNG
            FormatCombo.ListIndex = 5
        Case miFormatPSD
            FormatCombo.ListIndex = 6
    End Select
    
    ' Set the unit combo box to the current unit
    ' Take a short cut: units # 0 through 13 correspond to combo list number
    If RulerUnit < 14 Then
        UnitCombo.ListIndex = 0
    Else
        Select Case RulerUnit
            Case miUnitLink
                UnitCombo.ListIndex = 14
            Case miUnitChain
                UnitCombo.ListIndex = 15
            Case miUnitRod
                UnitCombo.ListIndex = 16
        End Select
    End If
End Sub

Private Sub OKButton_Click()
    On Error GoTo Err
    ExportHeight = HeightText.Text
    ExportWidth = WidthText.Text
    If ExportHeight <= 0 Or ExportWidth <= 0 Then GoTo Err
    
    ' If the ExportHeight/Width are equal to the MapPaperHeight/Width, the
    ' user did not modify them from the defaults
    If ExportHeight = fMainForm.Map1.MapPaperHeight And ExportWidth = fMainForm.Map1.MapPaperWidth Then
        ExportHeight = 0#
        ExportWidth = 0#
    End If
    
    ' Set the UsePolyRuler boolean to the correct value
    If LineOption.Value = True Then
        UsePolyRuler = False
    Else ' PolyOption is pressed
        UsePolyRuler = True
    End If
    
    ' If the current tool is the ruler, change it to have the correct ruler behavior
    If UsePolyRuler = True And fMainForm.Map1.CurrentTool = RulerToolID Then
        fMainForm.Map1.CurrentTool = PolyRulerToolID
    End If
    If UsePolyRuler = False And fMainForm.Map1.CurrentTool = PolyRulerToolID Then
        fMainForm.Map1.CurrentTool = RulerToolID
    End If
    
    ' RulerUnitString is the plural name of the unit (e.g. "Feet", "Meters")
    ' RulerUnit is the index of the unit
    
    RulerUnitString = UnitCombo.Text
    Select Case UnitCombo.ListIndex
        Case 0 ' Meter
            RulerUnit = miUnitMeter
        Case 1 ' Kilometers
            RulerUnit = miUnitYard
        Case 2 ' Inches
            RulerUnit = miUnitMillimeter
        Case 3 ' Feet
            RulerUnit = miUnitMile
        Case 4 ' Yards
            RulerUnit = miUnitInch
        Case 5 ' Millimeters
            RulerUnit = miUnitFoot
    End Select
    
    Select Case FormatCombo.ListIndex
        Case 0 ' wmf
            ExportFormat = miFormatWMF
            ExportFormatString = "Windows Metafile"
            ExportFormatExt = "*.wmf"
        Case 1 ' bmp
            ExportFormat = miFormatBMP
            ExportFormatString = "Windows Bitmap"
            ExportFormatExt = "*.bmp"
        Case 2 ' gif
            ExportFormat = miFormatGIF
            ExportFormatString = "Graphics Interchange Format"
            ExportFormatExt = "*.gif"
        Case 3 ' jpeg
            ExportFormat = miFormatJPEG
            ExportFormatString = "JPEG"
            ExportFormatExt = "*.jpg"
        Case 4 ' TIFF
            ExportFormat = miFormatTIF
            ExportFormatString = "TIFF"
            ExportFormatExt = "*.tif"
        Case 5 ' PNG
            ExportFormat = miFormatPNG
            ExportFormatString = "Portable Network Graphics"
            ExportFormatExt = "*.png"
        Case 6 ' PSD
            ExportFormat = miFormatPSD
            ExportFormatString = "Photoshop File"
            ExportFormatExt = "*.psd"
    End Select
    Unload Me
    Exit Sub
Err:
    MsgBox "Please enter valid numbers for the height and width."
End Sub