frmcb900k.frm

电子皮带秤管理软件,绝对超值

        Timer1.Enabled = False
        Timer2.Enabled = False
        Send ("\ENQID00")
        tmp = "\ENQID0" & Trim(Combo1.Text)
        Tmpid = Format(Combo1.Text, "00")
        
       If Send(tmp) = Tmpid Then
           StatusBar1.Panels(4).Text = Combo1.Text & "地址已经打开！"
       Else
           StatusBar1.Panels(4).Text = Combo1.Text & "地址不能打开！"
       End If
        
 Else
    Send ("R")
    Command10(0).Enabled = True
    Command10(1).Enabled = True
    Command3.Enabled = False
    Command4.Enabled = False
    Command8.Enabled = False
    Command9.Enabled = False
    Command12.Caption = "开始校秤"
 End If
End Sub

Private Sub Command2_Click()
FrmDataView.Show
End Sub

Private Sub Command3_Click()
Dim tmp As String
Dim Tmpid As String
tmp = Format(Trim(Combo1.Text), "00")
Tmpid = "\ENQID" & tmp

 If MsgBox("确认去除皮重吗", vbYesNo) = vbYes Then
    If Send(Tmpid) = tmp Then
     PBar1.Value = 0
     Send ("TARE")
     Timer3.Enabled = True
      StatusBar1.Panels(3).Text = "正在调皮....！！！"
    Else
      StatusBar1.Panels(3).Text = "不能调皮....！！！"
     End If
End If
End Sub

Private Sub Command4_Click()
Dim tmp As String
Dim Tmpid As String
tmp = Format(Trim(Combo1.Text), "00")
Tmpid = "\ENQID" & tmp

If MsgBox("确认去除总累重吗", vbYesNo) = vbYes Then
  If Send(Tmpid) = tmp Then
      Send ("RSTT")
      Send ("E")
  End If
End If
End Sub

Private Sub Command5_Click(Index As Integer)
SaveData (Index)
SavePrint (Index)
End Sub

Private Sub Command6_Click(Index As Integer)
 Call PrintD
End Sub

Private Sub Command7_Click()
    If MSComm1.PortOpen Then
       MSComm1.PortOpen = False
    End If
    End
End Sub

Private Sub Command8_Click()
Dim tmp As String
Dim Tmpid As String
tmp = Format(Trim(Combo1.Text), "00")
Tmpid = "\ENQID" & tmp

Send ("\ENQDI00")
 If Send(Tmpid) = tmp Then
        Send ("FUNC")
        Send ("SYSTEM")
        Send ("E")
        Send ("E")
        Send ("E")
        Send ("E")
        Text5.Text = IsNum(Text1.Text) ' Text1.Text
        Send ("R")
        StatusBar1.Panels(2).Text = "读取成功！"
  Else
     StatusBar1.Panels(2).Text = "读取失败！"
  End If
End Sub

Private Sub Command9_Click()
Dim tmp As String
Dim Tmpid As String
tmp = Format(Trim(Combo1.Text), "00")
Tmpid = "\ENQID" & tmp

Send ("\ENQDI00")
 If Send(Tmpid) = tmp Then
        Send ("FUNC")
        Send ("SYSTEM")
        Send ("E")
        Send ("E")
        Send ("E")
        Send ("E")
        Send (Val(Trim(Text5.Text)) * 100)  '动态去皮
        Send ("E")
        StatusBar1.Panels(3).Text = "已经加载"
        Send ("R")
  Else
        StatusBar1.Panels(3).Text = "加载失败！"
  End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim msg As String
On Error Resume Next

If App.PrevInstance Then    '禁止程序重复运行
   msg = App.EXEName & "程序已经加载，不能重复！"
   MsgBox msg, 48 '给出程序已运行的提示和一惊叹号以示警告
   Unload Me
    End
End If
Call AddOdbc("tl", "pdcdata.mdb")
Connstr = "dsn=tl" '"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\pdcdata.mdb;Persist Security Info=False"
Adodc1.ConnectionString = Connstr
Adodc1.RecordSource = "select * from data"
Adodc1.Refresh

Combo1.Clear
For i = 1 To 128
    Combo1.AddItem i
Next
Combo1.ListIndex = 0

Combo3.Clear
For i = 1 To 128
    Combo3.AddItem i
Next
Combo3.ListIndex = 0


Slider1.Value = 400

MaxRate(0) = Val(Text4(0).Text)
MaxRate(1) = Val(Text4(1).Text)
For i = 1 To 10

 Combo4(0).AddItem i
 Combo4(1).AddItem i
Next
Combo4(0).ListIndex = 0
Combo4(1).ListIndex = 0

End Sub

Sub Setcomm()
    Dim Commstr As String
    On Error GoTo errStr
    
    With MSComm1
         If .PortOpen = True Then
            MsgBox ("串口已经打开了")
           .PortOpen = False
            Exit Sub
         End If
        Commstr = "2400,N,8,1"
                 .Settings = Commstr                     '"2400,n,8,1"  '设置通信口参数
                 .CommPort = Val(Combo3.Text)            '使用串口1.c
                 .InputLen = 0
                 .InBufferSize = 512
                 .InBufferCount = 0
                 .OutBufferSize = 512
                 .OutBufferCount = 0
                 .RThreshold = 1
                 .SThreshold = 1
                 .PortOpen = True                        '打开串口
                 
     End With
        StatusBar1.Panels(1).Text = "串口已经打开！"
        Exit Sub
errStr:
       If Err.Number = 8002 Then
         StatusBar1.Panels(1).Text = "串口不存在！"
         MsgBox "串口不存在！", vbOKOnly Or vbInformation
       ElseIf Err.Number = 8005 Then
         MsgBox "串口已打开！", vbOKOnly Or vbInformation
       End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
'Cancel = 1
End Sub

Private Sub mnuExit_Click()
On Error Resume Next
If MSComm1.PortOpen Then
   MSComm1.PortOpen = False
 End If
 Unload Me
 End
End Sub

Private Sub mnuView_Click()
 FrmDataView.Show
End Sub

Private Sub Slider1_Change()
 Ytime = Slider1.Value
End Sub

Private Sub Text4_Change(Index As Integer)
MaxRate(Index) = Val(Text4(Index).Text)
End Sub

Private Sub Text4_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
  MaxRate(Index) = Val(Text4(Index).Text)
End If

End Sub

Private Sub Timer1_Timer()
Dim Tmpid As String

If ScaleState(0) Then
   Tmpid = Format(Combo4(0).Text, "00")
   Call ReadData(Tmpid, 0)
Else
  Label7(0).Caption = "停机!"
End If

If ScaleState(1) Then
  Tmpid = Format(Combo4(1).Text, "00")
  Call ReadData(Tmpid, 1)
Else
  Label7(1).Caption = "停机!"
End If

End Sub
Function ReadData(Addr As String, i As Integer)
   Dim CBid As String
   Dim tmp As String
    CBid = "\ENQID" & Addr

    If (Send(CBid) = Addr) Then
    
       tmp = Send("RDAL")
       If Trim(tmp) = "00" Then
          Label7(i).Caption = "运行"
        Else
          Label7(i).Caption = "停机"
          Exit Function
       End If
                
       tmp = Send("RDSP")
        If Trim(tmp) = "04" Then
           Label7(i).Caption = "停机"
           Exit Function
        Else
           TxtRate(i).Text = Send("RDSP")
        End If
        '
        tmp = Send("RDFR")
        If Len(tmp) > 1 Then
            TxtFlow(i).Text = tmp
        End If
      
        tmp = Send("RDTL")
        If Len(tmp) > 1 Then
            TxtSum(i).Text = tmp
        End If
        
        tmp = Send("RDTR")
        If Len(tmp) > 1 Then
           TxtTare(i).Text = tmp
        End If
       
     Else
       Label7(i).Caption = "停机!"
     End If

End Function

Sub SaveData(Index As Integer)
    On Error Resume Next
    Adodc1.Recordset.AddNew
    Adodc1.Recordset.Fields("日期").Value = Now
    Adodc1.Recordset.Fields("车船号").Value = Text3(0).Text
    Adodc1.Recordset.Fields("发货方").Value = Text3(2).Text
    Adodc1.Recordset.Fields("操作员").Value = Text3(4).Text
    Adodc1.Recordset.Fields("码头号").Value = Text3(3).Text
    Adodc1.Recordset.Fields("货名").Value = Text3(1).Text
    Adodc1.Recordset.Fields("速度").Value = Val(TxtRate(Index).Text)
    Adodc1.Recordset.Fields("流量").Value = Val(TxtFlow(Index).Text)
    Adodc1.Recordset.Fields("累重").Value = Val(TxtSum(Index).Text)
    Adodc1.Recordset.Update
   
End Sub

Private Sub Timer2_Timer()
    If (TxtRate(0).Text = "0") Or (TxtRate(1).Text = "") Then
       Exit Sub
    End If
    SaveData (0)
    SaveData (1)
End Sub

Function IsAlarm(strX As String)
Dim tmp As String
    If InStr(strX, "AL") > 0 Then
      tmp = Format(IsNum(strX), "00")
      IsAlarm = tmp
      If tmp = "04" Then
        Send ("R")
      End If
    End If

End Function

Sub PrintD()
   Dim Sqlstr As String
   On Error Resume Next
   Adodc2.ConnectionString = Connstr
   Adodc2.RecordSource = "select * from print"
   Adodc2.Refresh
 
   Sqlstr = "select * from print"
   With DTEsoure.rsCommand1
        If .State = adStateOpen Then .Close
           .Source = Adodc2.ConnectionString
           .Open Sqlstr
   End With
   A3.Show vbModal

End Sub
Private Sub SavePrint(Index As Integer)
    On Error Resume Next
    Adodc2.ConnectionString = Connstr
    Adodc2.RecordSource = "select * from print"
    Adodc2.Refresh
    If Adodc2.Recordset.RecordCount = 0 Then
           Adodc2.Recordset.AddNew
           Adodc2.Recordset.Fields("日期").Value = Now
           Adodc2.Recordset.Fields("车船号").Value = Text3(0).Text
           Adodc2.Recordset.Fields("发货方").Value = Text3(2).Text
           Adodc2.Recordset.Fields("操作员").Value = Text3(4).Text
           Adodc2.Recordset.Fields("码头号").Value = Text3(3).Text
           Adodc2.Recordset.Fields("货名").Value = Text3(1).Text
           Adodc2.Recordset.Fields("速度").Value = Val(TxtRate(Index).Text)
           Adodc2.Recordset.Fields("流量").Value = Val(TxtFlow(Index).Text)
           Adodc2.Recordset.Fields("累重").Value = Val(TxtSum(Index).Text)
           Adodc2.Recordset.Update
       Else
           Adodc2.Recordset.Fields("日期").Value = Now
           Adodc2.Recordset.Fields("车船号").Value = Text3(0).Text
           Adodc2.Recordset.Fields("发货方").Value = Text3(2).Text
           Adodc2.Recordset.Fields("操作员").Value = Text3(4).Text
           Adodc2.Recordset.Fields("码头号").Value = Text3(3).Text
           Adodc2.Recordset.Fields("货名").Value = Text3(1).Text
           Adodc2.Recordset.Fields("速度").Value = Val(TxtRate(Index).Text)
           Adodc2.Recordset.Fields("流量").Value = Val(TxtFlow(Index).Text)
           Adodc2.Recordset.Fields("累重").Value = Val(TxtSum(Index).Text)
           Adodc2.Recordset.Update
       End If
End Sub

Function FlowFl(str As String) As Single
On Error Resume Next
Dim StrA As Single
If str = 0 Or str = "" Then Exit Function
StrA = CSng(str)
If (StrA < (MaxRate(1) + 20)) Then
       Flow(N2) = StrA
       N2 = N2 + 1
        If N2 >= 6 Then
           N2 = 0
        End If
        FlowFl = StrA
 End If
End Function

Function RateFL(str As String) As Single
On Error Resume Next
Dim StrB As Single
If str = 0 Or str = "" Then Exit Function
StrB = CSng(str)
If (StrB > (MaxRate(0) - 0.5)) And (StrB < (MaxRate(0) + 0.3)) Then
        Rate(N1) = StrB
        N1 = N1 + 1
        If N1 >= 6 Then
           N1 = 0
        End If
        RateFL = StrB
End If

End Function

Function GrossFL(str As String) As Single
On Error Resume Next
Dim StrC As Single
If str = 0 Or str = "" Then Exit Function
StrC = CSng(str)
GrossWeight(N3) = StrC
If N3 > 0 Then
    If GrossWeight(N3) > GrossWeight(N3 - 1) Then
       GrossFL = GrossWeight(N3)
    End If
ElseIf N3 = 0 Then
    If GrossWeight(N3) > GrossWeight(6) Then
      
      GrossFL = GrossWeight(N3)
    End If

End If
N3 = N3 + 1
If N3 > 6 Then
 N3 = 0
End If

End Function

Private Sub Timer3_Timer()
PBar1.Value = PBar1.Value + 1
If PBar1.Value >= 60 Then
  Timer3.Enabled = False
  StatusBar1.Panels(3).Text = "调皮结束！！！"
  PBar1.Value = 0
End If
End Sub