📄 frmmain.frm
字号:
AutoSize = -1 'True
BackColor = &H8000000C&
BackStyle = 0 'Transparent
Caption = "不保护"
Height = 180
Left = 4080
TabIndex = 58
Top = 2760
Width = 540
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "通讯状态"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 8295
TabIndex = 30
Top = 495
Width = 1095
End
Begin VB.Shape shpComStatus
BorderColor = &H00FF8080&
BorderWidth = 4
FillStyle = 0 'Solid
Height = 255
Left = 9480
Shape = 3 'Circle
Top = 480
Width = 255
End
Begin VB.Label lblSpeed
BackColor = &H8000000C&
BackStyle = 0 'Transparent
Caption = "速度："
Height = 255
Left = 7920
TabIndex = 28
Top = 7200
Width = 1455
End
Begin VB.Label lblDepth
BackColor = &H8000000C&
BackStyle = 0 'Transparent
Caption = "深度："
Height = 255
Left = 6480
TabIndex = 27
Top = 7200
Width = 1380
End
Begin VB.Label lblName
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "泰安市第二无线电厂"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 2055
Left = 8040
TabIndex = 0
Top = 840
Width = 3135
End
Begin VB.Shape ShapeCmd
BorderColor = &H00808000&
BorderWidth = 3
Height = 2775
Left = 7920
Shape = 4 'Rounded Rectangle
Top = 240
Width = 3375
End
Begin VB.Shape ShapeBoardFrame
BorderColor = &H00808000&
BorderWidth = 3
Height = 2775
Left = 240
Shape = 4 'Rounded Rectangle
Top = 240
Width = 7500
End
Begin VB.Menu mnuCommand
Caption = "&C命令"
Begin VB.Menu mnuConnect
Caption = "连接"
End
Begin VB.Menu yulll
Caption = "-"
End
Begin VB.Menu mnuClearTrack
Caption = "清空轨迹记录"
Shortcut = ^{F3}
End
Begin VB.Menu mnuClearSpeed
Caption = "清空速度数据"
Shortcut = ^{F4}
End
Begin VB.Menu mnu6546545
Caption = "-"
End
Begin VB.Menu mnuRefineSpeedData
Caption = "修正速度数据"
Shortcut = {F3}
Visible = 0 'False
End
Begin VB.Menu mnuHandModifySpeedData
Caption = "手绘速度曲线"
Shortcut = {F4}
End
Begin VB.Menu mnuExit
Caption = "退出"
End
End
Begin VB.Menu mnuSetup
Caption = "&S设置"
Begin VB.Menu mnuModifyPara
Caption = "目标参数"
Shortcut = {F5}
End
Begin VB.Menu mnuAdjustPicX
Caption = "调节图像"
Shortcut = {F6}
End
Begin VB.Menu mnufrmOptions
Caption = "选项..."
Shortcut = {F7}
End
End
Begin VB.Menu mnuDebug
Caption = "&T工具"
Begin VB.Menu mnuSerialKeyboard
Caption = "串口模拟键盘"
Shortcut = {F8}
End
Begin VB.Menu mnuOpenDebugWindow
Caption = "通讯记录窗口"
Shortcut = {F9}
End
End
Begin VB.Menu mnuHelp
Caption = "&H帮助"
NegotiatePosition= 3 'Right
Begin VB.Menu mnuHelpAbout
Caption = "关于"
End
Begin VB.Menu mnu5767
Caption = "-"
End
Begin VB.Menu mnuShowLog
Caption = "打开日志"
Shortcut = {F11}
End
Begin VB.Menu mnuUserHelp
Caption = "使用说明"
Shortcut = {F1}
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public tComWait As Integer '连接等待时间
Public tComRefresh As Integer '刷新等待时间
Dim currentPicX As Single
Dim currentPicY As Single
Dim picMouseDown As POINT
Dim picMouseUp As POINT
'画速度用到的最大井深，开始井深和结束井深对应的数组索引
'定义速度数据数组大小
'数组索引为脉冲数
Dim SaveSpeedL(0 To SPEED_LEN) As Single
Dim SaveSpeedR(0 To SPEED_LEN) As Single
'自动轨迹记录数组
Dim TempSpeedTrack(0 To SPEED_LEN) As Single
'手绘轨迹记录数组
Dim picDrawTrack(SPEED_LEN) As Single
'刷新标志
'Dim rq_depth As Boolean
'Dim rq_speed As Boolean
'Dim rq_click As Boolean
'Dim rq_worktimes As Boolean
'Dim rq_status As Boolean
'err:6 0~11
Dim rq_array(0 To ComCmdMax + 1) As Boolean
Dim rq_err(0 To 5) As Boolean
Dim pnum_current As Integer
Dim speed_current As Single
Const MAX_P_NUM = 50000
Const ConnectWaitTime = 6
Const ConnectRefreshTime = 1
Public key_sts As Integer '下位机键盘设置状态
'串口键盘变量
Dim key_timer As Integer
Dim key_index As Integer
Dim color As Long
Const key_1 As Integer = 7
Const key_2 As Integer = 10
'连接状态
Enum enum_flagConnectStatus
noConnect = 0
Connecting = 1
Connected = 2
Waitting = 3
End Enum
Dim flagConnectStatus As enum_flagConnectStatus
'拖动控件
Dim OldX As Single
Dim OldY As Single
Private FormOldWidth As Long
'保存窗体的原始宽度
Private FormOldHeight As Long
'保存窗体的原始高度
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0
End Sub
'按比例改变表单内各元件的大小，在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
Exit Sub
ScaleX = FormName.ScaleWidth / FormOldWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / FormOldHeight
'保存窗体高度缩放比例
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
'读取控件的原始位置与大小
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next i
Next Obj
On Error GoTo 0
End Sub
Private Sub chkTrack_Click()
cmdRefresh_Click
mnuClearTrack.Enabled = chkTrack.Value
End Sub
'开发软件时候,把这个modal装入程序中.然后加入如下代码:
'Private Sub Form_Load()
'Call ResizeInit(Me) '在程序装入时必须加入
'End Sub
Private Sub Form_Resize()
Call ResizeForm(Me) '确保窗体改变时控件随之改变
End Sub
Private Sub mnufrmOptions_Click()
frmOptions.Show 1, Me
End Sub
Private Sub mnuHandModifySpeedData_Click()
mnuHandModifySpeedData.Checked = Not mnuHandModifySpeedData.Checked
If mnuHandModifySpeedData.Checked = True Then
If chkDraw(0).Value = 1 And chkDraw(1).Value = 1 Then
chkDraw(1).Value = 0
End If
PicX.MousePointer = 2
Else
PicX.MousePointer = 0
End If
End Sub
Private Sub mnuHelpAbout_Click() '“关于”对话框
frmAbout.Show vbModal, frmMain
End Sub
Private Sub mnuModifyPara_Click()
frmPara.Show 1, Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -