frmmain.frm

自动化测试程序

      End
      Begin VB.Menu MenuWrTime 
         Caption         =   "对时"
      End
      Begin VB.Menu RdDevTime 
         Caption         =   "读当前装置时间"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "&搜索帮助"
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "&关于"
      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
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags _
As Long) As Long

Const HWND_TOPMOST = -1

Dim Rdata1

Dim ErrData() As Byte
Dim ErrDatalen As Integer
Dim errTag As Boolean
Dim errType As Integer

Private Sub MDIForm_Load()
    ProjectExist = False
    Dim temp As String
    Dim i, j As Integer
    Module_num = GetINI("MOD_TYPE", "NUM", App.Path & "\config.ini")
    ReDim Module_type(Module_num) As Integer
    ReDim Module_name(Module_num) As String
    For i = 1 To Module_num
        temp = GetINI("MOD_TYPE", "CLASS" & i, App.Path & "\config.ini")
        j = InStr(1, temp, ",")
        Module_name(i) = Mid(temp, 1, j - 1)
        Module_type(i) = Mid(temp, j + 1)
    Next i
    Clr_Par
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
'    SelProtect.Show , Me
'    frmSetComm.Show , Me
    
'    SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
'    , Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, _
'    Me.Height / Screen.TwipsPerPixelY, 0
'Me.MenuDevice.Enabled = False
'Me.MenuGuiye.Enabled = False
'Me.MenuComm.Enabled = False
'Me.MenuRdWr.Enabled = False
    Com_Open = False
    Comm_tx_type = FUNC_YC
    Comm_tx_loop_type = FUNC_YC
End Sub


Private Sub LoadNewDoc()
    Static lDocumentCount As Long
    Dim frmD As frmDocument
    lDocumentCount = lDocumentCount + 1
    Set frmD = New frmDocument
    frmD.Caption = "Document " & lDocumentCount
    frmD.Show
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub MenuCancal_Click()
    Unload Me
End Sub

Private Sub MenuCommSet_Click()
frmSetComm.Show
End Sub

Private Sub MenuComm_Click()
    frmSetComm.Show , Me
End Sub

Private Sub MenuGuiyeMup_Click()
    Me.MenuGuiyeMup.Checked = True
    Me.MenuGuiyeSup.Checked = False
    If OpenCom = False Then
        MsgBox "串口打开失败！", 16, "提示"
    End If
End Sub

Private Sub MenuGuiyeSup_Click()
    Me.MenuGuiyeSup.Checked = True
    Me.MenuGuiyeMup.Checked = False
    If OpenCom = False Then
        MsgBox "串口打开失败！", 16, "提示"
    End If
End Sub

Private Sub MenuNew_Click()
NewProject.Show 1
End Sub

Private Sub MenuOpen_Click()
SelProject.Show 1
End Sub

Private Sub MenuWrTime_Click()
    Comm_tx_type = FUNC_TIME
'    Send_handle
End Sub

Private Sub RdDevTime_Click()
    Comm_tx_type = FUNC_R_TIME

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    
    Select Case Button.Key
        Case "New"
            NewProject.Show 1
        Case "Open"
        
        Case "Save"

        Case "Print"

    End Select
    
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Sub Clr_Par()
'初始化参数内存
    Dim i, j, k As Integer
    For i = 0 To 255
        For j = 0 To 256
            Dev_Par(i).dd_base_cfg(j) = 0
            Dev_Par(i).dd_rate_cfg(j) = 1
            Dev_Par(i).di_dd_cfg(j) = 0
            Dev_Par(i).di_delay_cfg(j) = 0
            Dev_Par(i).di_func1_cfg(j) = 255
            Dev_Par(i).di_func2_cfg(j) = 255
            Dev_Par(i).di_pro_cfg(j) = 0
            For k = 2 To DO_FUNC_NUM + 1
            Dev_Par(i).do_cfg(k, j) = 255
            Next k
            Dev_Par(i).di_cfg(j) = 0
            Dev_Par(i).yc_cfg(j) = 0
            Dev_Par(i).sys_cfg(j) = 0
            Dev_Par(i).chks(j, 2) = 1#
            Dev_Par(i).chks(j, 3) = 0#
            Dev_Par(i).chks(j, 4) = 0#
            Dev_Cur_Dat(i).cur_dd(j) = 0
            Dev_Cur_Dat(i).cur_yc(j) = 0
            Dev_Cur_Dat(i).cur_ycxs(j) = 1#
            Dev_Cur_Dat(i).cur_yx(j) = 0
            Dev_Par(i).settle(j) = 100
        Next j
        Dev_Par(i).settle(0) = 0
   Next i
End Sub

Private Sub Comm_OnComm()
'通讯原理
'主动传送时，发送数据先写入发送缓冲区，启动发送、发送定时器和通讯故障计时器，
'当发送定时器到发送下一组数据，当通讯故障计时器到提示串口故障
'接收数据，设置接收完成计时器，当接收完成计时器到时处理接收数据，清通讯故障计时器

'问答方式，一问一答，发送启动重发计时器和通讯故障计时器
'重发计时器到重新发送数据，通讯故障计时器到提示通讯故障
'接收数据，设置接收完成计时器，当接收完成计时器到时处理接收数据，清通讯故障
'计时器和重发计时器
If Comm.CommEvent = comEvReceive Then
    Timer2.Enabled = False
    Timer2.Interval = 30
    Timer2.Enabled = True
    Timer3.Enabled = False
    Timer3.Interval = 5000
    Timer3.Enabled = True
    Timer4.Enabled = False
    Timer4.Interval = 2000
    Timer4.Enabled = True
ElseIf Comm.CommEvent = comEvSend Then
    If Comm_mast_slave Then '主动方式下发送完成计时
        Timer1.Enabled = False
        Timer1.Interval = Comm_tx_tm
        Timer1.Enabled = True
    Else '问答方式
        Timer3.Enabled = False
        Timer3.Interval = 5000  '5秒收不到数据设置通讯故障
        Timer3.Enabled = True
        Timer4.Enabled = False
        Timer4.Interval = 2000
        Timer4.Enabled = True
    End If
End If
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
'发送数据完成，处理发送任务
Comm_tx_end = True
'Send_handle
End Sub

Private Sub Timer2_Timer()
Dim TempLen As Integer
Dim Start As Integer
Dim i, j As Integer
On Error Resume Next

    Timer2.Enabled = False
    RData.Datalen = Comm.InBufferCount
    ReDim RData.TempData(RData.Datalen - 1)
'    RData.TempData = Comm.Input
    NewRecData = Comm.Input
    Comm.InBufferCount = 0
    DisposeAllData
    Send_handle
End Sub

Private Sub Timer3_Timer()
Timer3.Enabled = False
If BaoWen_Refresh Then
frmMsgList.Text1(0) = "    未收到返回信息，请检查通讯状态！" & vbCrLf & frmMsgList.Text1(0)
frmMsgList.Text1(0) = "<<<<" & Now & vbCrLf & frmMsgList.Text1(0)

'MsgBox "等待超时,通讯失败！", vbOKOnly, "信息"
End If
End Sub

Private Sub Timer4_Timer()
'    Comm_tx_type = Comm_tx_type_bk
    Send_handle
End Sub

Private Sub Timer5_Timer()
If const_dd_tm = 0 Then
    const_dd_tm = 10
    Comm_tx_type = FUNC_DD
Else
    const_dd_tm = const_dd_tm - 1
End If
End Sub