clscpgb_gmz.cls

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

             doLockCol
    Case "butFP"
'发票列表：为基础资料得袋重，需要修改。还需要增加是否过磅判断
        strSql = "select b.finterid,b.fbillno,d.fnumber,d.fname,isnull(sum(a.fqty),0) as fpiaozhong,isnull(sum(c.F_673*a.fauxqty),0) as fdaizhong " _
            & "from icsaleentry a left join  icsale b " _
            & "on a.finterid=b.finterid " _
            & "left join t_icitem c " _
            & "on a.fitemid=c.fitemid " _
            & "left join t_organization d " _
            & "on b.fcustid=d.fitemid " _
            & "where b.fheadselfi0541=0 " _
            & "and b.fstatus=1 " _
            & "group by b.finterid,b.fbillno,d.fnumber,d.fname"
        Set FrmFp.rsFp = m_BillInterface.K3Lib.GetData(strSql)

        FrmFp.Show 1
        FrmFp.rsFp.Close
        Set FrmFp.rsFp = Nothing
        Set FrmFp = Nothing
        

        If UBound(arrayFp, 2) = 1 Then Exit Sub
        m_BillInterface.DeleteEntryData 3
        
        DoEvents
       
        For I = 0 To UBound(arrayFp, 1)
            m_BillInterface.InsertNewRowAndFill 3, 1, "ffapiaohao", arrayFp(I, 0), "fkehu1", arrayFp(I, 1), "FPiaoZhong", arrayFp(I, 3), "FDaiZhong", arrayFp(I, 4), "FZhongZhong", arrayFp(I, 5), "FFaPiao", arrayFp(I, 6)
        Next I

        Set dctTemp = m_BillInterface.GetFieldInfoByKey("FDaiZhong", "", 0)
        m_BillInterface.BillCtl.SetSumData dctTemp
        DoEvents

    
        Set dctTemp = m_BillInterface.GetFieldInfoByKey("FPiaoZhong", "", 0)
        m_BillInterface.BillCtl.SetSumData dctTemp
        DoEvents
    
        Set dctTemp = m_BillInterface.GetFieldInfoByKey("FZhongZhong", "", 0)
        m_BillInterface.BillCtl.SetSumData dctTemp
        DoEvents
        
        getHeadZhongLiang
    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 菜单 ***************
 
    '新增 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     '将菜单对象插入指定工具栏
 
    Set oTool = oMenuBar.BOSTools.Add("butFP")
    With oTool
        .Caption = "发票"
        .ToolTipText = "发票"
        .Description = "发票"
        .ShortcutKey = 36
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path + "\fapiao.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     '将菜单对象插入指定工具栏
 
 
'*************** 结束新增 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 ret As Integer
    Dim I As Integer
    Dim SumJingZhong As Double
    Dim iindex As Long
    Dim spkey As String
    Dim dMaoZhong As Double
    Dim dPiZhong As Double
    
    Dim dctTemp As KFO.Dictionary
    
    
    If 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("FMaoZhong").Value) <> 0 Then
        ret = MsgBox("车牌号(" + m_BillInterface.BillEntrys(1).BOSFields("FChePaiHao").Value + ")的重量已经存在，是否重新过磅？", vbYesNo)
        If ret = vbNo Then Exit Sub
    End If
    
    Frmgb.Show vbModal
'    Unload Frmgb
'    Set Frmgb = Nothing
    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("FMaoZhong").Value = SjZl
    
    
    
    
    '出厂时间
    If Trim(m_BillInterface.BillEntrys(1).BOSFields("FChuChangShiJian").Value) = "" Then
        m_BillInterface.BillEntrys(1).BOSFields("FChuChangShiJian").Value = getTime
    End If
    
    '计算净重
    
    
    
    
    '过磅净重
    dMaoZhong = m_BillInterface.BillEntrys(1).BOSFields("FMaoZhong").Value
    dPiZhong = m_BillInterface.BillEntrys(1).BOSFields("FPiZhong").Value
    m_BillInterface.BillEntrys(1).BOSFields("FJingZhong").Value = dMaoZhong - dPiZhong
    
   
    
    ' ==============================================================================
    ' 合计问题
    ' 更新毛重的合计数  Begin
        Set dctTemp = m_BillInterface.GetFieldInfoByKey("FMaoZhong", "", 0)
        m_BillInterface.BillCtl.SetSumData dctTemp
        
        Set dctTemp = m_BillInterface.GetFieldInfoByKey("FJingZhong", "", 0)
        m_BillInterface.BillCtl.SetSumData dctTemp
        
    ' 更新毛重的合计数  End
    ' ==============================================================================
    getHeadZhongLiang
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical

End Sub
Private Sub getHeadZhongLiang()
On Error GoTo HERROR
    Dim SumGuoBang As Double
    Dim SumPiaoMian As Double
    
    If m_BillInterface.BillHeads(1).BOSFields("FPiaoMiaoZhongLiang").Value = "" Then m_BillInterface.BillHeads(1).BOSFields("FPiaoMiaoZhongLiang").Value = "0"
    If m_BillInterface.BillHeads(1).BOSFields("FGuoBangZhongLiang").Value = "" Then m_BillInterface.BillHeads(1).BOSFields("FGuoBangZhongLiang").Value = "0"
    If m_BillInterface.BillHeads(1).BOSFields("FChaYiZhongLiang").Value = "" Then m_BillInterface.BillHeads(1).BOSFields("FChaYiZhongLiang").Value = "0"
    If m_BillInterface.BillHeads(1).BOSFields("FChaYiBeiFengBi").Value = "" Then m_BillInterface.BillHeads(1).BOSFields("FChaYiBeiFengBi").Value = "0"
    
    SumGuoBang = m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("FJingZhong", "", 0))
    SumPiaoMian = m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("FZhongZhong", "", 0))
    
    '过磅总量
    
    m_BillInterface.BillHeads(1).BOSFields("FGuoBangZhongLiang").Value = SumGuoBang
    
    m_BillInterface.BillHeads(1).BOSFields("FPiaoMiaoZhongLiang").Value = SumPiaoMian
    
    
    
    '差异总量
    m_BillInterface.BillHeads(1).BOSFields("FChaYiZhongLiang").Value = SumPiaoMian - SumGuoBang
    '差异百分表
    If SumPiaoMian <> 0 Then
        m_BillInterface.BillHeads(1).BOSFields("FChaYiBeiFengBi").Value = 100 * ((SumPiaoMian - SumGuoBang) / SumPiaoMian)
    End If
    Exit Sub
HERROR:
    MsgBox Err.Description, vbCritical
End Sub