frmsalesbill.frm

金算盘软件代码

        clsBill.blnChangeEvent = False
        chkPrint(1).Value = 1
        clsBill.blnIsChanged = True
        clsBill.blnChangeEvent = True
'        "本张"& lblcaption.Caption
        If chkPrint(2).Visible Then
            chkPrint(2).Enabled = False
            If chkPrint(3).Visible Then
                chkPrint(3).Enabled = False
            End If
        End If
        clsBill.cmdButtonEnabled(7) = False
        clsBill.cmdButtonEnabled(9) = False
        clsBill.cmdButtonEnabled(11) = False
        clsBill.cmdButtonEnabled(12) = False
        clsBill.cmdButtonEnabled(13) = False
        DrawAIcon GrdCol.hwnd, lblCaption.Left + lblCaption.width, GrdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
        clsBill.blnMayChange = False
    End If
    clsBill.UpdateMainEditMenu
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
End Sub
Private Sub chkPrint3_Click()
    If Not clsBill.blnChangeEvent Then Exit Sub
    clsBill.blnChangeEvent = False
    chkPrint(3).Value = 1 - chkPrint(3).Value
    clsBill.blnChangeEvent = True
'    clsBill.blnIsChanged = True
'    If chkPrint(3).Value = 0 Then
'    Else
        If SaveBill() = False Then
'            clsBill.blnChangeEvent = False
'            chkPrint(3).Value = 0
'            clsBill.blnChangeEvent = True
            Exit Sub
        End If
        Dim lngResult As Long
        
        lngResult = frmCashSettle.ShowMe(Me)
        If lngResult = 1 Then
            clsBill.blnChangeEvent = False
            chkPrint(3).Value = 1
            clsBill.blnChangeEvent = True
        ElseIf lngResult = -1 Then
            clsBill.blnChangeEvent = False
            chkPrint(3).Value = 0
            clsBill.blnChangeEvent = True
        End If
        clsBill.blnBillCanChange
'    End If
End Sub

Private Sub chkPrint_Click(Index As Integer)
    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
            chkPrint0_Click
        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 Then
        Exit Sub
    End If
    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 = -1 Then
               CmdPrev_Click
'               TestData2
            #Else
               CmdPrev_Click
            #End If
        Case 0
            Debug.Print "NEXTS:" & vbTab & Timer
            cmdNext_Click
            Debug.Print "NEXTE:" & 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
            blnNoClick = False
            clsBill.blnIsChanged = False
            Unload Me
            Exit Sub
        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
            End If
        Case 9
            '作废时退出
            If chkPrint(1).Value = 1 Then GoTo EndProc
            cmdbutton9_click
        Case 10  '工程费用
            '作废时退出
            If chkPrint(1).Value = 1 Then GoTo EndProc
            #If conVersionType = 16 Then    '财务版
            #Else
'                If Not clsBill.HeadFieldValid() Then GoTo EndProc
'                frmProjectCost.GivemeParameter Me
            #End If
        Case 11
            CmdSelect_Click
        Case 12
            CmdPay_Click
        Case 13
            clsBill.ShowCalcDisc
        Case 14
            CmdInvoice_Click
        Case 15
            CmdNote_Click
        Case 16
            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 13, 14, 16, 19
    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) = 20 Then
        Else
            If clsBill.blnMayChange = False Or blnEdit = False Then
                Exit Sub
            End If
        End If
        If C2lng(lblHead(2).Tag) <> 14 Then
            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
        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) = 20 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.WriteTotalRow
                clsBill.blnIsChanged = True
                clsBill.ModiRateReadOnly
            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
            ShowAOldBill lngID
        End If
    Else
        If clsBill.blnIsChanged Then
            If Not SaveBill() Then Exit Sub
        End If
            ShowANewTypeBill C2lng(lblHead(3 - 1).Tag)
    End If
End Sub

Private Sub CmdNote_Click()
    If C2lng(lblHead(0).Tag) = 0 Then
        clsBill.ShowMsgOther Me.hwnd, "无单位信息，记事簿不可用！", MB_SYSTEMMODAL, "记事簿"
    End If