frmmain.frm

完整的VB和单片机系统连接的源代码

Public Sub mnuOpenDebugWindow_Click()
    mnuOpenDebugWindow.Checked = Not mnuOpenDebugWindow.Checked
    If mnuOpenDebugWindow.Checked = True Then
        frmDebug.Show 0, Me
    Else
        frmDebug.Hide
    End If
End Sub


















Private Sub WriteRecord()                                      '写记录
    Dim i As Integer
    SetIniString "记录", "提升次数", lblWorktimes.Caption
    SetIniString "记录", "打点次数", lblClick.Caption
    For i = 0 To 5
        SetIniString "记录", lblErrX(i).Caption, lblErr(i).Caption
    Next
End Sub
Private Sub ReadRecord()                                           '读记录
    Dim s As String, i As Integer
    lblWorktimes.Caption = GetIniString("记录", "提升次数", s, "0")
    TxtClick(0).Text = Left(lblWorktimes.Caption, 1)
    lblClick.Caption = GetIniString("记录", "打点次数", s, "")
    For i = 0 To 5
        lblErr(i).Caption = GetIniString("记录", lblErrX(i).Caption, s, "0")
    Next
End Sub






Private Sub ReadInterface()                                           '读界面参数
    Dim s As String
   '读取界面图片
    ImageListShow.ListImages.add , "Up", LoadPicture(fnPicUp)
    ImageListShow.ListImages.add , "Down", LoadPicture(fnPicDown)
    ImageListShow.ListImages.add , "FormIcon", LoadPicture(fnPicFormIcon)
    
    '设置窗体图标
    Me.Icon = ImageListShow.ListImages("FormIcon").ExtractIcon
    
    '读取保存的界面
    'Me.Left = Val(GetIniInterface("Left", s, Str(1660)))
    'Me.Top = Val(GetIniInterface("Top", s, Str(1500)))
    'Me.Width = Val(GetIniInterface("Width", s, Str(11520)))
    'Me.Height = Val(GetIniInterface("Height", s, Str(8400)))
    
    s = GetIniInterface("名称", s, "泰安市第二无线电厂")
    s = Replace(s, "<CR>", vbCrLf)
    lblName.Caption = s
    
    HSpicXL.Value = Val(GetIniInterface("左边距", s, Str(1)))
    HSpicXR.Value = Val(GetIniInterface("右边距", s, Str(1)))
    VSpicYUP.Value = Val(GetIniInterface("上边距", s, Str(1)))
    VSpicYDN.Value = Val(GetIniInterface("下边距", s, Str(1)))
    HSpicXscale.Value = Val(GetIniInterface("深度显示范围", s, Str(200)))
    VSpicYscale.Value = Val(GetIniInterface("速度显示范围", s, Str(10)))

    chkDraw(0).Value = Val(GetIniInterface("左方", s, Str(1)))
    chkDraw(1).Value = Val(GetIniInterface("右方", s, Str(1)))
    chkLineRefX.Value = Val(GetIniInterface("X参考", s, Str(1)))
    chkLineRefY.Value = Val(GetIniInterface("Y参考", s, Str(1)))
    chkTrack.Value = Val(GetIniInterface("轨迹", s, Str(1)))
    Me.BackColor = Val(GetIniInterface("窗体背景色", s, Str(11513775)))

    '读取图像设置
    With MainSetting
        .ComPort = Val(GetIniInterface("串口号", s, Str(1)))
        .ComSeting = GetIniInterface("串口设置", s, "9600")
        
        .ColorLeftSpeed = Val(GetIniInterface("左方颜色", s, Str(vbRed)))
        .ColorRightSpeed = Val(GetIniInterface("右方颜色", s, Str(vbBlue)))
        .ColorHandDraw = Val(GetIniInterface("手绘颜色", s, Str(vbYellow)))
        .picHandSmoothScale = Val(GetIniInterface("手绘平滑范围", s, Str(10)))
        .picHandSmoothTimes = Val(GetIniInterface("手绘平滑次数", s, Str(2)))
        .picModifyScale = Val(GetIniInterface("拟合范围", s, Str(100)))
        .picModifySmoothScale = Val(GetIniInterface("拟合平滑范围", s, Str(10)))
        .picModifySmoothTimes = Val(GetIniInterface("拟合平滑次数", s, Str(2)))
        .picModifyMarginLeft = Val(GetIniInterface("拟合始点", s, Str(10)))
        .picModifyMarginRight = Val(GetIniInterface("拟合终点", s, Str(10)))
        .picModifyByMean = Val(GetIniInterface("描绘斜率", s, Str(0)))
        .picScaleWidth = Val(GetIniInterface("纵向范围", s, Str(200)))
        
        .SpeedDevide = Val(GetIniInterface("速度分频", s, Str(1)))
        '.WellDepth = Val(GetIniInterface("井深", s, Str(200)))
        .GapDepth = Val(GetIniInterface("脉冲宽度", s, Str(0.1)))
    End With

    '设置背景色
    Call SetBackColor

End Sub
Private Sub WriteInterface()                                           '写界面参数
    Dim s As String
    If Me.WindowState <> vbMinimized And Me.WindowState <> vbMaximized Then
        SetIniInterface "Left", Str(Me.Left)
        SetIniInterface "Top", Str(Me.Top)
        SetIniInterface "Width", Str(Me.Width)
        SetIniInterface "Height", Str(Me.Height)
        s = """" & lblName.Caption & """"
        s = Replace(s, vbCrLf, "<CR>")
        SetIniInterface "名称", s
    End If
    SetIniInterface "左边距", Str(HSpicXL.Value)
    SetIniInterface "右边距", Str(HSpicXR.Value)
    SetIniInterface "上边距", Str(VSpicYUP.Value)
    SetIniInterface "下边距", Str(VSpicYDN.Value)
    SetIniInterface "深度显示范围", Str(HSpicXscale.Value)
    SetIniInterface "速度显示范围", Str(VSpicYscale.Value)
    
    SetIniInterface "左方", Str(chkDraw(0).Value)
    SetIniInterface "右方", Str(chkDraw(1).Value)
    SetIniInterface "X参考", Str(chkLineRefX.Value)
    SetIniInterface "Y参考", Str(chkLineRefY.Value)
    SetIniInterface "轨迹", Str(chkTrack.Value)
    SetIniInterface "窗体背景色", Str(Me.BackColor)

    '保存图像设置
    With MainSetting
        SetIniInterface "串口号", Str(.ComPort)
        SetIniInterface "串口设置", .ComSeting
        
        SetIniInterface "左方颜色", Str(.ColorLeftSpeed)
        SetIniInterface "右方颜色", Str(.ColorRightSpeed)
        SetIniInterface "手绘颜色", Str(.ColorHandDraw)
        SetIniInterface "手绘平滑范围", Str(.picHandSmoothScale)
        SetIniInterface "手绘平滑次数", Str(.picHandSmoothTimes)
        SetIniInterface "拟合范围", Str(.picModifyScale)
        SetIniInterface "拟合平滑范围", Str(.picModifySmoothScale)
        SetIniInterface "拟合平滑次数", Str(.picModifySmoothTimes)
        SetIniInterface "拟合始点", Str(.picModifyMarginLeft)
        SetIniInterface "拟合终点", Str(.picModifyMarginRight)
        SetIniInterface "描绘斜率", Str(.picModifyByMean)
        SetIniInterface "纵向范围", Str(.picScaleWidth)
        
        SetIniInterface "速度分频", Str(.SpeedDevide)
        SetIniInterface "脉冲宽度", Str(.GapDepth)
        
    End With
    
End Sub


Public Sub SetBackColor() '设置背景颜色
    Dim Obj As Control
    On Error Resume Next
    For Each Obj In Me
        If TypeName(Obj) = "CheckBox" Then
            Obj.BackColor = Me.BackColor
        End If
        If TypeName(Obj) = "PictureBox" Then
            Obj.BackColor = Me.BackColor
        End If
        If TypeName(Obj) = "CommandButton" Then
            Obj.BackColor = Me.BackColor
        End If
    Next Obj
    On Error GoTo 0
End Sub

Private Sub Form_Load() '加载窗体

    Call ResizeInit(Me) '在程序装入时必须加入

     
    Load frmPara
    Call frmPara.SynchrolizeShow
    '读界面参数
    Call ReadInterface

    '初始化速度
    Call ReadSaveSpeed

    '恢复历史记录
    Call ReadRecord
    
    '初始化画图
    Call InitPicX
    'Call DrawThePoint(HSpicXscale.Value, VSpicYscale.Value)

    
    '初始化串口参数
    Call InitComStatus '串口参数初始化
    Call InitComCmd '串口命令分析初始化
    
    
    Call SaveLog("运行")
    
    TxtShow(0).Text = "0.0"
    TxtShow(1).Text = "0.0"

    '串口键盘
    timerKey.Interval = 100
    timerKey.Enabled = False
    color = cmdKey(0).BackColor

End Sub



Private Sub Form_Unload(Cancel As Integer) '卸载窗体
    Dim s As String
    Dim i As Integer
    Call CloseCom '关串口
    Call SaveSpeedData
    Call WriteRecord '历史记录
    Call WriteInterface '界面参数
    
    s = "勾数" + lblWorktimes.Caption
    s = s + "  打点" + lblClick.Caption
    For i = 0 To 5
        s = s + " " + Left(lblErrX(i).Caption, 2) + lblErr(i).Caption
    Next
    Call SaveLog(s)
    Call SaveLog("退出." & vbCrLf)
    
    Call mnuExit_Click  '卸载所有窗体
End Sub







Private Sub mnuExit_Click() '退出
    '把窗体卸载干净
    'VB的End语句并不总是将在程序中打开的东西卸载得一干二净?例如你在程序中打
    '开了一个文件，而没有用Close语句关闭这个文件，这时你通过程序中的End语句结
    '束了程序，Windows就会认为你打开的文件正在被一个程序所使用，导致你在资源
    '管理器中无法删除该文件。在有些情况下，如果你只用End语句来结束程序，会导
    '致一些非常严重的后果，例如Windows会发出错误的信息，告诉你C盘损坏等等。
    '因此最好是自己编写一个关闭子程序:
    Dim i As Long
    On Error Resume Next
    For i = Forms.Count - 1 To 0 Step -1
        Unload Forms(i) ' Triggers QueryUnload and Form_Unload
        ' If we aren't in Force mode and the
        ' unload failed, stop the shutdown.
        'If Not Force Then
        '    If Forms.Count > I Then
        '    Exit Sub
        'End If
        'End If
    Next i
    ' If we are in Force mode OR all
    ' forms unloaded, close all files.
    'If Force Or (Forms.Count = 0) Then Close
    ' If we are in Force mode AND all
    ' forms not unloaded, end.
    'If Force Or (Forms.Count > 0) Then End
    
End Sub






Public Function InitCom(ComPort As Integer, Setting As String) As Integer '初始化串口
    On Error GoTo ComErr

    MSComm1.CommPort = ComPort
    MSComm1.PortOpen = True
    MSComm1.Settings = Setting & "N,8,1"                 ' 9600 波特，无奇偶校验，8 位数据，一个停止位。
    MSComm1.InputLen = 1                                 'Com.InputLen
    MSComm1.RThreshold = 1                               '允许产生接收事件
    MSComm1.InputMode = comInputModeBinary               '使用二进制模式接收
    InitCom = ComPort

    
        '初始化定时器
    TimerCom.Enabled = True
    TimerCom.Interval = 500

    com.port = True
    ComSendAnalize SendIs_Connect, 0, 0 '发出连接请求
    Exit Function
ComErr:
    MsgBox "不能打开串口" & Trim(Str(ComPort)) & "，" & _
            "可能是别的程序正在使用该串口，或者设置了错误的波特率，请检查后重试。"
    InitCom = 0
End Function





Private Sub mnuSerialKeyboard_Click()
    mnuSerialKeyboard.Checked = Not mnuSerialKeyboard.Checked
    picKey.Visible = mnuSerialKeyboard.Checked
End Sub

Private Sub mnuShowLog_Click()
    'frmLog.Show 1, Me
    frmLog.Show 0, Me
    frmLog.ShowLog
End Sub

Private Sub mnuUserHelp_Click()
    frmUserHelp.Show 1, Me
End Sub



Public Sub SendNextRequest()    '发送下一个等待的命令
    Dim i As Integer
    Static b As Boolean
    
    If b = True Then
        MsgBox "SendNextRequest()重入"
        GoTo exit1
    End If
    b = True
    
    If 1 = 2 Then
    '
    ElseIf rq_array(3) Then      'H读状态
        ComSendAnalize SendIs_ReadStatus, 0, 0
        rq_array(3) = False
        GoTo exit1
    ElseIf rq_array(6) Then        'L读保护状态
        ComSendAnalize SendIs_ReadSts, 0, 0
        rq_array(6) = False
        GoTo exit1
    ElseIf rq_array(5) Then         'K读错误
       For i = 0 To 5
            If rq_err(i) = True Then
                rq_err(i) = False
                ComSendAnalize SendIs_ReadErr, i, 0
                If i = 5 Then rq_array(5) = False
                GoTo exit1
            End If
       Next
    ElseIf rq_array(0) = True Then 'C读到勾数
        ComSendAnalize SendIs_ReadWorkTimes, 0, 0
        rq_array(0) = False
        GoTo exit1
    ElseIf rq_array(4) Then       'J读打点
          ComSendAnalize SendIs_ReadClick, 0, 0
          rq_array(4) = False
          GoTo exit1
    ElseIf rq_array(2) Then         'G读速度
        ComSendAnalize SendIs_ReadSpeed, 0, 0
        rq_array(2) = False
        GoTo exit1
    ElseIf rq_array(1) Then        'F读深度
        ComSendAnalize SendIs_ReadDepth, 0, 0
        rq_array(1) = False
        GoTo exit1
    End If
    
    b = False
    '重新开始刷新
    For i = 0 To 6: rq_array(i) = True: Next
    For i = 0 To 5: rq_err(i) = True: Next
    Exit Sub
exit1:
    b = False
 End Sub












Private Sub TimerCom_Timer() '串口等待定时器,对tComRefresh计数，到零后认为通讯失去
    Dim i As Integer
    '定时刷新程序
    If (chkAutoRefresh.Value = 1) And (flagConnectStatus = Connected) Then
        If tComRefresh <> 0 Then tComRefresh = tComRefresh - 1
        If tComRefresh = 0 Then     '超时：一段时间(3秒)内没有接收到数据
            Call SendNextRequest
            tComRefresh = ConnectRefreshTime
        End If
    End If
    
    '等待程序
    If tComWait <> 0 Then     '超时：一段时间(3秒)内没有接收到数据
        If tComWait = 1 Then    '串口等待超时
            Select Case flagConnectStatus
            Case Connected
                Call ShowConnectStatus(Waitting)
            Case Connecting
                CloseCom
                Call SaveLog("连接失败")
            Case Else
            End Select
        End If
        If f