clscpgb_gpz.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 = "clsCPGB_GPZ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is BillEvent Interface Class, made by K3BOSPLUGINSWIZAED"
 Option Explicit
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
Dim gGrid  As Object
Dim IsFirstTime As Boolean


 
Public Sub Show(ByVal oBillInterface As Object)
 
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = oBillInterface
    IsFirstTime = True

End Sub

Private Sub Class_Terminate()
 
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = Nothing

End Sub

Private Function getTime() As Date
On Error GoTo HERROR
    Dim Rt As ADODB.Recordset
    Set Rt = m_BillInterface.K3Lib.GetData("select getdate()")
    getTime = Rt.Fields(0).Value
    Rt.Close
    Set Rt = Nothing
    Exit Function
HERROR:
    MsgBox Err.Description, vbCritical

End Function


Private Sub m_BillInterface_AfterLoadBill()
    doLockCol

End Sub


Private Sub m_BillInterface_AfterNewBill()
    m_BillInterface.BillHeads(1).BOSFields("Fdate").Value = getTime
    doLockCol
End Sub

Private Sub doLockCol()
    If isOK Then
        m_BillInterface.BillEntrys(1).BOSFields("FPiZhong").FieldLock = False
    Else
        m_BillInterface.BillEntrys(1).BOSFields("FPiZhong").FieldLock = True
        
    End If
    m_BillInterface.BillEntrys(1).BOSFields("FJingChangShiJian").FieldLock = True
End Sub

Private Sub m_BillInterface_BeforeSave(bCancel As Boolean)
    Dim I As Integer
    
    For I = 1 To gGrid.DataRowCnt
        gGrid.Row = I
        gGrid.Col = 4
        If gGrid.Text = strCar Then
            gGrid.SetActiveCell 4, I
            m_BillInterface.SetFieldValue "fchepaihao", "", I
            
        End If
    Next I

End Sub

Private Sub m_BillInterface_BeginEdit(ByVal dct As KFO.IDictionary, ByVal Col As Long, ByVal Row As Long)
On Error GoTo HERROR
    If IsFirstTime Then
        Set gGrid = m_BillInterface.GetActiveCtl
        IsFirstTime = False
    End If
    
    If Trim(m_BillInterface.GetFieldValue("fchepaihao", Row)) = "" Then
      m_BillInterface.SetFieldValue "fchepaihao", strCar, Row
    End If

    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical


End Sub




Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 MenuBarClick
 
 
    Select Case BOSTool.ToolName
    Case "butPZGB"
        '此处添加处理 butPZGB 菜单对象的 Click 事件
        doGetPZ
    Case "butJS"
        '此处添加处理 butJS 菜单对象的 Click 事件
        FrmPassword.Show 1
        doLockCol
    Case "butJIAS"
        '此处添加处理 butJIAS 菜单对象的 Click 事件
             isOK = False
             doLockCol
    Case Else
    End Select


End Sub

Private Sub m_BillInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************




   
'    Set oBand = oMenuBar.BOSBands.Add("mnuNHG")
'    oBand.Caption = "新希望"
'    oBand.BandType = 2
'    oBand.Flags = 127
'    oBand.Visible = True
'
'    oMenuBar.Refresh
'    Set oBand = oMenuBar.BOSBands.Add("Menu")
'    Set oTool = oBand.BOSTools.Add("mnuNHG")
'    With oTool
'        .Caption = "新希望"
'        .ToolTipText = "新希望"
'        .Description = "新希望"
'        .ShortcutKey = 0
'        .Visible = True
'        .Enabled = True
''        .SubBand = oMenuBar.BOSBands("mnuNHG")
'    End With
'     oBand.BOSTools.InsertBefore "mnuOption", oTool
 
 
 
 
    '新增 butPZGB 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("butPZGB")
    With oTool
        .Caption = "过磅"
        .ToolTipText = "过磅"
        .Description = "过磅"
        .ShortcutKey = 35
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path + "\guobang.ico"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuFileExit", oTool    '将菜单对象插入指定工具栏
    
    Set oBand = oMenuBar.BOSBands("mnuCust")
    oBand.BOSTools.InsertBefore "", oTool     '将菜单对象插入指定工具栏
    



 
    Set oTool = oMenuBar.BOSTools.Add("butJS")
    With oTool
        .Caption = "解锁"
        .ToolTipText = "解锁"
        .Description = "解锁"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path + "\LOPEN.BMP"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuFileExit", oTool    '将菜单对象插入指定工具栏
    Set oBand = oMenuBar.BOSBands("mnuCust")
    oBand.BOSTools.InsertBefore "", oTool     '将菜单对象插入指定工具栏
    
    
    
    Set oTool = oMenuBar.BOSTools.Add("butJIAS")
    With oTool
        .Caption = "加锁"
        .ToolTipText = "加锁"
        .Description = "加锁"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path + "\LSHUT.BMP"
        .SetPicture 0, vbButtonFace
    End With
 
   Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertBefore "mnuFileExit", oTool    '将菜单对象插入指定工具栏
    Set oBand = oMenuBar.BOSBands("mnuCust")
    oBand.BOSTools.InsertBefore "", oTool     '将菜单对象插入指定工具栏
    
    
    
    
 
'*************** 结束新增 BOS 菜单 ***************
    InitCS
    

End Sub
Private Sub InitCS()
On Error GoTo HERROR
    Dim Rt As ADODB.Recordset
    Set Rt = m_BillInterface.K3Lib.GetData("select * from t_NHG_SystemProfile")
    InitGuoBangCs Rt
    Rt.Close
    Set Rt = Nothing
    isOK = False
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub


Private Sub doGetPZ()
On Error GoTo HERROR
    Dim dctTemp As KFO.Dictionary
    Dim ret As Integer
    If Trim(m_BillInterface.BillEntrys(1).BOSFields("FChePaiHao").Value) = strCar Or Trim(m_BillInterface.BillEntrys(1).BOSFields("FChePaiHao").Value) = "" Then
        MsgBox "请先填写车牌号码！"
        Exit Sub
    End If
    
    
    If Val(m_BillInterface.BillEntrys(1).BOSFields("FPiZhong").Value) <> 0 Then
        ret = MsgBox("车牌号(" + m_BillInterface.BillEntrys(1).BOSFields("FChePaiHao").Value + ")的重量已经存在，是否重新过磅？", 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_BillInterface.BillEntrys(1).BOSFields("FPiZhong").Value = SjZl
    If Trim(m_BillInterface.BillEntrys(1).BOSFields("FJingChangShiJian").Value) = "" Then
        m_BillInterface.BillEntrys(1).BOSFields("FJingChangShiJian").Value = getTime
    End If
    
    
    Set dctTemp = m_BillInterface.GetFieldInfoByKey("FPiZhong", "", 0)
    m_BillInterface.BillCtl.SetSumData dctTemp

    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub