frminvoice.frm

金算盘软件代码

        If WanNeng Then
           tblReceipt.Buttons(ToolBarIndex(8, Me.Name)).Enabled = Cmdbutton(8).Enabled
        End If
        Cmdbutton(6 + 1).Enabled = True
        If WanNeng Then
           tblReceipt.Buttons(ToolBarIndex(7, Me.Name)).Enabled = Cmdbutton(7).Enabled
        End If
        RefreshRect Me.hwnd, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2 + 140 * Screen.TwipsPerPixelX, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2 + 70 * Screen.TwipsPerPixelY
    Else
        RefreshRect Me.hwnd, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2, GrdCol.Left + (GrdCol.width - 140 * Screen.TwipsPerPixelX) / 2 + 140 * Screen.TwipsPerPixelX, GrdCol.top + (GrdCol.Height + 1.5 * GrdCol.RowHeight(0) - 70 * Screen.TwipsPerPixelY) / 2 + 70 * Screen.TwipsPerPixelY
        Cmdbutton(7 + 1).Enabled = False
        If WanNeng Then
           tblReceipt.Buttons(ToolBarIndex(8, Me.Name)).Enabled = Cmdbutton(8).Enabled
        End If
        Cmdbutton(6 + 1).Enabled = False
        If WanNeng Then
           tblReceipt.Buttons(ToolBarIndex(7, Me.Name)).Enabled = Cmdbutton(7).Enabled
        End If
    End If
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
EndProc:
    Erase lngWriteOffID
End Sub

Private Sub chkPrint_Click(Index As Integer)
    If clsBill Is Nothing Then Exit Sub

    clsBill.CHK_CLICK Index
'    If clsBill.blnMayChanged = False Then Exit Sub
    Select Case Index
        Case 0
            chkPrint0_Click
        Case 1
            chkPrint1_Click
    End Select
    clsBill.SetAFocus
End Sub

Private Sub cmdButton_Click(Index As Integer)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnNotRaiseEvent Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    If Not clsBill.cmdButton_Click(Index) Then GoTo EndProc
    Select Case Index
        Case 0
            clsBill.blnKeyDown = False
            cmdNext_Click
        Case 1
            clsBill.blnKeyDown = False
            CmdPrev_Click
        Case 2
            clsBill.blnKeyDown = False
            cmdHome_Click
        Case 3
            clsBill.blnKeyDown = False
            CmdEnd_Click
        Case 4
            clsBill.blnKeyDown = False
            cmdOK_Click
            Exit Sub
        Case 5
'            TestData
            clsBill.blnKeyDown = False
            CmdCancel_Click
            Exit Sub
        Case 6 '冲销
            clsBill.blnKeyDown = False
            BuildCancelBill True
        Case 7      '回款资料
            '------------------------------
            clsBill.blnKeyDown = False
            Screen.MousePointer = vbHourglass
            If Not SaveBill() Then
                Screen.MousePointer = vbDefault
                GoTo EndProc
            End If
            clsBill.blnIsChanged = False
            Screen.MousePointer = vbDefault
            If GrdCol.Rows = GrdCol.FixedRows Then GoTo EndProc
            frmInvoiceInfo.SetList FrmInvoice, clsBill.lngNowID
        Case 8      '核销
            clsBill.blnKeyDown = False
            CmdReceive_Click
        Case 9      '关联凭证
            clsBill.blnKeyDown = False
            cmdVoucher_Click
        Case 10  '记事本
            clsBill.blnKeyDown = False
            CmdNote_Click
        Case 11 '打印
            clsBill.blnKeyDown = False
            CmdPrint_Click
    End Select
EndProc:
    If clsBill Is Nothing Then Exit Sub
    clsBill.blnGrdCellDoing = True
        DoEvents
    clsBill.blnGrdCellDoing = False
    clsBill.SetAFocus
End Sub
Private Sub CmdReceive_Click()
    Dim intRegion As Integer
    Dim lngCusID As Long
    Dim lngCurID As Long
    Dim dblAmount As Double
    Dim blnMark As AccountblnOther
    
    '核销
    '------------------------------
    Screen.MousePointer = vbHourglass
    If Not SaveBill() Then
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    clsBill.blnIsChanged = False
    Screen.MousePointer = vbDefault
    '默认为对表头部分的核销
    
    If clsBill.LastRegion <> FGrid Then
        blnMark = blnOther(clsBill.getFieldID(5))
        If blnMark.intAccountNatureID = 3 Or blnMark.intAccountNatureID = 4 Then
            lngCusID = C2lng(lblHead(0).Tag)
            lngCurID = clsBill.getFieldID(12)
            dblAmount = C2Dbl(GetLabel(lblField(10)))
            If lngCusID < 1 Then
                ShowMsg Me.hwnd, "请指定必要的单位后再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
                Exit Sub
            End If
            If lngCurID < 1 Then
                ShowMsg Me.hwnd, "请指定必要的币种后再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
                Exit Sub
            End If
            frmdlInvoice.SetParameters lngHeadDetailID
            Set frmdlInvoice = Nothing
            ShowAOldBill clsBill.lngNowID
        Else
            ShowMsg Me.hwnd, "请重新选择应收或应付性质的科目再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
            Exit Sub
        End If
    Else    'If clsBill.LastRegion = FGrid Then
        blnMark = blnOther(C2lng(GrdCol.TextMatrix(GrdCol.Row, 16)))
        If blnMark.intAccountNatureID = 3 Or blnMark.intAccountNatureID = 4 Then
            lngCusID = C2lng(GrdCol.TextMatrix(GrdCol.Row, 18))
            lngCurID = C2lng(GrdCol.TextMatrix(GrdCol.Row, 17))
            dblAmount = C2Dbl(clsBill.strGrdCell(GrdCol.Row, 9))
            If lngCusID < 1 Then
                ShowMsg Me.hwnd, "请指定必要的单位后再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
                Exit Sub
            End If
            If lngCurID < 1 Then
                ShowMsg Me.hwnd, "请指定必要的币种后再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
                Exit Sub
            End If
            frmdlInvoice.SetParameters C2lng(GrdCol.TextMatrix(GrdCol.Row, 0))
            Set frmdlInvoice = Nothing
            ShowAOldBill clsBill.lngNowID
        Else
            ShowMsg Me.hwnd, "请重新选择应收或应付性质的科目再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
            Exit Sub
        End If
    End If
End Sub
Private Sub CmdCancel_Click()
    Screen.MousePointer = vbDefault
    clsBill.blnIsChanged = False
    clsBill.blnGrdCellDoing = False
    Unload Me
End Sub
Private Sub CmdEnd_Click()
    Dim i As Integer
    If Not ChangeSaveNote Then Exit Sub
    
    Dim lngID As Long
    lngYID = C2lng(lblHead(2).Tag)
    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(3).Tag))
    End If
    
    If lngID = 0 Then
'        If lngYID = 38 Then
        If lngYID = 99 Then
'            ShowMsg Me.hwnd, "没有可以显示的应收计息单据！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
            Exit Sub
        End If
        If blnEdit Then clsBill.GetANewBill C2lng(lblHead(5 - 1).Tag), C2lng(lblHead(3 - 1).Tag), lblField(1).Caption, True
        mlngItemActivityID = 0
        Exit Sub
    End If
    ShowAOldBill lngID
    
End Sub

Private Sub cmdHome_Click()
    Dim i As Integer
    
    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(3).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 = False Then Exit Sub
    
    Dim i As Integer
    Dim blnNewBill As Boolean
    If clsBill.lngNowID = 0 Then blnNewBill = True
    
    If Not SaveBill() Then Exit Sub
'--------------------------------------
    If blnNewBill Then
        If blnEdit Then
            If Not ChangeSaveNote() Then Exit Sub
                ShowANewBill
                'clsBill.GetANewBill C2lng(lblHead(5 - 1).Tag), C2lng(lblHead(3 - 1).Tag), lblField(1).Caption, True
            Exit Sub
        End If
    End If
'--------------------------------------
    Dim lngID As Long
        
    lngYID = C2lng(lblHead(2).Tag)
    If blnView 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(3).Tag))
    End If
    If lngID < 1 Then
        If lngYID = 99 Then
'            ShowMsg Me.hwnd, "没有可以显示的应收计息单据！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
            Exit Sub
        End If

        If blnEdit Then
            If Not ChangeSaveNote() Then Exit Sub
            ShowANewTypeBill C2lng(lblHead(3 - 1).Tag)
            'clsBill.GetANewBill C2lng(lblHead(5 - 1).Tag), C2lng(lblHead(3 - 1).Tag), lblField(1).Caption, True
            Exit Sub
        End If
    Else
        ShowAOldBill lngID
    End If
End Sub

Private Sub CmdNote_Click()
    showNotePad (C2lng(lblHead(0).Tag))
End Sub

Private Sub cmdOK_Click()
    If SaveBill() Then
        clsBill.blnGrdCellDoing = False
        Unload Me
    Else
        clsBill.blnGrdCellDoing = False
    End If
End Sub

Private Sub CmdPrev_Click()
    Dim i As Integer
    
'    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, 0)
    Else
        lngID = lngOtherBill(C2lng(lblHead(2).Tag), C2Date(lblField(2).Caption), lblField(1).Caption, 0, C2lng(LblMemo(3).Tag))
    End If
    
    If lngID = 0 Then Exit Sub
    ShowAOldBill lngID
End Sub

Private Sub CmdPrint_Click()
   If GrdCol.Rows = GrdCol.FixedRows Then Exit Sub
   If Not SaveBill() Then
        Exit Sub
   End If
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    If myPrintclass.PrintReceipt(gclsBase.BaseDB, C2lng(ReceiptTypeID), C2lng(lblHead(2).Tag), CStr(clsBill.lngNowID), BillPublic.getPrintIDofTemplateID(C2lng(lblHead(4).Tag)), BillRePrintRight(C2lng(lblHead(2).Tag))) = True Then
        blnPrinted = True
        If clsBill.blnMayChanged = True And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
            clsBill.blnMayChanged = False
        End If
        If Cmdbutton(11).Enabled And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
            Cmdbutton(11).Enabled = False
        End If
        If WanNeng Then
            tblReceipt.Buttons(ToolBarIndex(11, Me.Name)).Enabled = Cmdbutton(11).Enabled
        End If
        clsBill.UpdateMainEditMenu
    End If
    Set myPrintclass = Nothing
End Sub

Private Sub cmdVoucher_Click()
    If clsBill.blnVoucher(clsBill.lngNowID) Then
        FrmVoucher.ShowAOldBill clsBill.lngVoucherID
    Else
        ShowMsg Me.hwnd, "凭证不存在！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        Cmdbutton(8 + 1).Enabled = False
        If WanNeng Then
           tblReceipt.Buttons(ToolBarIndex(9, Me.Name)).Enabled = Cmdbutton(9).Enabled
        End If
        clsBill.blnHaveISVoucher = False
        clsBill.lngVoucherID = 0
    End If
End Sub

Private Sub Col_GotFocus()
    Call clsBill.colButton_GotFocus(0)
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    clsBill.UpdateMainEditMenu
    gclsSys.CurrFormName = Me.hwnd
    If clsBill.blnNotFormActive Then
        clsBill.MoveMemo
        clsBill.blnNotFormActive = False
        Exit Sub
    End If
    Form_Resize
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    
    If mclsMainControl Is Nothing Then Exit Sub
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgAccount Then '接收到科目改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
            '刷新科目
            Call clsBill.RefreshRecordset(0)
        End If
        If vntMessage = Message.msgCustomer Then '接收到单位改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
            '刷新单位
            Call clsBill.RefreshRecordset(1)
        End If
    Next

End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If clsBill Is Nothing Then Exit Sub
    If clsBill.blnGrdCellDoing Then Exit Sub
    clsBill.blnGrdCellDoing = True
    clsBill.GrdCol_Mouseup Button, Shift, x, y