📄 frmoptions.frm
字号:
VERSION 5.00
Begin VB.Form frmOptions
BorderStyle = 3 'Fixed Dialog
Caption = "Options"
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
Begin VB.CommandButton btnDefaults
Caption = "Defaults"
Height = 375
Left = 3360
TabIndex = 15
Top = 1200
Width = 1215
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Height = 375
Left = 3360
TabIndex = 16
Top = 720
Width = 1215
End
Begin VB.CommandButton OKButton
Caption = "OK"
Default = -1 'True
Height = 375
Left = 3360
TabIndex = 0
Top = 240
Width = 1215
End
Begin VB.Frame Frame2
Caption = "Printing and Exporting Options"
Height = 1335
Left = 120
TabIndex = 6
Top = 1680
Width = 4335
Begin VB.ComboBox FormatCombo
Height = 315
ItemData = "frmOptions.frx":0442
Left = 1320
List = "frmOptions.frx":045B
Style = 2 'Dropdown List
TabIndex = 12
Top = 960
Width = 2895
End
Begin VB.TextBox WidthText
Height = 285
Left = 1320
TabIndex = 8
Top = 600
Width = 1695
End
Begin VB.TextBox HeightText
Height = 285
Left = 1320
TabIndex = 7
Top = 240
Width = 1695
End
Begin VB.Label Label7
Caption = "inches"
Height = 255
Left = 3120
TabIndex = 14
Top = 600
Width = 495
End
Begin VB.Label Label6
Caption = "inches"
Height = 255
Left = 3120
TabIndex = 13
Top = 240
Width = 495
End
Begin VB.Label Label5
Caption = "Export Format:"
Height = 255
Left = 120
TabIndex = 11
Top = 1000
Width = 1095
End
Begin VB.Label Label4
Caption = "Height:"
Height = 255
Left = 120
TabIndex = 10
Top = 270
Width = 495
End
Begin VB.Label Label3
Caption = "Width:"
Height = 255
Left = 120
TabIndex = 9
Top = 640
Width = 495
End
End
Begin VB.Frame Frame1
Caption = "Ruler Options"
Height = 1455
Left = 120
TabIndex = 1
Top = 120
Width = 3135
Begin VB.ComboBox UnitCombo
Height = 315
ItemData = "frmOptions.frx":0508
Left = 600
List = "frmOptions.frx":0536
Style = 2 'Dropdown List
TabIndex = 4
Top = 960
Width = 2295
End
Begin VB.OptionButton PolyOption
Caption = "Polygon Style Ruler (Many Points)"
Height = 255
Left = 120
TabIndex = 2
Top = 600
Width = 2775
End
Begin VB.OptionButton LineOption
Caption = "Line Style Ruler (Two Points)"
Height = 255
Left = 120
TabIndex = 3
Top = 240
Width = 2415
End
Begin VB.Label Label1
Caption = "Units:"
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()
' Set the controls to the correct values
' UsePolyRuler is defined in Module1.bas. It is true if the Ruler tool
' should have a polygon type behavior, and false if the Ruler tool
' should measure the distance between just two points
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 = RulerUnit
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()
' Update the Height and Width values in options.
' An error is raised if the values are invalid (non-numeric)
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 ' Miles
RulerUnit = miUnitMile
Case 1 ' Kilometers
RulerUnit = miUnitKilometer
Case 2 ' Inches
RulerUnit = miUnitInch
Case 3 ' Feet
RulerUnit = miUnitFoot
Case 4 ' Yards
RulerUnit = miUnitYard
Case 5 ' Millimeters
RulerUnit = miUnitMillimeter
Case 6 ' Centimeters
RulerUnit = miUnitCentimeter
Case 7 ' Meters
RulerUnit = miUnitMeter
Case 8 ' Survey Feet
RulerUnit = miUnitSurveyFoot
Case 9 ' Nautical Miles
RulerUnit = miUnitNauticalMile
Case 10 ' Twips
RulerUnit = miUnitTwip
Case 11 ' Points
RulerUnit = miUnitPoint
Case 12 ' Picas
RulerUnit = miUnitPica
Case 13 ' Degrees
RulerUnit = miUnitDegree
Case 14 ' Links
RulerUnit = miUnitLink
Case 15 ' Chains
RulerUnit = miUnitChain
Case 16 ' Rods
RulerUnit = miUnitRod
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -