📄 frmoption.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FrmOption
BorderStyle = 3 'Fixed Dialog
Caption = "选项"
ClientHeight = 5352
ClientLeft = 2568
ClientTop = 1500
ClientWidth = 6348
Icon = "FrmOption.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5352
ScaleWidth = 6348
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 3
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5688
TabIndex = 7
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample4
Caption = "示例 4"
Height = 1785
Left = 2100
TabIndex = 10
Top = 840
Width = 2055
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 2
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5688
TabIndex = 6
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample3
Caption = "示例 3"
Height = 1785
Left = 1545
TabIndex = 9
Top = 675
Width = 2055
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 1
Left = -20000
ScaleHeight = 3780
ScaleWidth = 5688
TabIndex = 5
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame fraSample2
Caption = "示例 2"
Height = 1785
Left = 645
TabIndex = 8
Top = 300
Width = 2055
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 0
Left = 240
ScaleHeight = 3780
ScaleWidth = 5688
TabIndex = 3
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame FraSelectPort
Caption = "选择串口（RS232口）"
Height = 2748
Left = 840
TabIndex = 4
Top = 720
Width = 3852
Begin VB.OptionButton OptionCom8
Caption = "Com8"
Height = 252
Left = 2400
TabIndex = 19
Top = 2160
Width = 852
End
Begin VB.OptionButton OptionCom7
Caption = "Com7"
Height = 372
Left = 2400
TabIndex = 18
Top = 1560
Width = 732
End
Begin VB.OptionButton OptionCom6
Caption = "Com6"
Height = 252
Left = 2400
TabIndex = 17
Top = 1080
Width = 732
End
Begin VB.OptionButton OptionCom5
Caption = "Com5"
Height = 252
Left = 2400
TabIndex = 16
Top = 600
Width = 1092
End
Begin VB.OptionButton OptionCom4
Caption = "Com4"
Height = 492
Left = 600
TabIndex = 15
Top = 2040
Width = 1452
End
Begin VB.OptionButton OptionCom3
Caption = "Com3"
Height = 372
Left = 600
TabIndex = 13
Top = 1560
Width = 2172
End
Begin VB.OptionButton OptionCom2
Caption = "Com2"
Height = 372
Left = 600
TabIndex = 12
Top = 1080
Width = 2052
End
Begin VB.OptionButton OptionCom1
Caption = "Com1 "
Height = 252
Left = 600
TabIndex = 11
Top = 600
Width = 2292
End
End
End
Begin VB.CommandButton CmdApply
Caption = "应用"
Height = 375
Left = 4920
TabIndex = 2
Top = 4680
Width = 1095
End
Begin VB.CommandButton CmdCancel
Cancel = -1 'True
Caption = "取消"
Height = 375
Left = 3720
TabIndex = 1
Top = 4680
Width = 1095
End
Begin VB.CommandButton CmdOK
Caption = "确定"
Height = 375
Left = 2490
TabIndex = 0
Top = 4680
Width = 1095
End
Begin MSComctlLib.TabStrip tbsOptions
Height = 4245
Left = 105
TabIndex = 14
Top = 120
Width = 5895
_ExtentX = 10393
_ExtentY = 7493
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 1
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "设置串口"
Key = "Group1"
Object.ToolTipText = "设置编程器使用的串行端口号"
ImageVarType = 2
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Attribute VB_Name = "FrmOption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CommPorts(8) As Boolean
Public Sub FindPorts()
'Find Comm ports by trying to open each.
'Each port must support the current settings (bit rate, etc.).
Dim Count As Integer
Dim NumberOfPorts As Integer
Dim SavedPortNumber As Integer
Dim SaveCurrentPort As Boolean
On Error Resume Next
SaveCurrentPort = False
NumberOfPorts = 0
'If a port is already open, reopen it on exiting.
If FrmMain.MSComm1.PortOpen = True Then
FrmMain.MSComm1.PortOpen = False
SavedPortNumber = FrmMain.MSComm1.CommPort
SaveCurrentPort = True
End If
For Count = 1 To 8 Step 1
FrmMain.MSComm1.CommPort = Count
FrmMain.MSComm1.PortOpen = True
If Err.Number = 8005 Then
'The port is already open
'The port exists, so add it to the list.
NumberOfPorts = NumberOfPorts + 1
CommPorts(Count) = False
ElseIf FrmMain.MSComm1.PortOpen = True Then
'If the port opens, it exists.
'Close it and add to the list.
FrmMain.MSComm1.PortOpen = False
NumberOfPorts = NumberOfPorts + 1
CommPorts(Count) = True
End If
Err.Clear
Next Count
'Disable the error handler
On Error GoTo 0
If SaveCurrentPort = True Then
FrmMain.MSComm1.CommPort = SavedPortNumber
If FrmMain.MSComm1.PortOpen = False Then
FrmMain.MSComm1.PortOpen = True
End If
End If
If (CommPorts(1) = True) Then
OptionCom1.Enabled = True
End If
If (CommPorts(2)) Then
OptionCom2.Enabled = True
End If
If (CommPorts(3)) Then
OptionCom3.Enabled = True
End If
If (CommPorts(4)) Then
OptionCom4.Enabled = True
End If
If (CommPorts(5)) Then
OptionCom5.Enabled = True
End If
If (CommPorts(6)) Then
OptionCom6.Enabled = True
End If
If (CommPorts(7)) Then
OptionCom7.Enabled = True
End If
If (CommPorts(8)) Then
OptionCom8.Enabled = True
End If
End Sub
Private Sub cmdApply_Click()
'MsgBox "在这里设置代码来设置选项 w/o 关闭对话框!"
Call cmdOK_Click
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim ucSelectComPortNumber As Byte '串口号
Dim bReturnValue As Boolean
'MsgBox "在这里放置代码来设置选项并且关闭对话框!"
If (OptionCom1.Value) Then
ucSelectComPortNumber = 1
ElseIf (OptionCom2.Value) Then
ucSelectComPortNumber = 2
ElseIf (OptionCom3.Value) Then
ucSelectComPortNumber = 3
ElseIf (OptionCom4.Value) Then
ucSelectComPortNumber = 4
ElseIf (OptionCom5.Value) Then
ucSelectComPortNumber = 5
ElseIf (OptionCom6.Value) Then
ucSelectComPortNumber = 6
ElseIf (OptionCom7.Value) Then
ucSelectComPortNumber = 7
ElseIf (OptionCom8.Value) Then
ucSelectComPortNumber = 8
Else
End If
If ((ucSelectComPortNumber > 0) And (ucSelectComPortNumber < 9)) Then
bReturnValue = SetComPortNumber(ucSelectComPortNumber)
Else
Unload Me
End If
If (bReturnValue) Then
Current_PGMSysInformation.PGMSysInfo_CommPortNumber = ucSelectComPortNumber
Call FrmMain.RefreshPGMSysInfo
Unload Me
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Integer
'处理 ctrl+tab 键来移动到下一个选项
If Shift = vbCtrlMask And KeyCode = vbKeyTab Then
i = tbsOptions.SelectedItem.Index
If i = tbsOptions.Tabs.Count Then
'已到达最后的选项,转回到选项 1
Set tbsOptions.SelectedItem = tbsOptions.Tabs(1)
Else
'递增选项
Set tbsOptions.SelectedItem = tbsOptions.Tabs(i + 1)
End If
End If
End Sub
Private Sub Form_Load()
'置中窗体
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
OptionCom1.Enabled = False
OptionCom2.Enabled = False
OptionCom3.Enabled = False
OptionCom4.Enabled = False
OptionCom5.Enabled = False
OptionCom6.Enabled = False
OptionCom7.Enabled = False
OptionCom8.Enabled = False
Call FindPorts
If (ucCurrentComPortNumber = 1) Then
OptionCom1.Value = True
ElseIf (ucCurrentComPortNumber = 2) Then
OptionCom2.Value = True
ElseIf (ucCurrentComPortNumber = 3) Then
OptionCom3.Value = True
ElseIf (ucCurrentComPortNumber = 4) Then
OptionCom4.Value = True
ElseIf (ucCurrentComPortNumber = 5) Then
OptionCom5.Value = True
ElseIf (ucCurrentComPortNumber = 6) Then
OptionCom6.Value = True
ElseIf (ucCurrentComPortNumber = 7) Then
OptionCom7.Value = True
ElseIf (ucCurrentComPortNumber = 8) Then
OptionCom8.Value = True
Else
End If
End Sub
Private Sub tbsOptions_Click()
Dim i As Integer
'显示并使选项的控件可用
'并且隐藏使其他被禁用
For i = 0 To tbsOptions.Tabs.Count - 1
If i = tbsOptions.SelectedItem.Index - 1 Then
picOptions(i).Left = 210
picOptions(i).Enabled = True
Else
picOptions(i).Left = -20000
picOptions(i).Enabled = False
End If
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -