frmmain.frm

一个称重计量程序

 txtmz.Text = Format(TxtWeight.Text / 1000, "0.00")
 GetWeight
End Sub

Private Sub CmdPrint_Click()
On Error Resume Next
If (Trim(txtmz.Text) = "0.00") Or (Trim(TxtPz.Text)) = "0.00" Then
 MsgBox "数据不完整！不能打印磅单！", vbInformation + vbOKOnly, "提示!"
 Exit Sub
End If
 If cmdmz.Enabled = True And cmdpz.Enabled = True Then
   MsgBox "你是不是弄错了，打印这样的单子是不合情理的！", vbInformation + vbOKOnly, "提示！"
   Exit Sub
 End If
 If Val(Txtjz.Text) <= 0 Then
   MsgBox "净重不能小于0，打印这样的单子是不合情理的！", vbInformation + vbOKOnly, "提示！"
   Exit Sub
 End If
'//加入打印磅单代码
 Adodc1.ConnectionString = Cn
 Adodc1.RecordSource = "select*from tb_wightbb"
 Adodc1.Refresh
 Do Until Adodc1.Recordset.EOF
  Adodc1.Recordset.Delete
  Adodc1.Recordset.Update
   DoEvents
  Adodc1.Recordset.MoveNext
 Loop
  With Adodc1.Recordset
  .AddNew
  .Fields!车号 = TxtCh.Text
  .Fields!仓库 = Cmbck.Text
  .Fields!货物名称 = Trim(cmbhw.Text)
  .Fields!单位 = Trim(Cmbdw.Text)
  If Chkdw.Value = 1 Then
   .Fields!单位类型 = "拉货单位"
  Else
   .Fields!单位类型 = "送货单位"
  End If
  .Fields!毛重 = txtmz.Text
  .Fields!皮重 = Format(Val(Trim(TxtPz.Text)) + Val(Trim(Txtkz.Text)), "0.00")
  .Fields!净重 = Txtjz.Text
  If CInt(Val(Txthl.Text) * 100) = 0 Then
   .Fields!含量 = ""
  Else
   .Fields!含量 = Format(Val(Txthl.Text), "0.00") & "%"
  End If
  If CInt(Val(TxtyS.Text * 100)) = 0 Then
   .Fields!应收数量 = ""
  Else
   .Fields!应收数量 = Format(TxtyS.Text, "0.00")
  End If
  .Fields!过磅员 = UserName
  .Update
  End With
  Set Dpbd.DataSource = Adodc1
  Dpbd.Sections("section2").Controls.Item("label4").Caption = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日"
  Adodc1.Recordset.MoveFirst
  Dpbd.Sections("section1").Controls.Item("txtch").DataField = Adodc1.Recordset.Fields!车号.Name
  Dpbd.Sections("section1").Controls.Item("txtck").DataField = Adodc1.Recordset.Fields!仓库.Name
  Dpbd.Sections("section1").Controls.Item("txthw").DataField = Adodc1.Recordset.Fields!货物名称.Name
  Dpbd.Sections("section1").Controls.Item("txtdw").DataField = Adodc1.Recordset.Fields!单位.Name
  Dpbd.Sections("section1").Controls.Item("txtdwlx").DataField = Adodc1.Recordset.Fields!单位类型.Name
  Dpbd.Sections("section1").Controls.Item("txtmz").DataField = Adodc1.Recordset.Fields!毛重.Name
  Dpbd.Sections("section1").Controls.Item("txtpz").DataField = Adodc1.Recordset.Fields!皮重.Name
  Dpbd.Sections("section1").Controls.Item("txtjz").DataField = Adodc1.Recordset.Fields!净重.Name
  Dpbd.Sections("section1").Controls.Item("txtys").DataField = Adodc1.Recordset.Fields!应收数量.Name
  Dpbd.Sections("section1").Controls.Item("txthl").DataField = Adodc1.Recordset.Fields!含量.Name
  Dpbd.Sections("section1").Controls.Item("txtby").DataField = Adodc1.Recordset.Fields!过磅员.Name
  'Dpbd.Show
  Dpbd.PrintReport , False
 Prtflag = True
End Sub

Private Sub CmdPz_Click()
On Error Resume Next
'If Chkdw.Value = 0 And CInt(txtmz.Text) = 0 Then
'  MsgBox "是送货单位,应该先过毛重!", vbInformation + vbOKOnly, "提示!"
'  Exit Sub
'End If
If Trim(TxtWeight.Text) = "" Then
  MsgBox "数据通讯不正常,不能采集皮重!", vbInformation + vbOKOnly, "提示"
  Exit Sub
End If
 TxtPz.Text = Format(TxtWeight.Text / 1000, "0.00")
 GetWeight
End Sub

Private Sub Cmdsave_Click()
On Error Resume Next
 Dim rd_wight As New ADODB.Recordset
 Dim rddw As New ADODB.Recordset
 If Trim(TxtCh.Text) = "" Then
  MsgBox "车号不能为空！", vbInformation + vbOKOnly, "提示"
  Exit Sub
 End If
 If (txtmz.Text = "0.00") And (TxtPz.Text = "0.00") Then
  MsgBox "还没有毛重或皮重，不能保存数据！", vbInformation + vbOKOnly, "提示！"
  Exit Sub
 End If

'//半单添加
If (txtmz.Text = "0.00") Or (TxtPz.Text = "0.00") Then
 If TxtCh.Locked = True Then
   MsgBox "必须过完该张磅单才能保存！", vbInformation + vbOKOnly, "提示！"
   Exit Sub
 End If
 With rd_wight
     .Open "select*from tb_wight", Cn, adOpenKeyset, adLockPessimistic
     '//该处需加代码
      .AddNew
      .Fields!车号 = TxtCh.Text
      .Fields!货物名称 = cmbhw.Text
      If Chkdw.Value = 1 Then
       .Fields!单位类型 = "拉货单位"
      Else
       .Fields!单位类型 = "送货单位"
      End If
      .Fields!单位 = Trim(Cmbdw.Text)
      .Fields!仓库 = Trim(Cmbck.Text)
      .Fields!过磅员 = UserName
      .Fields!毛重 = Trim(txtmz.Text)
      .Fields!皮重 = Trim(TxtPz.Text)
      .Fields!净重 = Trim(Txtjz.Text)
      .Fields!扣重 = Trim(Txtkz.Text)
      .Fields!含量 = Trim(Txthl.Text)
      .Fields!应收数量 = Trim(TxtyS.Text)
      '.Fields!皮重2 = CStr(Val(Trim(TxtPz.Text)) + Val(Trim(Txtkz.Text)))
      .Fields!日期 = Now
      .Fields!作废标志 = "否"
      .Update
     .Close
       TxtCh.Locked = False
       TxtCh.BackColor = vbWhite
 End With
'//数据完成
Else
 If (cmdmz.Enabled = True) And (cmdpz.Enabled = True) Then
   MsgBox "你是不是弄错了，不能同时过毛重和皮重！", vbInformation + vbOKOnly, "提示！"
   Exit Sub
 End If
 If Prtflag = False Then
   MsgBox "该磅单还没有打印，请打印完再保存数据！", vbInformation + vbOKOnly, "提示"
   Exit Sub
 End If
  With rd_wight
 
    .Open "select*from tb_wight where 车号='" & Trim(TxtCh.Text) & "'  and (毛重='0.00' or 皮重='0.00') and 作废标志<>'是' order by 日期 desc ", Cn, adOpenKeyset, adLockPessimistic
       If .EOF Then
         MsgBox "没有找到磅单，不能保存该数据！", vbInformation + vbOKOnly, "提示！"
       Else
        .Fields!货物名称 = cmbhw.Text
        If Chkdw.Value = 1 Then
         .Fields!单位类型 = "拉货单位"
        Else
         .Fields!单位类型 = "送货单位"
        End If
        .Fields!单位 = Trim(Cmbdw.Text)
        .Fields!仓库 = Trim(Cmbck.Text)
        .Fields!过磅员 = UserName
        .Fields!应收数量 = Trim(TxtyS.Text)
        .Fields!毛重 = Trim(txtmz.Text)
        .Fields!皮重 = Trim(TxtPz.Text)
        .Fields!净重 = Trim(Txtjz.Text)
        .Fields!扣重 = Trim(Txtkz.Text)
        .Fields!含量 = Trim(Txthl.Text)
        .Fields!日期 = Now
        .Update
       End If
    .Close
   End With
  End If
   '//数据复位
    TxtCh.Text = ""
    InitData
    InitCmb "tb_hw", cmbhw
    InitCmb "tb_ck", Cmbck
     Cmbdw.Clear
    With rddw
     .Open "select*from tb_dw where 单位类型='拉货单位' order by 单位名称", Cn, adOpenKeyset, adLockPessimistic
       Do Until .EOF
        Cmbdw.AddItem .Fields!单位名称
       .MoveNext
       Loop
     .Close
    End With
    Chkdw.Value = 0
    Prtflag = False
    cmdmz.Enabled = True
    cmdpz.Enabled = True
    TxtCh.Locked = False
    TxtCh.BackColor = vbWhite
End Sub

Private Sub Form_Load()
On Error Resume Next
 Dim rddw As New ADODB.Recordset
 TxtCh.Text = ""
 InitData
 InitCmb "tb_hw", cmbhw
 InitCmb "tb_ck", Cmbck
 'InitCmb "tb_dw", cmbdw
     Cmbdw.Clear
  With rddw
   .Open "select*from tb_dw where 单位类型='送货单位' order by 单位代号", Cn, adOpenKeyset, adLockPessimistic
     Do Until .EOF
      Cmbdw.AddItem .Fields!单位名称
     .MoveNext
     Loop
   .Close
  End With
 Chkdw.Value = 0
 Com.PortOpen = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 If (txtmz.Text <> "0.00") Or (TxtPz.Text <> "0.00") Then
  If MsgBox("你在退出程序前保存数据了吗?", vbQuestion + vbYesNo, "提示") = vbNo Then
    Cancel = 1
  End If
 End If
End Sub

Private Sub Label4_DblClick()
On Error Resume Next
 Dim rddw As New ADODB.Recordset
 Dim Dwname As String
 Dwname = Cmbdw.Text
 Dwname = "%" & Dwname & "%"
    With rddw
     If Chkdw.Value = 1 Then
       .Open "select*from tb_dw where 单位类型='拉货单位' and 单位名称 like '" & Dwname & "' ", Cn, adOpenKeyset, adLockPessimistic
     Else
       .Open "select*from tb_dw where 单位类型='送货单位' and 单位名称 like '" & Dwname & "' ", Cn, adOpenKeyset, adLockPessimistic
     End If
     If Not .EOF Then
       Cmbdw.Clear
       Do Until .EOF
         Cmbdw.AddItem .Fields!单位名称
        .MoveNext
       Loop
       Cmbdw.ListIndex = 0
     End If
      .Close
    End With
End Sub

Private Sub Tmrmain_Timer()
On Error Resume Next
 TxtWeight = GetData
End Sub

Private Sub TxtCh_DblClick()
On Error Resume Next
 Dim rd_wight As New ADODB.Recordset
  With rd_wight
   .Open "select*from tb_wight where 车号='" & Trim(TxtCh.Text) & "'and (毛重='0.00' or 皮重='0.00') and 作废标志<>'是' and 日期>#" & Date - 4 & "# order by 日期 desc", Cn, adOpenKeyset, adLockPessimistic
    If .EOF Then
       InitData
       cmbhw = ""
       Cmbck = ""
       Cmbdw = ""
       Chkdw.Value = 0
       cmdmz.Enabled = True
       cmdpz.Enabled = True
    Else
       cmbhw.Text = .Fields!货物名称 & ""
       TxtyS.Text = .Fields!应收数量
       Cmbck.Text = .Fields!仓库 & ""
       txtmz.Text = .Fields!毛重
       TxtPz.Text = .Fields!皮重
       Txtjz.Text = .Fields!净重
       Txtkz.Text = .Fields!扣重
       Txthl.Text = .Fields!含量
       If .Fields!单位类型 = "拉货单位" Then
         Chkdw.Value = 1
       Else
         Chkdw.Value = 0
       End If
       Cmbdw.Text = .Fields!单位 & ""
       If txtmz.Text <> "0.00" Then
         cmdmz.Enabled = False
       Else
         cmdpz.Enabled = False
       End If
       TxtCh.Locked = True
       TxtCh.BackColor = &HC0C0C0
    End If
   .Close
  End With
End Sub
Private Sub Txthl_KeyPress(KeyAscii As Integer)
On Error Resume Next
If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 And Chr(KeyAscii) <> "." Then
   KeyAscii = 0
 End If
End Sub
Private Sub Txthl_LostFocus()
On Error Resume Next
   If IsNumeric(Txthl.Text) = False Or Val(Txthl.Text) < 0 Or Val(Txthl.Text) > 100 Then
     Txthl.SetFocus
      MsgBox "含量值输入不正确，请重输！", vbInformation + vbOKOnly, "提示！"
      Txthl = "100"
     Exit Sub
    End If
 GetWeight
End Sub

Private Sub Txtkz_KeyPress(KeyAscii As Integer)
On Error Resume Next
 If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 And Chr(KeyAscii) <> "." And Chr(KeyAscii) <> "-" Then
   KeyAscii = 0
 End If
 'If Trim(Txtkz.Text) = "" Then
 ' Txtkz.Text = "0.00"
' End If
End Sub
Private Sub Txtkz_LostFocus()
On Error Resume Next
    If IsNumeric(Txtkz.Text) = False Then
     Txtkz.SetFocus
      MsgBox "扣重值输入不正确，请重输！", vbInformation + vbOKOnly, "提示！"
      Txtkz.Text = "0.00"
     Exit Sub
    End If
    GetWeight
    If Val(Txtjz.Text) < 0 Then
        Txtkz.SetFocus
        MsgBox "你扣的太多了，净重都成了负数了，请输入适当的扣重！", vbInformation + vbOKOnly, "提示！"
        Txtkz.Text = "0.00"
         GetWeight
        Exit Sub
   End If
End Sub
'//取得结果值
Private Sub GetWeight()
On Error Resume Next
    If Val(txtmz.Text) <> 0 And Val(TxtPz.Text) <> 0 Then
      Txtjz.Text = Format(txtmz.Text - TxtPz.Text - Txtkz, "0.00")
    End If
End Sub
'//重仪表接收数据
Private Function GetData()
On Error Resume Next
Dim str As String
Dim i As Integer
 '
 'GetData = Format(Rnd() * 100000, "0")
  '//改为串口通讯接收数据
str = Com.Input
'str = str & comm.Input
 For i = 1 To Len(str)
    If Mid(str, i, 2) = "GS" Then
      If Mid(str, i + 6, 5) <> "" Then
       GetData = Val(Mid(str, i + 6, 5))
      End If
       Exit Function
     End If
 Next i
End Function
Private Sub TxtyS_KeyPress(KeyAscii As Integer)
On Error Resume Next
 If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 And Chr(KeyAscii) <> "." Then
   KeyAscii = 0
 End If
End Sub
Private Sub TxtyS_LostFocus()
On Error Resume Next
 If Trim(TxtyS.Text) = "" Then
  TxtyS.Text = "0.00"
 End If
End Sub