📄 clipregion.frm
字号:
VERSION 5.00
Begin VB.Form ClipRegion
BorderStyle = 3 'Fixed Dialog
Caption = "矩形区域裁剪"
ClientHeight = 4932
ClientLeft = 36
ClientTop = 324
ClientWidth = 5280
BeginProperty Font
Name = "宋体"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4932
ScaleWidth = 5280
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox PictureMapPar
BackColor = &H80000001&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.6
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4932
Left = 0
MousePointer = 1 'Arrow
ScaleHeight = 407
ScaleMode = 3 'Pixel
ScaleWidth = 437
TabIndex = 0
Top = 0
Width = 5292
Begin VB.CheckBox Check2
Alignment = 1 'Right Justify
Caption = "打√中央经线为直线(无投影)"
Height = 372
Left = 120
TabIndex = 14
Top = 2640
Value = 1 'Checked
Width = 4932
End
Begin VB.TextBox TextLatWidth
Height = 372
Left = 1440
MaxLength = 3
TabIndex = 13
Text = "Text1"
Top = 1920
Width = 3612
End
Begin VB.TextBox TextLonWidth
Height = 372
Left = 1440
MaxLength = 3
TabIndex = 12
Text = "Text1"
Top = 1320
Width = 3612
End
Begin VB.CheckBox Check1
Alignment = 1 'Right Justify
Caption = "打√输入经纬度窗长，否则输入经纬度范围"
Height = 372
Left = 120
TabIndex = 11
Top = 720
Value = 1 'Checked
Width = 4932
End
Begin VB.ComboBox ComboDW
Height = 312
Left = 1440
TabIndex = 10
Text = "Combo1"
Top = 120
Width = 3612
End
Begin VB.CommandButton CommandExit
Caption = "放弃"
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3600
MousePointer = 1 'Arrow
TabIndex = 6
Top = 3900
Width = 1452
End
Begin VB.CommandButton CommandOK
Caption = "确定"
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
MousePointer = 1 'Arrow
TabIndex = 5
Top = 3900
Width = 1452
End
Begin VB.TextBox TextLonMax
Height = 360
Left = 3120
MaxLength = 8
MousePointer = 3 'I-Beam
TabIndex = 4
Top = 1320
Visible = 0 'False
Width = 1692
End
Begin VB.TextBox TextLonMin
Height = 360
Left = 1440
MaxLength = 8
MousePointer = 3 'I-Beam
TabIndex = 3
Top = 1320
Visible = 0 'False
Width = 1692
End
Begin VB.TextBox TextLatMax
Height = 360
Left = 3120
MaxLength = 7
MousePointer = 3 'I-Beam
TabIndex = 2
Top = 1920
Visible = 0 'False
Width = 1692
End
Begin VB.TextBox TextLatMin
Height = 360
Left = 1440
MaxLength = 7
MousePointer = 3 'I-Beam
TabIndex = 1
Top = 1920
Visible = 0 'False
Width = 1692
End
Begin VB.Label LabelDW
Alignment = 2 'Center
Caption = "选择单位"
Height = 348
Left = 120
TabIndex = 9
Top = 120
Width = 1332
End
Begin VB.Label LabelLon
Alignment = 2 'Center
Caption = "经度窗长(度)"
Height = 348
Left = 120
TabIndex = 8
Top = 1320
Width = 1332
End
Begin VB.Label LabelLat
Alignment = 2 'Center
Caption = "纬度窗长(度)"
Height = 348
Left = 120
TabIndex = 7
Top = 1920
Width = 1332
End
End
End
Attribute VB_Name = "ClipRegion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim LatMin(0 To 200) As Double, LatMax(0 To 200) As Double, LonMin(0 To 200) As Double, LonMax(0 To 200) As Double
Private Sub Check1_Click()
If (Check1.Value = 1) Then
LabelLon.Caption = "经度窗长(度)"
LabelLat.Caption = "纬度窗长(度)"
TextLonWidth.Visible = True
TextLonMin.Visible = False
TextLonMax.Visible = False
TextLatWidth.Visible = True
TextLatMin.Visible = False
TextLatMax.Visible = False
Else
LabelLon.Caption = "经度范围(度)"
LabelLat.Caption = "纬度范围(度)"
TextLonWidth.Visible = False
TextLonMin.Visible = True
TextLonMax.Visible = True
TextLatWidth.Visible = False
TextLatMin.Visible = True
TextLatMax.Visible = True
End If
End Sub
Private Sub ComboDW_Click()
Dim I As Integer
I = ComboDW.ListIndex
TextLonMin.Text = Format(LonMin(I), "###0.0000")
TextLonMax.Text = Format(LonMax(I), "###0.0000")
TextLatMin.Text = Format(LatMin(I), "###0.0000")
TextLatMax.Text = Format(LatMax(I), "###0.0000")
End Sub
Private Sub CommandExit_Click()
bOKCancel = False
Unload Me
End Sub
Private Sub CommandOK_Click()
Dim LatDelta As Double, LonDelta As Double
If (Check1.Value = 0) Then
ClipLonMin = Val(TextLonMin.Text)
ClipLonMax = Val(TextLonMax.Text)
ClipLatMin = Val(TextLatMin.Text)
ClipLatMax = Val(TextLatMax.Text)
Else
LonDelta = Val(TextLonWidth.Text)
LatDelta = Val(TextLatWidth.Text)
If (LonDelta < 0.1) Then LonDelta = 1
If (LatDelta < 0.1) Then LatDelta = 1
ClipLonMin = ClipLon0 - LonDelta / 2
ClipLonMax = ClipLon0 + LonDelta / 2
ClipLatMin = ClipLat0 - LatDelta / 2
ClipLatMax = ClipLat0 + LatDelta / 2
End If
MidLonVer = Check2.Value
bOKCancel = True
Unload Me
End Sub
Private Sub Form_Load()
Dim LineTemp As String
Dim I As Integer, J As Integer
ComboDW.Clear
ClipRegion.Caption = "矩形区域裁剪"
LabelDW.Caption = "选择单位"
Check1.Enabled = False
Check1.Value = 0
ComboDW.Enabled = True
Open TheMapInfoPath + "矩形区域裁剪.ini" For Input As #1
J = -1
Do While Not EOF(1)
Line Input #1, LineTemp
If (Len(LineTemp) > 21) Then
I = InStr(LineTemp, " ")
J = J + 1
ComboDW.AddItem Format(J + 1, "000 ") + Left(LineTemp, I - 1)
LineTemp = Trim(Right(LineTemp, Len(LineTemp) - I))
LatMin(J) = Val(Left(LineTemp, 2)) + Val(Mid(LineTemp, 3, 2)) / 60#
LatMax(J) = Val(Mid(LineTemp, 6, 2)) + Val(Mid(LineTemp, 8, 2)) / 60#
LonMin(J) = Val(Mid(LineTemp, 11, 3)) + Val(Mid(LineTemp, 14, 2)) / 60#
LonMax(J) = Val(Mid(LineTemp, 17, 3)) + Val(Mid(LineTemp, 20, 2)) / 60#
End If
Loop
Close (1)
Check2.Value = 0
Check2.Enabled = True
ComboDW.ListIndex = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -