frmpayable.frm

金算盘软件代码

    If clsBill.blnGrdCellDoing Then Exit Sub
    If Not clsBill.cmdButton_Click(Index) Then GoTo EndProc
    clsBill.blnGrdCellDoing = True
    clsBill.blnKeyDown = False
    Select Case Index
        Case 0
            cmdNext_Click
        Case 1
            CmdPrev_Click
        Case 2
            cmdHome_Click
        Case 3
            CmdEnd_Click
        Case 4
            cmdOK_Click
            Exit Sub
        Case 5
'            TestData
            CmdCancel_Click
            Exit Sub
        Case 6
            BuildCancelBill True
        Case 7  '付款资料
            '------------------------------
            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
            frmPayableInfo.SetList Me, clsBill.lngNowID
        Case 8  '核销
            CmdReceive_Click
        Case 9  '关联凭证
            cmdVoucher_Click
        Case 10   '记事本
            CmdNote_Click
        Case 11 'Print
            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
'            frmdlPayment.SetParameters lngHeadDetailID
            frmdlInvoice.SetParameters lngHeadDetailID
            Set frmdlInvoice = Nothing
            ShowAOldBill clsBill.lngNowID
        Else
            ShowMsg Me.hWnd, "请重新选择应收或应付性质的科目再进行核销操作", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
            Exit Sub
        End If
    Else   'If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FPicture Or clsBill.bytRegion = FNote 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
'             frmdlPayment.SetParameters C2Lng(grdCol.TextMatrix(grdCol.Row, 0))
            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()
     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
    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 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()
    Dim i As Integer
    If clsBill.lngNowID <= 0 Then If clsBill.blnIsChanged = False Then Exit Sub
    
    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), True
            Exit Sub
        End If
    End If
'--------------------------------------
    Dim lngID As Long
    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 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
    Else
        ShowAOldBill lngID
    End If
End Sub

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

Private Sub cmdOK_Click()
    If Not SaveBill Then
        clsBill.blnGrdCellDoing = False
    Else
        clsBill.blnGrdCellDoing = False
        Unload Me
    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))) 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
'        lblmemo(0).Move LblBack.Left + 5 * Screen.TwipsPerPixelX, _
'                     lblmemo(0).top
'        lblmemo(3).Move LblBack.Left + LblBack.width - 3 * Screen.TwipsPerPixelX - lblmemo(3).width, _
'                   lblmemo(3).top - 1 * Screen.TwipsPerPixelY
'        lblmemo(2).Move lblmemo(3).Left - 3 * Screen.TwipsPerPixelX - lblmemo(2).width, _
'                          lblmemo(2).top
'        lblmemo(1).Move lblmemo(0).Left + lblmemo(0).width + 3 * Screen.TwipsPerPixelX, _
'                     lblmemo(2).top, _
'                     lblmemo(2).Left - 3 * Screen.TwipsPerPixelX - (lblmemo(0).Left + lblmemo(0).width + 3 * Screen.TwipsPerPixelX)
'        LblBack.Refresh
        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
    If Button = vbRightButton Then
        MakeListActivityMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListActivity
        clsBill.blnNotRespondKeyPress = False
    End If
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
End Sub

Private Sub GrdCol_RowColChange()
    clsBill.GrdCol_RowColChange
End Sub

Private Sub grdCol_Scroll()
    clsBill.grdCol_Scroll
End Sub

Private Sub imgPicDown_Click(Index As Integer)
    clsBill.picLblInput_Getfocus Index, True
End Sub

Private Sub LblBack_MouseDown(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.LblBack_MouseUp
    If Button = vbRightButton Then
        clsBill.blnGrdCellDoing = True
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
        clsBill.blnGrdCellDoing = True
        DoEvents
        clsBill.blnGrdCellDoing = False
    End If
End Sub

Private Sub lblField_MouseDown(Index As Integer, 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.Field_MouseUp Index, Button, x, y
    
    If Button = vbRightButton Then
        MakeListEditMenu
        clsBill.blnNotRespondKeyPress = True
        PopupMenu frmMain.mnuListEdit
        clsBill.blnNotRespondKeyPress = False
    End If
    clsBill.blnGrdCellDoing = True