frmpayment.frm

金算盘软件代码

    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
            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(2).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))) Then
        blnPrinted = True
        If clsBill.blnMayChanged = True And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
            clsBill.blnMayChanged = False
        End If
        If cmdButton(10).Enabled And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
            cmdButton(10).Enabled = False
        End If
        If WanNeng Then
            tblReceipt.Buttons(ToolBarIndex(10, Me.Name)).Enabled = cmdButton(10).Enabled
        End If
        clsBill.UpdateMainEditMenu
    End If
    Set myPrintclass = Nothing
End Sub

Private Sub CmdReceive_Click()
'核销
    
    Dim blnMark As AccountblnOther
    
    If GrdCol.Row < 1 And GrdCol.Rows > 1 Then
        If clsBill.blnLeftRight Then
            GrdCol.Row = 2
        Else
            GrdCol.Row = 1
        End If
    End If
    
    If GrdCol.Row < 1 Then
        ShowMsg Me.hWnd, "核销只能对一条具体的分录，请选择一分录再进行核销", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        Exit Sub
    End If
    '取出此科目的核算属性
    blnMark = blnOther(C2lng(GrdCol.TextMatrix(GrdCol.Row, 16)))
    
    If blnMark.blnIsCustomer = False Then
        ShowMsg Me.hWnd, "请选择一笔有单位属性的科目的分录再进行核销！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        Exit Sub
    ElseIf C2lng(GrdCol.TextMatrix(GrdCol.Row, 18)) < 1 Then
        ShowMsg Me.hWnd, "该笔分录的科目没有录入必要的单位，不能进行核销", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        Exit Sub
    End If
    
    If C2lng(GrdCol.TextMatrix(GrdCol.Row, 17)) < 1 Then
        ShowMsg Me.hWnd, "该笔分录没有相应的币种，不能进行核销", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        Exit Sub
    End If
    
    Screen.MousePointer = vbHourglass
    If Not SaveBill() Then
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    clsBill.blnIsChanged = False
    Screen.MousePointer = vbDefault
'    frmdlPayment.SetParameters C2Lng(grdCol.TextMatrix(grdCol.Row, 0))
    frmdlInvoice.SetParameters C2lng(GrdCol.TextMatrix(GrdCol.Row, 0))
    Set frmdlInvoice = Nothing
    ShowAOldBill clsBill.lngNowID
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(7 + 1).Enabled = False
        If WanNeng Then
            tblReceipt.Buttons(ToolBarIndex(8, Me.Name)).Enabled = cmdButton(8).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
    DoEvents
    clsBill.blnGrdCellDoing = False
End Sub


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

Private Sub lblHead_Change(Index As Integer)
    If Index = 5 Then
        refTmpID_Change
    End If
    If Index = 1 Then
        lblField(0).Caption = strDetailMsg(C2lng(lblHead(0).Tag))
    End If
    If Index = 3 Then
        If C2lng(lblHead(2).Tag) = 0 Then Exit Sub
        blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))   '设置blnEdit标志
        blnView = IsCanDo(EditNO(C2lng(lblHead(2).Tag), False))   '设置blnView标志
        '设置可修改标志
        If blnEdit And C2lng(LblMemo(3).Tag) = gclsBase.OperatorID Then
            clsBill.blnMayChanged = True
        Else
            clsBill.blnMayChanged = False
        End If
        chkPrint(0).Enabled = clsBill.blnMayChanged      '设置待打印按纽
        If chkPrint(1).Enabled Then
            chkPrint(1).Enabled = clsBill.blnMayChanged       '设置作废按纽
        End If
    End If
End Sub


Private Sub lblHead_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.UpdateMainEditMenu
    MakeListEditMenu
    Select Case Button
        Case vbRightButton
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            clsBill.blnNotRespondKeyPress = False
            GoTo EndProc
        Case vbLeftButton
            If (Index \ 2) * 2 = Index Then GoTo EndProc
            clsBill.blnGrdCellDoing = True
            If x >= lblHead(Index).width - clsBill.DropButtonWidth And _
               x <= lblHead(Index).width And _
               y >= 0 And _
               y <= lblHead(Index).Height Then
                clsBill.Head_Click Index, True
            Else
                clsBill.Head_Click Index, False
            End If
            clsBill.UpdateMainEditMenu
    End Select
EndProc:
    clsBill.blnGrdCellDoing = True
    DoEvents
    clsBill.blnGrdCellDoing = False
End Sub

Private Sub lblInput_Click(Index As Integer)
    clsBill.picLblInput_Getfocus Index
End Sub


Private Sub LblMemo_Click(Index As Integer)
    clsBill.Memo_Click Index
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID C2lng(Me.HelpContextID)
    ResponseMessage
    gclsSys.CurrFormName = Me.hWnd
    clsBill.UpdateMainEditMenu
    If WanNeng Then
        tblReceipt.Refresh
    End If
End Sub

Private Sub mclsMainControl_EditCopy()
    mclsMainControl_ListEditMenu (3)