frmmain.frm

社区医疗系统实现了数字电压计参数的无线传送和温度参数的传送

Private Sub about_menu_Click()
  frmAbout.Show
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'血压测量操作区执行的传输命令
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'开机
Private Sub cmdStart_Click()
 If Winsock1.State <> sckConnected Then
    MsgBox "网络断线，请重新联机"
    Exit Sub
 Else: Dim a As Byte
    a = &HA1
    Winsock1.SendData a
 End If
End Sub

'开始加压
Private Sub ComPress_Click()
  If Winsock1.State <> sckConnected Then
    MsgBox "网络断线，请重新联机"
    Exit Sub
  Else: Dim a As Byte
    a = &HA6
    Winsock1.SendData a
 End If
End Sub

'读结果
Private Sub ComRead_Click()
If Winsock1.State <> sckConnected Then
    MsgBox "网络断线，请重新联机"
    Exit Sub
 Else: Dim a As Byte
       a = &HA8
       Winsock1.SendData a
 End If
End Sub

'关机
Private Sub ComClose_Click()
 If Winsock1.State <> sckConnected Then
    MsgBox "网络断线，请重新联机"
    Exit Sub
 Else: Dim a As Byte
       a = &HA0
       Winsock1.SendData a
 End If
End Sub

'添加病人姓名
Private Sub cmdSure_Click()
'NameText.Text = ""
  'NameText.Text = NameText1.Text
 Data2.Recordset.AddNew
End Sub


'接收数据
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim speData             'speData为收到的数组数据
    Dim zhdata
    Dim m, i As Integer
    Dim buf As String
    Dim temstr() As Byte       '字节数组，用于存放收到的字节数据
    Dim s As Integer, a As Integer, b As Integer, k As Integer
    Dim a0, a1, a2, a3 As Integer
    
    txtReceive.Text = ""
                                   '''''''''''''''''''''''''''''''''''''''''frmMain.
     
  ' Data2.Recordset.LastModified
  'Data2.Refresh
       
    Winsock1.GetData temstr, vbArray + vbByte, bytesTotal
    For i = LBound(temstr, 1) To UBound(temstr, 1)
        buf = Right(Hex(temstr(i)), 2)    'Hex转换完了是十六进制字符串
     
        If temstr(i) < 16 Then
            txtReceive.Text = txtReceive.Text & "0" & Hex(temstr(i)) + " "
        Else   'txtReceive.Text = txtReceive.Text & Hex(temstr(i))
            txtReceive.Text = txtReceive.Text & buf & " "
        End If
    Next i
     
    If txtReceive.Text = "EA " Then
        MsgBox "开机完成"
        txtReceive.Text = ""
    End If
    If txtReceive.Text = "EB " Then
        MsgBox "开始加压"
        txtReceive.Text = ""
    End If
    If txtReceive.Text = "ED " Then
        MsgBox "测量完成"
        txtReceive.Text = ""
    End If
    If txtReceive.Text = "EF " Then
        MsgBox "关机了"
        txtReceive.Text = ""
    End If
    If txtReceive.Text = "00 00 01 ED " Then
        MsgBox "出错信息：袖带未连接15秒内未加压到40mmHg"
        txtReceive.Text = ""
    Exit Sub
    End If
        If txtReceive.Text = "00 00 02 ED " Then
        MsgBox "出错信息:系统漏气45秒内仍未加压到200mmHg以便进入测量"
        txtReceive.Text = ""
    Exit Sub
    End If
    If txtReceive.Text = "00 00 03 ED " Then
        MsgBox "出错信息：脉搏太弱"
        txtReceive.Text = ""
    Exit Sub
    End If
    If txtReceive.Text = "00 00 04 ED " Then
        MsgBox "出错信息:外气囊系统漏气50秒内仍未加压到预设定的压力"
        txtReceive.Text = ""
    Exit Sub
    End If
    
    s = 0
 
    'frmMain.Data2.Recordset.AddNew                           '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    speData = Split(txtReceive.Text, " ")
    If UBound(speData) > 0 Then
           
      For m = 0 To UBound(speData) - 1
      
          For k = 1 To Len(speData(m))   '此循环是把接收到的十六进制转换为十进制
          
            x = Mid(speData(m), k, 1)
            If Asc(x) >= 65 And Asc(x) <= 70 Then    '65是A
                a = Asc(x) - 55
            End If
            If Asc(x) >= 97 And Asc(x) <= 102 Then    '97是a
                a = Asc(x) - 87
            End If
            If Asc(x) >= 48 And Asc(x) <= 57 Then     '48是0
                a = Asc(x) - 48
            End If
            If Len(speData(m)) - k = 0 Then
                s = s + a
            Else
                b = Len(speData(m)) - k
                s = s + a * (16 ^ b)
            End If
        Next k
  
     Select Case m
        Case 0
            a0 = s
            s = 0
        Case 1
            a1 = s
            s = 0
        Case 2
            a2 = s
            s = 0
        Case 3
            a3 = s
            s = 0
      End Select
    Next m
    
    Outtxt.Text = a0 & "/" & a1 & "/" & a2 & "/" & a3
    
    If (a0 And a1 And a2 = 0) Or (a1 = 253) Or (a2 = 253) Then
    'MsgBox "出错信息:"
    Call ComRead_Click
    Else
    
    
    NameText.Text = NameText1.Text
    GaoyaText.Text = a0 '& "/" & a1
    DiyaText.Text = a1
    MaiboText.Text = a2
    txtdate.Text = Date & " " & Time   '系统日期写入数据库
    End If
    
    TimeDelay 6000
    Data2.Refresh '刷新
    a0 = a1 = a2 = a3 = 0
    
    NameText.Text = "无"
    GaoyaText.Text = 0
    DiyaText.Text = 0
    MaiboText.Text = 0
    txtdate.Text = 0   '系统日期写入数据库
    
 End If
'------------------------------------
          '查询并显示记录
          'Dim sqlstring As String
          '  sqlstring = "select*from M where M.M='" & txtSelect.Text & "'"
          '  Data1.RecordSource = sqlstring
          '  Data1.Refresh
    
          'If Data1.Recordset.EOF = False Then
          '  Indexpicture = Val(txtSzt.Text) '图片索引
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'关闭联机并结束程序
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command2_Click()
  Winsock1.Close '关闭联机
  End '结束程序
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'设置连接参数
'执行连接的动作
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command3_Click()
   Dim i%
   '检查状态，若不是关闭，则执行关闭
    If Winsock1.State <> 0 Then Winsock1.Close
   '设置远程的地址及通信端口号码
   Winsock1.RemoteHost = txtIP.Text
   Winsock1.RemotePort = txtPort.Text
   Winsock1.Connect  '执行联机
   TimeDelay 100
    '下面循环等待联机成功
    Do
     DoEvents
    Loop Until Winsock1.State = sckConnected
    MsgBox "已联机"
   ' Me.Caption = "已联机"
    cmdStart.Enabled = True
End Sub


'Private Sub Timer1_Timer()
 ' If Winsock1.State = sckConnected Then
  '                                           ' StatusBar1.SimpleText = "   网络连接完毕" '状态栏显示
  'Else
   ' Winsock1.Close
                                              '    StatusBar1.SimpleText = "   正在进行网络连接..."
    'Me.Caption = "正在进行网络连接..."
   '设置远程的地址及通信端口号码
    'Winsock1.RemoteHost = txtIP.Text
    'Winsock1.RemotePort = txtPort.Text
    'Winsock1.Connect  '执行联机
    'Me.Caption = "正在进行网络连接2..."
    'TimeDelay 100
   '下面循环等待联机成功
    'Do
    'DoEvents
    'Loop Until Winsock1.State = sckConnected
                                               'StatusBar1.SimpleText = "   网络连接完毕"
    'Me.Caption = "网络连接完毕"
 ' End If
'End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'当联机一端中止联机时，便会引发以下的事件。
'我们将联机关闭，并作适当处理
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Private Sub Winsock1_Close()
 ' Dim i%
  'txtReceive.Text = txtReceive.Text & " 对方要求中断。" & vbCr
  'Winsock1.Close  '中断联机
  'cmdSend.Enabled = False
'End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'控件收到对方送来的数据时，会引发以下的事件。
'将数据接收到后，显示在文本框中
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'浏览器的制作
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command6_Click()
   WebBrowser1.Refresh
End Sub

Private Sub Command8_Click()
  KeyCode = 13
  Dim i As Long
    Dim existed As Boolean
    If KeyCode = 13 Then
    'If Left(Combo1.Text, 7) <> "http://" Then
    Combo1.Text = "http://" + "10.30.85.42"
    'End If
    WebBrowser1.Navigate Combo1.Text
    For i = 0 To Combo1.ListCount - 1
    If Combo1.List(i) = Combo1.Text Then
    existed = True
    Exit For
    Else
    existed = False
    End If
    Next
    If Not existed Then
    Combo1.AddItem (Combo1.Text)
    End If
    End If
End Sub


Private Sub Form_Resize()
    On Error GoTo a
    Combo1.Width = Form1.Width - 100
    WebBrowser1.Width = Combo1.Width
    WebBrowser1.Height = Form1.Height - Combo1.Height - 1000
    ProgressBar1.Top = Me.Height - StatusBar1.Height - 330
    ProgressBar1.Left = 0.25 * StatusBar1.Width
    ProgressBar1.Width = 0.75 * Me.Width - 250
a:
End Sub
Private Sub Combo1_Click()
    WebBrowser1.Navigate Combo1.Text
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Long
    Dim existed As Boolean
    If KeyCode = 13 Then
    If Left(Combo1.Text, 7) <> "http://" Then
    Combo1.Text = "http://" + Combo1.Text
    End If
    WebBrowser1.Navigate Combo1.Text
    For i = 0 To Combo1.ListCount - 1
    If Combo1.List(i) = Combo1.Text Then
    existed = True
    Exit For
    Else
    existed = False
    End If
    Next
    If Not existed Then
    Combo1.AddItem (Combo1.Text)
    End If
    End If
End Sub
Private Sub WebBrowser1_DownloadBegin()
    StatusBar1.SimpleText = "载入中…"
End Sub
Private Sub WebBrowser1_DownloadComplete()
    StatusBar1.SimpleText = "下载完成"
    ProgressBar1.value = 0
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    If ProgressMax = 0 Then Exit Sub
    ProgressBar1.Max = ProgressMax
    If Progress <> -1 And Progress <= ProgressMax Then
    ProgressBar1.value = Progress
    End If
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
    Combo1.Text = WebBrowser1.LocationURL
End Sub
Private Sub Command7_Click()
    CommonDialog1.ShowOpen
    WebBrowser1.Navigate CommonDialog1.FileName
    End Sub