📄 form3.frm
字号:
End
Begin VB.Label Label3
Caption = "x2:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 270
TabIndex = 9
Top = 1515
Width = 915
End
Begin VB.Label Label4
Caption = "y2:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 270
TabIndex = 8
Top = 1815
Width = 915
End
Begin VB.Label Label6
BorderStyle = 1 'Fixed Single
Caption = " 右上角和左下角坐标值："
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 90
TabIndex = 7
Top = 180
Width = 2985
End
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消(&C)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5625
TabIndex = 1
Top = 5400
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "确定(&K)"
Default = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4125
TabIndex = 0
Top = 5400
Width = 1095
End
End
Attribute VB_Name = "frmCtrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
'确认参数设置
Dim i As Long
On Error GoTo aaa:
PSeData = 0
Call SeDataIN
SeData(0, 0) = 1
SeData(0, 1) = Val(Me.Text1.Text)
SeData(0, 2) = Val(Me.Text2.Text)
SeData(0, 3) = Val(Me.Text3.Text)
SeData(0, 4) = Val(Me.Text4.Text)
If Me.Option2.Value = True Then
SeData(0, 5) = 1
Else
SeData(0, 5) = 0
End If
SeData(0, 6) = Val(Me.Text13.Text)
SeData(0, 7) = Val(Me.Text15.Text)
SeData(0, 8) = Val(Me.Text16.Text)
SeData(0, 9) = Val(Me.Text29.Text)
SeData(0, 10) = Val(Me.Text30.Text)
SeData(0, 11) = Val(Me.Text31.Text)
SeData(0, 12) = Val(Me.Text17.Text)
If Me.Option4.Value = True Then
SeData(0, 13) = 1
ElseIf Me.Option5.Value = True Then
SeData(0, 13) = 2
ElseIf Me.Option1.Value = True Then
SeData(0, 13) = 3
End If
SeData(0, 14) = Val(Me.Text14.Text)
SeData(0, 15) = Val(Me.Text21.Text)
'SeData(0, 16) = Val(Me.Text22.Text)
SeData(0, 16) = Val(Me.Combo1.ListIndex) * 1 _
+ Val(Me.Combo2.ListIndex) * 100 _
+ Val(Me.Combo3.ListIndex) * 10000 _
+ Val(Me.Combo4.ListIndex) * 1000000
SeData(0, 17) = Val(Me.Text23.Text)
SeData(0, 18) = Val(Me.Text24.Text)
For i = 0 To 31
If Me.OptionZheSe(i).Value = True Then SeData(0, 19) = i
Next i
'===
frmCtrl.Hide
DoEvents
Call frmMain.Command1_Click
DoEvents
Exit Sub
aaa:
Call SeDataOUT
End Sub
Private Sub Command2_Click()
'取消参数设置
frmCtrl.Hide
End Sub
Private Sub Command3_Click()
'一窗口显示为准保存设置好的参数，保存为 *.HTXT 文件
Dim x1 As Double, i As Long
CommonDialogSave.fileName = ""
CommonDialogSave.ShowSave
If Me.CommonDialogSave.fileName = "" Then Exit Sub
If (Dir(CommonDialogSave.fileName)) <> "" Then
If MsgBox(" 文件已经存在，要覆盖吗？ ", vbOKCancel, "文件重名") <> vbOK Then Exit Sub
End If
SeData(-1, 0) = 1
SeData(-1, 1) = Val(Me.Text1.Text) '坐标 X1
SeData(-1, 2) = Val(Me.Text2.Text) '坐标 X1
SeData(-1, 3) = Val(Me.Text3.Text) '坐标 X1
SeData(-1, 4) = Val(Me.Text4.Text)
'If Me.Option2.Value = True Then
' SeData(-1, 5) = 1
'Else
SeData(-1, 5) = 0
'End If
SeData(-1, 6) = Val(Me.Text13.Text)
SeData(-1, 7) = Val(Me.Text15.Text)
SeData(-1, 8) = Val(Me.Text16.Text)
SeData(-1, 9) = Val(Me.Text29.Text)
SeData(-1, 10) = Val(Me.Text30.Text)
SeData(-1, 11) = Val(Me.Text31.Text)
SeData(-1, 12) = Val(Me.Text17.Text)
If Me.Option4.Value = True Then
SeData(-1, 13) = 1
ElseIf Me.Option5.Value = True Then
SeData(-1, 13) = 2
ElseIf Me.Option1.Value = True Then
SeData(-1, 13) = 3
End If
SeData(-1, 14) = Val(Me.Text14.Text)
SeData(-1, 15) = Val(Me.Text21.Text)
'SeData(-1, 16) = Val(Me.Text22.Text)
SeData(-1, 16) = Val(Me.Combo1.ListIndex) * 1 _
+ Val(Me.Combo2.ListIndex) * 100 _
+ Val(Me.Combo3.ListIndex) * 10000 _
+ Val(Me.Combo4.ListIndex) * 1000000
SeData(-1, 17) = Val(Me.Text23.Text)
SeData(-1, 18) = Val(Me.Text24.Text)
For i = 0 To 29
If Me.OptionZheSe(i).Value = True Then SeData(-1, 19) = i
Next i
On Error GoTo aaa:
Open CommonDialogSave.fileName For Output As #1
For i = 0 To 19
Write #1, SeData(-1, i)
Next i
Close #1
Exit Sub
aaa:
Close #1
MsgBox " 保存文件时出错 (或者其它错误) ！ ", vbOKOnly, " 错误"
End Sub
Public Sub Command4_Click()
'载入参数文件并显示
Dim x1 As Double, i As Long
On Error GoTo aaa:
CommonDialogOpen.fileName = ""
CommonDialogOpen.ShowOpen
If Me.CommonDialogOpen.fileName = "" Then Exit Sub
Open CommonDialogOpen.fileName For Input As #1
For i = 0 To 19
Input #1, x1
SeData(-1, i) = x1
Next i
Close #1
Me.Text1.Text = Str(SeData(-1, 1))
Me.Text2.Text = Str(SeData(-1, 2))
Me.Text3.Text = Str(SeData(-1, 3))
Me.Text4.Text = Str(SeData(-1, 4))
'If SeData(-1, 5) = 1 Then
' Me.Option2.Value = True
'Else
Me.Option3.Value = True
'End If
Me.Text13.Text = Str(SeData(-1, 6))
Me.Text15.Text = Str(SeData(-1, 7))
Me.Text16.Text = Str(SeData(-1, 8))
Me.Text29.Text = Str(SeData(-1, 9))
Me.Text30.Text = Str(SeData(-1, 10))
Me.Text31.Text = Str(SeData(-1, 11))
Me.Text17.Text = Str(SeData(-1, 12))
If SeData(-1, 13) = 1 Then
Me.Option4.Value = True
ElseIf SeData(-1, 13) = 2 Then
Me.Option5.Value = True
ElseIf SeData(-1, 13) = 3 Then
Me.Option1.Value = True
End If
Me.Text14.Text = Str(SeData(-1, 14))
Me.Text21.Text = Str(SeData(-1, 15))
'Me.Text22.Text = Str(SeData(-1, 16))
Me.Combo1.ListIndex = Int(SeData(-1, 16) / 1) Mod 100#
Me.Combo2.ListIndex = Int(SeData(-1, 16) / 100) Mod 100#
Me.Combo3.ListIndex = Int(SeData(-1, 16) / 10000) Mod 100#
Me.Combo4.ListIndex = Int(SeData(-1, 16) / 1000000) Mod 100#
Me.Text23.Text = Str(SeData(-1, 17))
Me.Text24.Text = Str(SeData(-1, 18))
Me.OptionZheSe(SeData(-1, 19)).Value = True
Exit Sub
aaa:
Close #1
MsgBox " 打开文件时出错 (或者其它错误) ！ ", vbOKOnly, " 错误"
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'用户按Enter键时的处理
If KeyCode = 13 Then
Call Command1_Click
End If
End Sub
Private Sub HScroll1_Change()
If Me.HScroll1.Value <> Val(Me.Text13.Text) Then
Me.Text13.Text = Str(Me.HScroll1.Value)
End If
End Sub
Private Sub HScroll1_Scroll()
If Me.HScroll1.Value <> Val(Me.Text13.Text) Then
Me.Text13.Text = Str(Me.HScroll1.Value)
End If
End Sub
Private Sub HScroll2_Change()
If Me.HScroll2.Value <> Val(Me.Text15.Text) Then
Me.Text15.Text = Str(Me.HScroll2.Value)
End If
End Sub
Private Sub HScroll2_Scroll()
If Me.HScroll2.Value <> Val(Me.Text15.Text) Then
Me.Text15.Text = Str(Me.HScroll2.Value)
End If
End Sub
Private Sub HScroll3_Change()
If Me.HScroll3.Value <> Val(Me.Text16.Text) Then
Me.Text16.Text = Str(Me.HScroll3.Value)
End If
End Sub
Private Sub HScroll3_Scroll()
If Me.HScroll3.Value <> Val(Me.Text16.Text) Then
Me.Text16.Text = Str(Me.HScroll3.Value)
End If
End Sub
Private Sub Option1_Click()
'界面处理
Me.Text14.Enabled = False
Me.Text21.Enabled = True
Me.Text23.Enabled = True
Me.Text24.Enabled = True
Me.Label12.Enabled = True
Me.Label15.Enabled = True
Me.Label16.Enabled = True
End Sub
Private Sub Option2_Click()
'界面处理
Me.HScroll1.Enabled = False
Me.HScroll2.Enabled = False
Me.HScroll3.Enabled = False
Me.Text13.Enabled = False
Me.Text15.Enabled = False
Me.Text16.Enabled = False
End Sub
Private Sub Option3_Click()
'界面处理
Me.HScroll1.Enabled = True
Me.HScroll2.Enabled = True
Me.HScroll3.Enabled = True
Me.Text13.Enabled = True
Me.Text15.Enabled = True
Me.Text16.Enabled = True
End Sub
Private Sub Option4_Click()
'界面处理
Me.Text14.Enabled = True
Me.Text21.Enabled = False
Me.Text23.Enabled = False
Me.Text24.Enabled = False
Me.Label12.Enabled = False
Me.Label15.Enabled = False
Me.Label16.Enabled = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -