frmreceive.frm

金算盘软件代码

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%
    strMsg1(0) = "确实要删除该条收款单记录吗?"
    strMsg1(1) = "确实要删除该条已经作废收款单记录吗?"
    strMsg1(2) = "该张收款单已经收款,删除将要影响对应的收款单记录,确实要删除该条收款单记录吗?"
    strMsg1(3) = "该张收款单已经生成记帐凭证,不能删除!"
    strMsg1(4) = "该张收款单已经生成记帐凭证,不能修改!"
    clsBill.blnKeyDown = False
    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, "警告信息"
                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
            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)  'ReceiptTypeID
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            If clsBill.bytRegion = FPicture Then
                GrdCol.Refresh
            End If
        Case 9  'Sound
            clsBill.blnSound = Not clsBill.blnSound
            SaveSetting App.title, "16" + CStr(gclsBase.OperatorID), "Sound_Receive", IIf(clsBill.blnSound, "True", "False")
        Case 10 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "16" + CStr(gclsBase.OperatorID), "Tell_Receive", 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 = 1
            intK = clsLst.IsVoucher(clsBill.lngNowID)
            If intK = 1 Then
                ShowMsg Me.hWnd, strMsg(3), MB_ICONQUESTION + MB_DEFBUTTON1 + MB_SYSTEMMODAL, "警告信息"
                Exit Sub
            ElseIf intK = -1 Then
                clsBill.lngNowID = 0
                Exit Sub
            End If
            If chkPrint(1).Value = 1 Then
                intYesNo = IDYES
            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, 1) Then
'                    cmdNext_Click
                Else
                    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 40
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
        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, "16" + CStr(gclsBase.OperatorID), "Sound_Receive", IIf(clsBill.blnSound, "True", "False")
        Case 12 'Tell
            clsBill.blnTell = Not clsBill.blnTell
            SaveSetting App.title, "16" + CStr(gclsBase.OperatorID), "Tell_Receive", IIf(clsBill.blnTell, "True", "False")
        Case 14 '金额线显示变化
            clsBill.CashLineDisplay
        Case 16 '筛选
            mclsMainControl_EditFilter
        Case 17 'LIST
            mclsMainControl_ReceiptList
        Case 18 'Go
            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 Then
            .mnuEditNew.Enabled = True
        Else
            .mnuEditNew.Enabled = False
        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 .mnuListEditMenu(9)
        Load .mnuListEditMenu(10)
        Load .mnuListEditMenu(11)
        Load .mnuListEditMenu(12)
        Load .mnuListEditMenu(13)
        Load .mnuListEditMenu(14)
        Load .mnuListEditMenu(15)
        Load .mnuListEditMenu(16)
        Load .mnuListEditMenu(17)
        Load .mnuListEditMenu(18)
        Load .mnuListEditMenu(19)
        .mnuListEditMenu(19).Caption = "成批打印(&Y)"        '
        .mnuListEditMenu(19).Enabled = True
        
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(0)  '新增
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(1)  '删除
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(2) '----
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(13) '----
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(15) '----
        
        .mnuListEditMenu(0).Caption = "新增单据(&N)"
        .mnuListEditMenu(1).Caption = "删除单据(&D)"
        .mnuListEditMenu(3).Caption = "复制单据(&C)"
        .mnuListEditMenu(4).Caption = "粘贴单据(&P)"
        

'        If clsBill.lngNowID > 0 Or clsBill.blnIsChanged Then
            .mnuListEditMenu(3).Enabled = True
'        Else
'            .mnuListEditMenu(3).Enabled = False
'        End If
        If clsBill.blnPasteRec And Not clsBill.blnHaveISVoucher And chkPrint(1).Value = 0 Then
            .mnuListEditMenu(4).Enabled = True
        Else
            .mnuListEditMenu(4).Enabled = False
        End If
        If clsBill.blnMayChanged = False Then
            .mnuListEditMenu(4).Enabled = False
        End If
        '折扣单据不能修改
        If clsBill.blnIsDiscount Then
            .mnuListEditMenu(4).Enabled = False
        End If
        
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Visible = True
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(6)       ' 搜索
        .mnuListEditMenu(7).Caption = "编号查询及整理(&Q)"
        .mnuListEditMenu(7).Enabled = True
        
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
        .mnuListEditMenu(9).Caption = "模版表体列宽恢复"
        .mnuListEditMenu(9).Enabled = True
        '--------------------------------
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(10)
        If clsBill.blnSound = False Then
            .mnuListEditMenu(11).Caption = "打开语音报数(&O)"
        Else
            .mnuListEditMenu(11).Caption = "关闭语音报数(&O)"
        End If
        .mnuListEditMenu(11).Enabled = True
        If clsBill.blnTell = False Then
            .mnuListEditMenu(12).Caption = "打开自动报警开关(&A)"
        Else
            .mnuListEditMenu(12).Caption = "关闭自动报警开关(&A)"
        End If
        .mnuListEditMenu(12).Enabled = True
        If clsBill.blnCashLine = True Then
            .mnuListEditMenu(14).Caption = "不显示金额线(&H)"        '
        Else
            .mnuListEditMenu(14).Caption = "显示金额线(&H)"        '
        End If
        .mnuListEditMenu(14).Enabled = True
        .mnuListEditMenu(16).Caption = "筛选(&F)"        '
        .mnuListEditMenu(16).Enabled = True
        .mnuListEditMenu(17).Caption = "单据列表(&L)"        '
        .mnuListEditMenu(17).Enabled = True
        .mnuListEditMenu(18).Caption = "单据定位(&B)"        '
        .mnuListEditMenu(18).Enabled = True
    End With
End Sub
'业务菜单
Private Sub MakeListActivityMenu()
    Dim intCnt As Integer
    
    clsBill.Update