frmstockbill.frm

金算盘软件代码

    Dim bytChkValue1 As Byte
    If clsBill.blnChangeEvent = False Then Exit Sub
    
    If Index > 0 And Not IsCanDo(EditNO(C2lng(lblHead(2).Tag))) Then Exit Sub
    clsBill.CHK_CLICK Index
    
    Select Case Index
        Case 0  '待打印
            clsBill.blnIsChanged = True
        Case 1   '作废
            chkPrint1_Click
        Case 2  '已开发票
           If Not blnChkNotClick Then clsBill.InvoiceWithBill IIf(chkPrint(2).Value = 1, True, False)
        Case 3  '现结
            chkPrint3_Click
    End Select
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If blnNoClick = True Then
        Debug.Print "Exit " & time & vbTab & Index
        Exit Sub
    End If
'    Debug.Print time & vbTab & Index
    blnNoClick = True
    If Index <> 5 Then
        If Not clsBill.cmdButton_Click(Index) Then
            GoTo EndProc
        End If
    End If
    Select Case Index
        Case 1
            #If conDebug Then
'                frmSelectBill.ShowMe Me
                CmdPrev_Click
            #Else
                Debug.Print "STime" & vbTab & Timer
                CmdPrev_Click
                Debug.Print "ETime" & vbTab & Timer
            #End If
        Case 0
            Debug.Print "STime" & vbTab & Timer
            cmdNext_Click
            Debug.Print "ETime" & vbTab & Timer
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
                If SaveBill() Then
                    DoEvents
                    blnNoClick = False
                    Unload Me
                    Exit Sub
                End If
        Case 5
            clsBill.blnIsChanged = False
            blnNoClick = False
            Unload Me
        Case 6
            If clsBill.blnIsChanged Then
                If Not SaveBill() Then
                    GoTo EndProc
                End If
            End If
'            If clsBill.SourceActivityID <> 0 Then
'                If blnDelWriteOffBillNote(Me.hwnd, C2lng(lblHead(2).Tag), clsBill.lngNowID, "其它") = False Then
'                    Exit Sub
'                End If
'            End If
'            If clsBill.lngNowID = 0 Then
'                blnMaxNODecrease gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), strDigitOfStr(LTrim(strNewReceiptNO))
'            End If
            Dim lngTmp As Long
'            If chkPrint(1).Value = 1 Then
'                lngTmp = frmWriteOffBill.WriteOffBill(C2lng(lblHead(2).Tag), Me.hwnd)
'            Else
                lngTmp = frmWriteOffBill.WriteOffBill(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hwnd)
'            End If
            If lngTmp = 0 Then GoTo EndProc
            If lngTmp <> clsBill.lngNowID Then
                ShowAOldBill lngTmp, True
            Else
                clsBill.WriteOffBill
                If lblHead(1).Visible Then
                    clsBill.Head_Click 1
                Else
                    clsBill.Field_Click 2
                End If
            End If
            strNewReceiptNO = lblField(1).Caption
            NewReceiptDate = C2Date(lblField(2).Caption)
'            blnAlertMenuChecked = False
        Case 7
            '作废时退出
            If chkPrint(1).Value = 1 Then GoTo EndProc
            cmdbutton7_click
        Case 8
            Dim lngID As Long
            lngID = ActivityIdToVoucherId(clsBill.lngNowID, True)
            If lngID <> 0 Then
                FrmVoucher.ShowAOldBill lngID
            Else
                clsBill.ShowMsgOther Me.hwnd, "对应凭证已被删除或作废，关联失败！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "关联凭证"
                clsBill.cmdButtonEnabled(8) = False
                If C2lng(lblHead(2).Tag) = 6 Then
                    clsBill.cmdButtonEnabled(7) = IIf(chkPrint(1).Value = 1, False, True)
                End If
            End If
        Case 9
            '作废时退出
            If chkPrint(1).Value = 1 Then GoTo EndProc
            cmdbutton9_click
        Case 10
            CmdSelect_Click
        Case 11
            CmdPay_Click
        Case 12
            CmdInvoice_Click
        Case 13
            CmdNote_Click
        Case 14
            CmdPrint_Click
    End Select
EndProc:
    If Index <> 5 Then
        DoEvents
        blnNoClick = False
        If Not clsBill Is Nothing Then
         clsBill.ReSetFocus
        End If
    End If
End Sub
Private Sub CmdInvoice_Click()
    Select Case C2lng(lblHead(2).Tag)
    Case 2, 3, 5, 7
    Case 8
        #If conVersionType <> 16 Then
            frmInvoiceSettle.ShowMe Me
        #End If
        Exit Sub
    Case Else
        Exit Sub
    End Select
    If chkPrint(2).Visible Then
        If chkPrint(2).Value = 1 Then
            Exit Sub
        End If
    End If
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    If clsBill.lngNowID <= 0 Then Exit Sub
    If GrdCol.Row < 1 Then
        clsBill.ShowMsgOther Me.hwnd, "请选择一条分录！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "发票核销"
        Exit Sub
    End If
    If C2lng(GrdCol.TextMatrix(GrdCol.Row, 0)) <= 0 Then
        clsBill.ShowMsgOther Me.hwnd, "请选择一条分录！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "发票核销"
        Exit Sub
    End If

    #If conVersionType <> 16 Then
        frmSettleInvoice.GivemeParameter C2lng(GrdCol.TextMatrix(GrdCol.Row, 0))
    #End If
End Sub

Private Sub CmdPay_Click()
'    If clsBill.blnIsChanged Then
'        If Not SaveBill() Then Exit Sub
'    End If
'    If clsBill.lngNowID = 0 Then Exit Sub
'    If clsBill.lngNowID = 0 Then
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
'    End If
    If clsBill.lngNowID = 0 Then Exit Sub
    If GrdCol.Row = 0 Then
        clsBill.ShowMsgOther Me.hwnd, "请选择一条分录！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应付核销"
        Exit Sub
    End If
    If C2lng(clsBill.TextOfGrid(GrdCol.Row, 0)) = 0 Then
        If C2lng(clsBill.TextOfGrid(GrdCol.Row, 28)) <> 0 Then
            clsBill.ShowMsgOther Me.hwnd, "第" & GrdCol.Row & "条分录没有保存，不能核销！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应付核销"
        Else
            clsBill.ShowMsgOther Me.hwnd, "请选择一条分录！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "应收核销"
        End If
        Exit Sub
    End If
    frmdlInvoice.SetItemActivity C2lng(clsBill.TextOfGrid(GrdCol.Row, 0))
End Sub
Private Sub CmdSelect_Click()
    #If conVersionType <> 16 Then
        If C2lng(lblHead(2).Tag) = 8 Then
        Else
            If clsBill.blnMayChange = False Or blnEdit = False Then
                Exit Sub
            End If
        End If
        If C2lng(lblHead(0).Tag) = 0 Then
            clsBill.ShowMsgOther Me.hwnd, "请先选择单位！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择单据"
            clsBill.Head_Click 1
            Exit Sub
        End If
        If clsBill.getFieldID(7) = 0 Then
            clsBill.ShowMsgOther Me.hwnd, "请先选择币种！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择单据"
            If lblField(7).Visible Then
                clsBill.Field_Click 7
            End If
            Exit Sub
        End If
        If C2lng(lblHead(2).Tag) = 8 Then
            Dim i As Long
            For i = 1 To GrdCol.Rows - 1
                If C2lng(TextOfGrid(i, 28)) <> 0 Then
                    Exit For
                End If
            Next
            If i <> GrdCol.Rows Then
                If C2lng(TextOfGrid(GrdCol.Row, 28)) = 0 Then
                    clsBill.ShowMsgOther Me.hwnd, "请选择一条分录！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择单据"
                    Exit Sub
                End If
                If SaveBill() = False Then
                    Exit Sub
                End If
            Else
                '简单判断
                If clsBill.blnMayChange Then
                    If clsBill.DataValid(True) = False Then
                        Exit Sub
                    End If
                End If
                SetGridRows 1
            End If
            
            If GrdCol.Rows > 1 Then
                If frmInvoiceSelect.ShowMe(Me, Not clsBill.blnMayChange, GrdCol.Row) Then
                    clsBill.SetBlnSelceted True
                     clsBill.ModiRateReadOnly
                    clsBill.WriteTotalRow
        '            clsBill.blnIsChanged = True
                End If
            Else
                If frmInvoiceSelect.ShowMe(Me, Not clsBill.blnMayChange) Then
                    clsBill.SetBlnSelceted True
                     clsBill.ModiRateReadOnly
                    clsBill.WriteTotalRow
        '            clsBill.blnIsChanged = True
                End If
            End If
        Else
            If frmSelectBill.ShowMe(Me) Then
                 clsBill.ModiRateReadOnly
                clsBill.WriteTotalRow
                clsBill.blnIsChanged = True
            End If
        End If
    #End If
End Sub
Private Sub CmdEnd_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 3, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdHome_Click()
    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If blnView Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 2, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub cmdNext_Click()
    If clsBill.lngNowID <> 0 Then
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        Dim lngID As Long
        If IsCanDo(EditNO(C2lng(lblHead(2).Tag), False)) Then
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1)
        Else
            lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 1, C2lng(LblMemo(LblMemo.Count - 1).Tag))
        End If
    
        If lngID < 1 And clsBill.lngNowID <> 0 Then
    '        If blnEdit Then clsBill.GetANewBill C2Lng(lblHead(5 - 1).Tag), C2Lng(lblHead(3 - 1).Tag), lblField(1).Caption
    '        cmdButton(11).Enabled = False
    '        Exit Sub
            ShowANewTypeBill C2lng(lblHead(3 - 1).Tag)
        ElseIf lngID > 0 Then
        Debug.Print "LTime:" & vbTab & time
        ShowAOldBill lngID
        End If
    Else
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
        Debug.Print "GetANewBill" & vbTab & Timer
        ShowANewTypeBill C2lng(lblHead(3 - 1).Tag)
    End If
End Sub

Private Sub CmdNote_Click()
    showNotePad C2lng(lblHead(0).Tag)
End Sub
Private Sub CmdPrev_Click()
'    If Not ChangeSaveNote() Then Exit Sub
    Dim lngID As Long
    If IsCanDo(EditNO(C2lng(lblHead(2).Tag), False)) Then
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0, C2lng(LblMemo(LblMemo.Count - 1).Tag))
    End If
    If lngID = 0 Then Exit Sub
    Debug.Print "LTime:" & vbTab & time
    ShowAOldBill lngID
End Sub

Private Sub CmdPrint_Click()
    If clsBill.blnIsChanged Then
        If Not SaveBill() Then Exit Sub
    End If
    If clsBill.lngNowID = 0 Then
        clsBill.ShowMsgOther Me.hwnd, "单据为空，无可打印信息！", MB_OK + MB_SYSTEMMODAL + MB_ICONINFORMATION, "打印单据"
        Exit Sub
    End If

    If clsBill.blnIsPrinted Then
      If clsBill.blnPrintPrintedBill Then
         If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经打印，您确实要打印吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据") = vbNo Then
            Exit Sub
         End If
      Else
         clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经打印，不能再打印！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "打印单据"
         Exit Sub
      End If
    End If
          
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    Dim blnTmp As Boolean
    Dim lngTmp As Long
    lngTmp = getPrintIDofTemplateID(C2lng(lblHead(4).Tag), blnTmp)
    If blnTmp Then
         If myPrintclass.PrintSameItemReceipt(gclsBase.BaseDB, C2lng(ReceiptTypeID), C2lng(lblHead(2).Tag), CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(C2lng(lblHead(2).Tag))) Then
            If chkPrint(0).Value <> 0 Then
                clsBill.blnChangeEvent = False
                chkPrint(0).Value = 0
                clsBill.blnChangeEvent = True
            End If
            clsBill.blnIsPrinted = True
         End If
    Else
'         myPrintclass.PrintReceipt gclsBase.BaseDB, C2lng(ReceiptTypeID), CStr(clsBill.lngNowID), lngTmp
         If myPrintclass.PrintReceiptSingle(gclsBase.BaseDB, C2lng(ReceiptTypeID), C2lng(lblHead(2).Tag), CStr(clsBill.lngNowID), lngTmp, BillRePrintRight(C2lng(lblHead(2).Tag))) Then
            If chkPrint(0).Value <> 0 Then
                clsBill.blnChangeEvent = False
                chkPrint(0).Value = 0
                clsBill.blnChangeEvent = True
            End If
            clsBill.blnIsPrinted = True
         End If
    End If
    Set myPrintclass = Nothing
End Sub