📄 frmoptions.frm
字号:
Left = 600
TabIndex = 12
Text = "2"
Top = 600
Width = 495
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "连接"
Height = 180
Left = 120
TabIndex = 32
Top = 990
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "范围"
Height = 180
Left = 120
TabIndex = 17
Top = 285
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "次数"
Height = 180
Left = 120
TabIndex = 16
Top = 630
Width = 360
End
End
End
Begin VB.PictureBox picOptions
BorderStyle = 0 'None
Height = 3780
Index = 0
Left = 210
ScaleHeight = 3840.968
ScaleMode = 0 'User
ScaleWidth = 5745.64
TabIndex = 2
TabStop = 0 'False
Top = 480
Width = 5685
Begin VB.Frame frameCom
Caption = "串口设置"
Height = 975
Left = 480
TabIndex = 8
Top = 720
Width = 2775
Begin VB.ComboBox cbxBPS
Height = 300
ItemData = "frmOptions.frx":0013
Left = 1065
List = "frmOptions.frx":002C
Style = 2 'Dropdown List
TabIndex = 46
Top = 585
Width = 1215
End
Begin VB.ComboBox cbxPort
Height = 300
ItemData = "frmOptions.frx":0059
Left = 1065
List = "frmOptions.frx":0069
Style = 2 'Dropdown List
TabIndex = 45
Top = 195
Width = 1215
End
Begin VB.Label Label2
Caption = "波特率"
Height = 255
Left = 120
TabIndex = 10
Top = 615
Width = 615
End
Begin VB.Label Label1
Caption = "串口号"
Height = 255
Left = 120
TabIndex = 9
Top = 270
Width = 615
End
End
End
Begin MSComctlLib.TabStrip tbsOptions
Height = 4245
Left = 105
TabIndex = 0
Top = 120
Width = 5895
_ExtentX = 10398
_ExtentY = 7488
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 4
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "组 1"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "组 2"
ImageVarType = 2
EndProperty
BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "组 3"
ImageVarType = 2
EndProperty
BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "组 4"
ImageVarType = 2
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog CommonDialogColor
Left = 480
Top = 4440
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdApply_Click()
'ToDo: 添加 'cmdApply_Click' 代码
Call Write_Setting
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
'ToDo: 添加 'cmdOK_Click' 代码
Call Write_Setting
Unload Me
End Sub
Private Sub Form_Load()
Call Read_Setting
End Sub
'失去焦点时验证是否是数
Private Function TextNumericTest(txtCtrol As TextBox) As Boolean
Dim icancel As Boolean
If IsNumeric(txtCtrol.Text) Then
icancel = False
Else
icancel = True
txtCtrol.SelStart = 0
txtCtrol.SelLength = Len(txtCtrol.Text)
End If
TextNumericTest = icancel
End Function
'失去焦点时验证是否是数
Private Sub txtSet_Validate(Index As Integer, Cancel As Boolean)
Cancel = TextNumericTest(txtSet(Index))
End Sub
Private Sub VSSet_Change(Index As Integer)
txtSet(Index).Text = VSSet(Index).Max - VSSet(Index).Value
End Sub
'修改颜色
Private Sub lblColor_DblClick(Index As Integer)
With CommonDialogColor
On Error Resume Next
.CancelError = True
.Flags = cdlCCRGBInit
.ShowColor
If Err = cdlCancel Then Exit Sub
lblColor(Index).ForeColor = .color
End With
End Sub
Private Sub cmdColor_Click()
With CommonDialogColor
On Error Resume Next
.CancelError = True
.Flags = cdlCCRGBInit
.ShowColor
If Err = cdlCancel Then Exit Sub
txtTitle.ForeColor = .color
End With
End Sub
Private Sub cmdFont_Click()
With CommonDialogFont
On Error Resume Next
'当用户按下“取消”按钮，返回一个错误信息，这样使我们可以对其进行控制
.CancelError = True
'此句必须要
.Flags = cdlCFBoth + cdlCFEffects
'显示“字体”对话框
.ShowFont
'出现“取消”错误时，跳出
If Err = cdlCancel Then
Exit Sub
Else
'将TextBox的字体属性根据“字体”对话框的变化作相应设置
'如果用户选择了字体才将字体改变，避免字体为空的错误
If .FontName <> "" Then
txtTitle.FontName = .FontName
End If
txtTitle.FontSize = .FontSize
txtTitle.FontBold = .FontBold
txtTitle.FontItalic = .FontItalic
txtTitle.FontStrikethru = .FontStrikethru
txtTitle.FontUnderline = .FontUnderline
End If
End With
End Sub
Private Sub Read_Setting()
Dim i As Integer
With MainSetting
'
tbsOptions.Tabs.Item(1).Caption = "通讯"
cbxPort.Text = .ComPort
cbxBPS.Text = .ComSeting
'
tbsOptions.Tabs.Item(2).Caption = "手绘"
txtSet(0).Text = .picHandSmoothScale
txtSet(1).Text = .picHandSmoothTimes
txtSet(2).Text = .picModifySmoothScale
txtSet(3).Text = .picModifySmoothTimes
txtSet(4).Text = .picModifyMarginLeft
txtSet(5).Text = .picModifyMarginRight
txtSet(6).Text = .picModifyScale
tbsOptions.Tabs.Item(3).Caption = "显示"
lblColor(0).ForeColor = .ColorLeftSpeed
lblColor(1).ForeColor = .ColorRightSpeed
lblColor(2).ForeColor = .ColorHandDraw
lblColor(3).ForeColor = frmMain.BackColor
tbsOptions.Tabs.Item(4).Caption = "其他"
End With
For i = 0 To txtSet.Count - 1
VSSet(i).Value = VSSet(i).Max - txtSet(i).Text
Next
With frmMain.lblName
txtTitle.FontSize = .FontSize
txtTitle.FontBold = .FontBold
txtTitle.FontItalic = .FontItalic
txtTitle.FontStrikethru = .FontStrikethru
txtTitle.FontUnderline = .FontUnderline
txtTitle.ForeColor = .ForeColor
txtTitle.Text = .Caption
End With
End Sub
Private Sub Write_Setting()
With MainSetting
'
'tbsOptions.Tabs.Item(1).Caption = "通讯"
.ComPort = cbxPort.Text
.ComSeting = cbxBPS.Text
'
'tbsOptions.Tabs.Item(2).Caption = "手绘"
.picHandSmoothScale = txtSet(0).Text
.picHandSmoothTimes = txtSet(1).Text
.picModifySmoothScale = txtSet(2).Text
.picModifySmoothTimes = txtSet(3).Text
.picModifyMarginLeft = txtSet(4).Text
.picModifyMarginRight = txtSet(5).Text
.picModifyScale = txtSet(6).Text
'tbsOptions.Tabs.Item(3).Caption = "显示"
.ColorLeftSpeed = lblColor(0).ForeColor
.ColorRightSpeed = lblColor(1).ForeColor
.ColorHandDraw = lblColor(2).ForeColor
frmMain.BackColor = lblColor(3).ForeColor
Call frmMain.SetBackColor
tbsOptions.Tabs.Item(4).Caption = "其他"
End With
Call frmMain.cmdRefresh_Click
With frmMain.lblName
.FontSize = txtTitle.FontSize
.FontBold = txtTitle.FontBold
.FontItalic = txtTitle.FontItalic
.FontStrikethru = txtTitle.FontStrikethru
.FontUnderline = txtTitle.FontUnderline
.ForeColor = txtTitle.ForeColor
.Caption = txtTitle.Text
End With
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Integer
i = tbsOptions.SelectedItem.Index
'处理 ctrl+tab 移到下一 tab
If (Shift And 3) = 2 And KeyCode = vbKeyTab Then
If i = tbsOptions.Tabs.Count Then
'已是最后的 tab 所以需要折回到 tab 1
Set tbsOptions.SelectedItem = tbsOptions.Tabs(1)
Else
'递增 tab
Set tbsOptions.SelectedItem = tbsOptions.Tabs(i + 1)
End If
ElseIf (Shift And 3) = 3 And KeyCode = vbKeyTab Then
If i = 1 Then
'已是最后的 tab 所以需要折回到 tab 1
Set tbsOptions.SelectedItem = tbsOptions.Tabs(tbsOptions.Tabs.Count)
Else
'递增 tab
Set tbsOptions.SelectedItem = tbsOptions.Tabs(i - 1)
End If
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 + -