frmpayable.frm

金算盘软件代码

    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
    Select Case Button
        Case vbRightButton
            clsBill.UpdateMainEditMenu
           MakeListEditMenu
            clsBill.blnNotRespondKeyPress = True
            PopupMenu frmMain.mnuListEdit
            clsBill.blnNotRespondKeyPress = False
            GoTo EndProc
        Case vbLeftButton
            If (Index \ 2) * 2 = Index Then GoTo EndProc
            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)
End Sub

Private Sub mclsMainControl_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub

Private Sub mclsMainControl_EditDelLine()
    mclsMainControl_ListActivityMenu (1)
End Sub

Private Sub mclsMainControl_EditInActive()
    If chkPrint(1).Value <> 0 Then
        chkPrint(1).Value = 0
    Else
        chkPrint(1).Value = 1
    End If
'    frmMain.mnuEditInActive.Checked = chkPrint(1).Value
    clsBill.UpdateMainEditMenu
End Sub

Private Sub mclsMainControl_EditInsLine()
    mclsMainControl_ListActivityMenu (0)
End Sub

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditPaste()
    mclsMainControl_ListEditMenu (4)
End Sub

Private Sub mclsMainControl_EditSearch()
    mclsMainControl_ListEditMenu (6)
End Sub

Private Sub mclsMainControl_EditShowAll()
    If chkPrint(0).Value <> 0 Then
        chkPrint(0).Value = 0
    Else
        chkPrint(0).Value = 1
    End If
End Sub

Private Sub mclsMainControl_EditShowList()
    ShowRelationList
End Sub

Private Sub mclsMainControl_FilePrint()
    CmdPrint_Click
End Sub
Private Sub mclsMainControl_FilePrintReceipt()
    If clsBill.lngNowID > 0 Then
        If clsBill.blnIsChanged Then
            If SaveBill() = False Then Exit Sub
        End If
    End If
    PrintReceipt C2lng(lblHead(2).Tag)
End Sub


Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String, strMsg1(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    clsBill.blnKeyDown = False
    strMsg1(0) = "确实要删除该条应付单记录吗?"
    strMsg1(1) = "确实要删除该条已经作废应付单记录吗?"
    strMsg1(2) = "该张应付单已经收款,删除将要影响对应的收款单记录,确实要删除该条应付单记录吗?"
    strMsg1(3) = "该张应付单已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张应付单已经生成记帐凭证,不能修改!"
    Select Case intIndex
        Case 0  '插入记录
            clsBill.InsertTheRow
        Case 1  '删除记录
            If clsLst.IsVoucher(clsBill.lngNowID) Then
                ShowMsg Me.hWnd, strMsg1(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                clsBill.SetAFocus
                Exit Sub
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            ElseIf BillPublic.ActivityIsHX(clsBill.lngNowID) Then
                intYesNo = ShowMsg(Me.hWnd, strMsg1(2), MB_YESNO + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "警告信息")
            Else
                intYesNo = ShowMsg(Me.hWnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            End If
            If intYesNo = IDYES Then
                clsBill.DelTheRow
            Else
                clsBill.SetAFocus
            End If
        Case 2  'bar
        Case 3  '复制记录
            clsBill.CopyTheRow
        Case 4  '粘贴记录
            clsBill.PasteTheRow
        Case 5  'Bar
        Case 6  '搜索
            frmTreeFind.ShowFind
            If clsBill.bytRegion = FPicture Then
                GrdCol.Refresh
            End If
        Case 7  '查询缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag)
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            If clsBill.bytRegion = FPicture Then
                GrdCol.Refresh
            End If
            clsBill.SetAFocus
        Case 9  'Sound
            clsBill.blnSound = Not clsBill.blnSound
            SaveSetting App.title, "13" + gclsBase.OperatorID, "Sound_Payable", IIf(clsBill.blnSound, "True", "False")
        Case 10 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "13" + gclsBase.OperatorID, "Tell_Payable", IIf(clsBill.blnTell, "True", "False")
        Case 12 '金额线显示变化
            clsBill.CashLineDisplay
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim intK As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张应付单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废的应付单吗?"
    strMsg(2) = "该张应付单已经收款,删除将要影响对应的收款单记录,确实要删除该张应付单全部记录吗?"
    strMsg(3) = "该张应付单已经生成记帐凭证,不能删除!"
    strMsg(4) = "该张应付单已经生成记帐凭证,不能修改!"
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0, 3, 4
            If clsBill.cmdButton_Click(0) = False Then Exit Sub
        Case 1
            If clsBill.SaveInput2Form = False Then Exit Sub
    End Select
    Select Case intIndex
        Case 0  '插入单据
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            If Not ChangeSaveNote() Then Exit Sub
            ShowANewBill
            'clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(1).Caption
        Case 1  '删除单据
            clsLst.theType = 4
            intK = clsLst.IsVoucher(clsBill.lngNowID)
            If intK = 1 Then
                ShowMsg Me.hWnd, strMsg(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                clsBill.SetAFocus
                Exit Sub
            ElseIf intK = -1 Then
                clsBill.lngNowID = 0
                clsBill.SetAFocus
                Exit Sub
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = IDYES 'ShowMsg(Me.hwnd, strMsg(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
            ElseIf BillPublic.ActivityIsHX(clsBill.lngNowID) Then
                intYesNo = ShowMsg(Me.hWnd, strMsg(2), MB_YESNO + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "警告信息")
            Else
'                intYesNo = ShowMsg(Me.hwnd, strMsg(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息")
                 intYesNo = IDYES
            End If
            If intYesNo = IDYES Then
                 If clsBill.DelTheBill(clsBill.lngNowID, 4) Then
                    cmdNext_Click
                 Else
'                    ShowMsg Me.hwnd, "Delete Error!!", MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                     clsBill.SetAFocus
                     Exit Sub
                 End If
            End If
            
        Case 2  'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
        Case 5  'BAR
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询单据缺号
            frmBillNo.ShowTypeID C2lng(lblHead(3 - 1).Tag)
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 9  'ModifyColWidthDefault
            BillPublic.ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            picFooter.Refresh
        Case 11 'Sound
            clsBill.blnSound = Not clsBill.blnSound
            SaveSetting App.title, "13" + gclsBase.OperatorID, "Sound_Payable", IIf(clsBill.blnSound, "True", "False")
        Case 12 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "13" + gclsBase.OperatorID, "Tell_Payable", IIf(clsBill.blnTell, "True", "False")
        Case 14 '金额线显示变化
            clsBill.CashLineDisplay
        Case 16 '筛选
            mclsMainControl_EditFilter
        Case 17 'list
            mclsMainControl_ReceiptList
        Case 18 'list
            mclsMainControl_ReceiptPosition
        Case 19
            mclsMainControl_FilePrintReceipt
    End Select
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList C2lng(lblHead(2).Tag), False
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList C2lng(lblHead(2).Tag), True
End Sub

Private Sub mclsMainControl_ReceiptPosition()
    BuildCancelBill False
End Sub
'单据冲销
Private Sub BuildCancelBill(Optional ByVal GenCancel As Boolean = True)
    Dim lngOldID As Long
    clsBill.blnKeyDown = False
    If ChangeSaveNote() = False Then
        Exit Sub
    End If
    If GenCancel Then
        lngOldID = frmWriteOffBill.WriteOffBill(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hWnd)
    Else
        lngOldID = frmWriteOffBill.SeekBill(C2lng(lblHead(2).Tag), clsBill.lngNowID, Me.hWnd)
    End If
    If lngOldID = 0 Then
    Else
        ShowAOldBill lngOldID, GenCancel
    End If
End Sub
Private Sub refTmpID_Change()
    clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub


'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    clsBill.UpdateMainEditMenu
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        If blnEdit = False Then
            .mnuEditNew.Enabled = False
        Else
            .mnuEditNew.Enabled = True
        End If
                
        Load .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Load .mnuListEditMenu(3)
        Load .mnuListEditMenu(4)
        Load .mnuListEditMenu(5)
        Load .mnuListEditMenu(6)
        Load .mnuListEditMenu(7)
        Load .mnuListEditMenu(8)
        Load .mnuListEd