clsylgb_gb.cls

这是一个基于金蝶K/3的磅秤插件源代码。安装本差价需要金蝶K/310.0以上的版本。本插件是客户端程序。在车辆过磅时自动产生金蝶K/3的出库单。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsYLGB_GB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private WithEvents m_BillTransfer As k3BillTransfer.Bill
Attribute m_BillTransfer.VB_VarHelpID = -1
Dim Cn As ADODB.Connection
Dim Rt As ADODB.Recordset


Public Sub Show(ByRef o As Object)
    Set m_BillTransfer = o
End Sub

Private Sub m_BillTransfer_BillInitialize()
On Error GoTo HERROR
    Set Cn = New ADODB.Connection
    Cn.CursorLocation = adUseClient
    Cn.Open m_BillTransfer.Cnnstring
    m_BillTransfer.AddUserMenuItem "毛重过磅", "新希望"
    m_BillTransfer.AddUserMenuItem "皮重过磅", "新希望"
    m_BillTransfer.AddUserMenuItem "解锁", "新希望"
    m_BillTransfer.AddUserMenuItem "加锁", "新希望"
    doLockCol
    InitCS
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical
    
End Sub

Private Sub InitCS()
On Error GoTo HERROR
    Set Rt = New ADODB.Recordset
    Rt.Open "select * from t_NHG_SystemProfile", Cn, adOpenKeyset, adLockReadOnly
    InitGuoBangCs Rt
    Rt.Close
    Set Rt = Nothing
    isOK = False
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub


Private Sub m_BillTransfer_BillTerminate()
On Error Resume Next
    Cn.Close
    Set Cn = Nothing
End Sub

Private Function GetCol(FieldName As String) As Integer
Dim I As Integer
Dim entryctl As Variant
   entryctl = m_BillTransfer.entryctl
   For I = 1 To UBound(entryctl)
        If UCase(entryctl(I).FieldName) = UCase(FieldName) Then
            GetCol = entryctl(I).FCtlOrder
            Exit For
        End If
   Next I
   
End Function


Private Function GetCol_Head(FieldName As String) As Integer
Dim I As Integer
Dim HeadCtl As Variant
   HeadCtl = m_BillTransfer.HeadCtl
   For I = 1 To UBound(HeadCtl)
        If UCase(HeadCtl(I).FieldName) = UCase(FieldName) Then
            GetCol_Head = HeadCtl(I).FCtlOrder
            Exit For
        End If
   Next I
   
End Function

Private Sub m_BillTransfer_EndBillFormActive()
    doLockCol
End Sub



Private Sub m_BillTransfer_GridChange(ByVal Col As Long, ByVal Row As Long, ByVal Value As Variant, ByVal bNewBill As Boolean, Cancel As Boolean)
    If Col = GetCol("FEntrySelfT0239") Or Col = GetCol("FEntrySelfT0240") Or Col = GetCol("FEntrySelfT0241") Or Col = GetCol("FEntrySelfT0242") Or Col = GetCol("FEntrySelfT0243") Or Col = GetCol("FEntrySelfT0244") Then
        SetJingZhong
    End If
End Sub

Private Sub m_BillTransfer_LeveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
    If NewCol = GetCol("FEntrySelfT0238") Then
        If Trim(m_BillTransfer.GetGridText(NewRow, NewCol)) = "" Then
            m_BillTransfer.SetGridText NewRow, NewCol, strCar
        End If
    End If
End Sub

Private Sub m_BillTransfer_UserMenuClick(ByVal Index As Long, ByVal Caption As String)
    Select Case Caption
        Case "毛重过磅"
           ' MsgBox "开始批量填充"
            Call doMaoZhong
        Case "皮重过磅"
           ' MsgBox "开始改变颜色"
            Call doPiZhong
        Case "解锁"
           ' MsgBox "开始获取名称"
            Call doJieSuo
        Case "加锁"
            Call doJaSuo
        Case Else
    End Select
End Sub
Private Function getTime() As Date
On Error GoTo HERROR
    Set Rt = New ADODB.Recordset
    Rt.Open "select getdate()", Cn, adOpenForwardOnly, adLockReadOnly
    getTime = Rt.Fields(0).Value
    Rt.Close
    Set Rt = Nothing
    Exit Function
HERROR:
    MsgBox Err.Description, vbCritical

End Function

Private Sub doMaoZhong()
On Error GoTo HERROR
    Dim ret As Integer
    If Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0238"))) = strCar Then
        MsgBox "请先选择车牌号码！"
        Exit Sub
    End If
    
    ''毛重
    
    If Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0239"))) <> 0 Then
        ret = MsgBox("车牌号(" + Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0238"))) + ")的毛重已经存在，是否重新过磅？", vbYesNo)
        If ret = vbNo Then Exit Sub
    End If
    
    Frmgb.Show vbModal
    If SjZl = "-1" Then Exit Sub
    
    If Val(SjZl) = 0 Then
        'MsgBox "磅秤读数为零！"
        Exit Sub
    End If
    ''过磅调整
    SjZl = CStr(Val(SjZl) + Val(strGBTZ))
    '
    ''毛重
    '
    m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0239"), SjZl
    '
    '
    ''进厂时间
    If Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0245"))) = "" Then
        m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0245"), Format(getTime, "yyyy-mm-dd hh:mm:ss")
    End If
    '
    ''计算净重
    SetJingZhong
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub
Private Sub SetJingZhong()
On Error GoTo HERROR
    Dim JingZhong As Double
    Dim PiZhong As Double
    Dim MaoZhong As Double
    Dim BaoZhuangJianZhong As Double
    Dim Jianshu As Double
    Dim DaiZhong As Double
    Dim QiTiKouZhong As Double
    
    '毛重
    MaoZhong = Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0239")))
    '皮重
    PiZhong = Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0243")))
    '包装件重
    BaoZhuangJianZhong = Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0240")))
    '件数
    Jianshu = Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0241")))
    
    DaiZhong = Jianshu * BaoZhuangJianZhong / 1000000
    '袋重
    m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0242"), DaiZhong
    '其他扣重
    QiTiKouZhong = Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0244")))
    QiTiKouZhong = QiTiKouZhong / 1000
    
    JingZhong = MaoZhong - PiZhong - DaiZhong - QiTiKouZhong
    '净重
    m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, GetCol("FAUXQTY"), JingZhong
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub
Private Sub doPiZhong()
On Error GoTo HERROR
    Dim ret As Integer
    If Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0239"))) = strCar Then
        MsgBox "请先填写车牌号码！"
        Exit Sub
    End If
    
    ''皮重
    If Val(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0243"))) <> 0 Then
        ret = MsgBox("车牌号(" + Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0238"))) + ")的皮重已经存在，是否重新过磅？", vbYesNo)
        If ret = vbNo Then Exit Sub
    End If
    
    Frmgb.Show vbModal
    If SjZl = "-1" Then Exit Sub
    
    If Val(SjZl) = 0 Then
        'MsgBox "磅秤读数为零！"
        Exit Sub
    End If
    
    
    ''过磅调整
    SjZl = CStr(Val(SjZl) + Val(strGBTZ))
    '
    ''皮重
    '
    m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0243"), SjZl
    '
    '
    ''进厂时间
    If Trim(m_BillTransfer.GetGridText(m_BillTransfer.Grid.ActiveRow, GetCol("FEntrySelfT0246"))) = "" Then
        m_BillTransfer.SetGridText m_BillTransfer.Grid.ActiveRow, 15, Format(getTime, "yyyy-mm-dd hh:mm:ss")
    End If
    '
    ''计算净重
    SetJingZhong
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub

Private Sub doJieSuo()
        FrmPassword.Show 1
        doLockCol
End Sub

Private Sub doJaSuo()
    isOK = False
    doLockCol
End Sub


Private Sub doLockCol()
    m_BillTransfer.Grid.BlockMode = True
    If isOK Then

        '毛重
        m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0239")
        m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0239")
        m_BillTransfer.Grid.Row = 1
        m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
        m_BillTransfer.Grid.Lock = False
        '皮重
        m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0243")
        m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0243")
        m_BillTransfer.Grid.Row = 1
        m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
        m_BillTransfer.Grid.Lock = False
        
    
    Else
        '毛重
        m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0239")
        m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0239")
        m_BillTransfer.Grid.Row = 1
        m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
        m_BillTransfer.Grid.Lock = True
       '皮重
        m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0243")
        m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0243")
        m_BillTransfer.Grid.Row = 1
        m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
        m_BillTransfer.Grid.Lock = True
    
        
        
    End If

    '袋重
    m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0242")
    m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0242")
    m_BillTransfer.Grid.Row = 1
    m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
    m_BillTransfer.Grid.Lock = True
    '进厂时间
    m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0245")
    m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0245")
    m_BillTransfer.Grid.Row = 1
    m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
    m_BillTransfer.Grid.Lock = True
    '出厂时间
    m_BillTransfer.Grid.Col = GetCol("FEntrySelfT0246")
    m_BillTransfer.Grid.Col2 = GetCol("FEntrySelfT0246")
    m_BillTransfer.Grid.Row = 1
    m_BillTransfer.Grid.Row2 = m_BillTransfer.Grid.MaxRows
    m_BillTransfer.Grid.Lock = True
    
    m_BillTransfer.Grid.BlockMode = False


End Sub