frmstriprigout.frm

金算盘软件代码

        .mnuListEditMenu(11).Enabled = True
        
        .SetToolBar True
    End With
End Sub
'业务菜单
Private Sub MakeListActivityMenu()
    Dim intCnt As Integer
    
    clsBill.UpdateMainEditMenu
    With frmMain
        For intCnt = .mnuListActivityMenu.Count - 1 To 1 Step -1
            Unload .mnuListActivityMenu(intCnt)
        Next
        Load .mnuListActivityMenu(1)
        Load .mnuListActivityMenu(2)
        Load .mnuListActivityMenu(3)
        Load .mnuListActivityMenu(4)
        Load .mnuListActivityMenu(5)
        Load .mnuListActivityMenu(6)
        Load .mnuListActivityMenu(7)
        
        Utility.CloneMenu .mnuEditInsLine, .mnuListActivityMenu(0)
        Utility.CloneMenu .mnuEditDelLine, .mnuListActivityMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListActivityMenu(2)

        .mnuListActivityMenu(3).Caption = "复制分录(&C)"
        If GrdCol.Rows <= 1 Then
            .mnuListActivityMenu(3).Enabled = False
        Else
            .mnuListActivityMenu(3).Enabled = True
        End If
        .mnuListActivityMenu(4).Caption = "粘贴分录(&P)"
'        .mnuListActivityMenu(3).Enabled = True
        If clsBill.blnPasteRec Then
            If chkPrint(1).Value <> 0 Or clsBill.blnMayDelete = False Then
                .mnuListActivityMenu(4).Enabled = False
            Else
                .mnuListActivityMenu(4).Enabled = True
            End If
        Else
            .mnuListActivityMenu(4).Enabled = False
        End If
        Utility.CloneMenu .mnuEditBar2, .mnuListActivityMenu(5)
        Utility.CloneMenu .mnuEditSearch, .mnuListActivityMenu(6)   ' "搜索"
        .mnuListActivityMenu(7).Caption = "编号查询及整理(&Q)"
        .mnuListActivityMenu(7).Enabled = True
        .SetToolBar True
    End With
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList C2lng(lblHead(2).Tag), False
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList C2lng(lblHead(2).Tag), True
End Sub

Private Sub mclsMainControl_ReceiptPosition()
    BuildCancelBill False
End Sub
'单据冲销
Private Sub BuildCancelBill(Optional ByVal GenCancel As Boolean = True)
    Dim lngOldID As Long
    
    clsBill.blnKeyDown = False
    If ChangeSaveNote() = False Then
        Exit Sub
    End If
    If GenCancel Then
        lngOldID = frmWriteOffBill.WriteOffBill(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    Else
        lngOldID = frmWriteOffBill.SeekBill(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod)
    End If
    If lngOldID = 0 Then
    Else
        ShowAOldBill lngOldID
    End If
End Sub

Private Sub refInput_AddNew()
    clsBill.ReferEvent 0
End Sub

Private Sub refInput_Choose()
    clsBill.refInput_Choose
End Sub

Private Sub refInput_Edit()
    clsBill.ReferEvent 1
End Sub
Private Sub refInput_Delete()
    clsBill.ReferEvent 2
End Sub

Private Sub refInput1_AddNew()
    clsBill.ReferEvent 0
End Sub

Private Sub refInput1_Choose()
    clsBill.refInput_Choose
End Sub

Private Sub refInput1_Edit()
    clsBill.ReferEvent 1
End Sub
Private Sub refInput1_Delete()
    clsBill.ReferEvent 2
End Sub


'ID号变化(单据修改进入时有效)
Public Sub ShowaOldOldbill(ByVal ActivityID1 As Long, ByVal ActivityID2 As Long)
    blnNotRaiseEvents = True
    clsBill.lngNowID = ActivityID1
    clsBill.cmdButton_Click 0
    blnIsCanEventChk_Click = False
    lngVoucherID = 0
    LoadBill ActivityID1, ActivityID2 'clsBill.lngNowID
    
    Dim blnEdit As Boolean
    Dim blnView As Boolean
    blnEdit = IsCanDo(EditNO(30))   '设置blnEdit标志
    blnView = IsCanDo(EditNO(30, False))   '设置blnView标志
    If blnEdit = False And blnView = False Then
        Unload MsgForm
        blnNotRaiseEvents = False
        Unload Me
        Exit Sub
    End If
    '设置可修改标志
'    clsBill.blnMayDelete = True
'    If clsBill.lngNowID > 0 And lngVoucherID > 0 Then
'        clsBill.blnMayDelete = False '已生成记帐凭证不可修改
    If blnEdit And C2lng(LblMemo(3).Tag) = gclsBase.OperatorID Then
        '----------------------------------------------------
        If gclsBase.PeriodClosed(lblField(2).Caption) Then
            clsBill.blnMayDelete = False
        ElseIf clsBill.blnDateErr(, False) Then    '已调价
            clsBill.blnMayDelete = False
        ElseIf lngVoucherID > 0 Then
            clsBill.blnMayDelete = False
        ElseIf blnPrinted And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
            clsBill.blnMayDelete = False
        Else
            clsBill.blnMayDelete = True
        End If
        '----------------------------------------------------
    Else
        clsBill.blnMayDelete = False
    End If
    If chkPrint(1).Value <> 0 Or clsBill.blnMayDelete = False Then
        chkPrint(1).Enabled = False
    Else
        chkPrint(1).Enabled = True
    End If
    '----------------------------------------------------
    cmdButton(6).Enabled = IIf(lngVoucherID > 0, True, False)
    If WanNeng Then
        tblReceipt.Buttons(7).Enabled = cmdButton(6).Enabled
    End If
    If blnPrinted And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
        cmdButton(7).Enabled = False
    Else
        cmdButton(7).Enabled = True
    End If
    If WanNeng Then
        tblReceipt.Buttons(8).Enabled = cmdButton(7).Enabled
    End If
    '----------------------------------------------------
    
    clsBill.blnIsChanged = False
    
    blnIsCanEventChk_Click = True
    blnNotRaiseEvents = False
     If clsBill.blnMayDelete Then clsBill.Field_Click 2, False
    MakeListActivityMenu
    MakeListEditMenu
End Sub

Public Sub ShowANewBill(Optional ByVal CurrentActivityID As Long = 0, Optional ByVal blnGetBillNo As Boolean = True)
    On Error GoTo EndProc
    If Not IsCanDo(EditNO(30)) Then
        If Not clsBill Is Nothing Then clsBill.blnRefresh = True
        If Not IsCanDo(EditNO(30, False)) Then
            Unload MsgForm
            ShowMsg Me.hWnd, gclsBase.OperatorName & "无新增及查询本单据权限！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "新增单据"
            blnNotRaiseEvents = False
            Unload Me
            Exit Sub
        Else
            Dim lngLastID As Long
            lngLastID = GetLastActivityID(30, True)
            If lngLastID > 0 Then
                ShowAOldBill lngLastID
                Exit Sub
            End If
            Unload MsgForm
            ShowMsg Me.hWnd, gclsBase.OperatorName & "无新增本单据权限，并且系统中无可查询单据！", MB_OK + MB_SYSTEMMODAL + MB_ICONHAND, "新增单据"
            blnNotRaiseEvents = False
            Unload Me
            Exit Sub
        End If
    End If
    Dim strNo As String
    Dim lngTypeID As Long
    Dim lngID As Long
    Dim intI As Integer
    Dim strSql As String
    blnEdit = True
    blnView = IsCanDo(EditNO(30, False)) ' True
    blnNotRaiseEvents = True
    If chkPrint(0).Visible Then
    End If
    Unload MsgForm
    Me.ZOrder
        
    If gclsBase Is Nothing Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    clsBill.blnMayDelete = True
    If clsBill.lngNowID = 0 Then
            lngTypeID = C2lng(lblHead(2).Tag)
            getPrevPlateAndBillNo lngTypeID, lngID, strNo
    Else
        strNo = lblField(1).Caption
        lngTypeID = lblHead(2).Tag
        lngID = lblHead(4).Tag
    End If
    If cmdButton(0).Visible Then
    End If
    If Me.Visible Then
        If Not ChangeSaveNote Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
    End If
    clsBill.GetANewBill lngID, lngTypeID, strNo, blnGetBillNo
    '----------------------------------------------------
    cmdButton(7).Enabled = True
    If WanNeng Then
        tblReceipt.Buttons(8).Enabled = cmdButton(7).Enabled
    End If
    '----------------------------------------------------
    cmdButton(6).Enabled = False
    If WanNeng Then
        tblReceipt.Buttons(7).Enabled = cmdButton(6).Enabled
    End If
    chkPrint(1).Enabled = False
    If blnGetBillNo Then
        blnNotRaiseEvents = False
        If Me.Visible = False Then
            blnFirstIn = True
            Me.Visible = True
        End If
        Me.ZOrder 0
        If gclsBase Is Nothing Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
        If blnGetBillNo Then clsBill.Field_Click 2, False
    End If
    MakeListActivityMenu
    MakeListEditMenu
    blnNotRaiseEvents = False
    Exit Sub
EndProc:
ErrHandle:
    If Errors.ErrorsDeal = edtResume Then
         Resume
    Else
         On Error Resume Next
        blnNotRaiseEvents = False
        Unload Me
    End If
    
End Sub

Private Function ChangeSaveNote() As Boolean
'    Dim blnT As Boolean
'    If clsBill.blnIsChanged Then
'        If ShowMsg(Me.hwnd, "该张拆卸组装单数据已经发生改变，是否需要保存?", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION + MB_SYSTEMMODAL, "提示") = IDYES Then
'            blnT = SaveBill()
'            If blnT Then
'                clsBill.blnIsChanged = False
'            End If
'            ChangeSaveNote = blnT
'        Else
'            ChangeSaveNote = True
'        End If
'    Else
'            ChangeSaveNote = True
'    End If
    Dim blnT As Boolean
    Dim dtmDate1 As Date
    Dim intReturn As Integer
    Dim strMsg As String
    clsBill.SaveInput2Form
    If clsBill.blnIsChanged Then
        If Len(Trim(lblField(1).Caption)) = 0 Then
            strMsg = "该张" & lblCaption.Caption & "数据已经发生改变，是否需要保存？"
        Else
            strMsg = "“" & lblField(1).Caption & "”号" & lblCaption.Caption _
                & "数据已经发生改变，是否需要保存？"
        End If
        intReturn = ShowMsg(Me.hWnd, strMsg, MB_YESNOCANCEL + MB_DEFBUTTON1 _
            + MB_ICONQUESTION + MB_SYSTEMMODAL, "修改单据")
        If intReturn = IDYES Then
            blnT = SaveBill()
            If blnT Then
                clsBill.blnIsChanged = False
            End If
            ChangeSaveNote = blnT
        ElseIf intReturn = IDNO Then
            clsBill.blnIsChanged = False
            ChangeSaveNote = True
            If clsBill.lngNowID = 0 Then
                dtmDate1 = C2Date(lblField(2).Caption)
                clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
                clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
                blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
            End If
        Else
            blnT = False
        End If
    Else
        If clsBill.lngNowID = 0 Then
            dtmDate1 = C2Date(lblField(2).Caption)
            clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
            clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)   '会计期间
            blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
        End If
        ChangeSaveNote = True
    End If
End Function

Public Function getID() As Long
    If clsBill Is Nothing Then Exit Function
    getID = clsBill.lngNowID
End Function

Public Sub ResponseMessage()
    On Error GoTo EndProc
    Dim vntMessage As Variant
    Dim lngOldID As Long
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgItem Then  '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            lngOldID = refInput1.ID
            clsBill.AddReferOfItem
            refInput1.SeekId lngOldID
        End If
    Next
EndProc:
End Sub

Public Sub ShowAOldBill(ByVal lngID As Long)
    On Error GoTo ErrHandle
    Dim lngInID As Long, lngOutID As Long
    If cmdButton(0).Visible Then
    End If
    blnNotRaiseEvents = True
    If Me.Visible Then
        clsBill.cmdButton_Click 0
        If Not ChangeSaveNote Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
    End If
    
    FindOtherID lngID, lngInID, lngOutID
    
    Unload MsgForm
    clsBill.cmdButton_Click 0
    If clsBill Is Nothing Then Exit Sub
    clsBill.lngNowID = IIf(lngInID < lngOutID, lngInID, lngOutID)
    lngInActivityID = lngInID
    lngOutActivityID = lngOutID
    blnIsCanEventChk_Click = False
    lngVoucherID = 0
    LoadBill lngInID, lngOutID
    
    blnEdit = IsCanDo(EditNO(30))   '设置blnEdit标志
    blnView = IsCanDo(EditNO(30, False))   '设置blnView标志
    If blnEdit = False And blnView = False Then
        Unload MsgForm
        blnNotRaiseEvents