📄 frmr_p.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
    blnNotRaiseEvents = False
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_EditDel()
   mclsMainControl_ListEditMenu (1)
End Sub


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

Private Sub mclsMainControl_EditNew()
   mclsMainControl_ListEditMenu (0)
End Sub

Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
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_ListEditMenu(ByVal intIndex As Integer)
    Dim strMsg(5) As String
    Dim intYesNo As Integer
    Dim i%, j%
    strMsg(0) = "确实要删除该张单全部记录吗?"
    strMsg(1) = "确实要删除该张已经作废单全部记录吗?"
    clsBill.blnKeyDown = False
    Select Case intIndex
        Case 0  '插入单据
            If clsBill.SaveInput2Form(True) = False Then Exit Sub
            clsBill.CHK_CLICK (9)
            If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then Exit Sub
            ShowANewTypeBill ReceiptType
        Case 1  '删除单据
                If Not clsLst.DeleteRow(clsBill.lngNowID, False) Then
                    clsBill.SetAFocus
                    Exit Sub
                Else
                    gclsSys.SendMessage Me.hWnd, 30 + C2lng(lblHead(2).Tag)
                    gclsSys.SendMessage Me.hWnd, msgItem
                    
                    Dim dtmDate1 As Date
                    dtmDate1 = C2Date(lblField(2).Caption)
                    clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1)   '会计年度
                    clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1)    '会计期间
                    blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
                    
                    clsBill.blnIsChanged = False
                    cmdNext_Click
                End If
        Case 2, 5 'BAR
        Case 3  '复制单据
            clsBill.SaveBillToCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 4  '粘贴单据
            clsBill.LoadBillFromCollection
            MakeListEditMenu
            clsBill.SetAFocus
        Case 6  '搜索
            frmTreeFind.ShowFind
        Case 7  '查询单据缺号
             frmBillNo.ShowTypeID C2lng(lblHead(2).Tag)
            If clsBill.lngNowID > 0 Then
                lblField(1).Caption = GetReceiptNo(40, clsBill.lngNowID)
            End If
            clsBill.SetAFocus
        Case 8  '模板表体列宽恢复
            ModifyColWidthDefault Me
            clsBill.TemplateChange C2lng(lblHead(4).Tag)
            clsBill.SetAFocus
        Case 10 '筛选
            mclsMainControl_EditFilter
        Case 11 'list
            mclsMainControl_ReceiptList
        Case 12 'go
            mclsMainControl_ReceiptPosition
        Case 13
            mclsMainControl_FilePrintReceipt
    End Select
End Sub
Private Sub mclsMainControl_ReceiptList()
    CallBillList Me.ReceiptType, False, True
End Sub
Private Sub mclsMainControl_EditFilter()
    CallBillList Me.ReceiptType, True, 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(ReceiptType, clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod, True)
    Else
        lngOldID = frmWriteOffBill.SeekBill(ReceiptType, clsBill.lngNowID, Me.hWnd, , clsBill.intAccountYear, clsBill.bytAccountPeriod, True)
    End If
    If lngOldID = 0 Then
    Else
        ShowAOldBill ReceiptType, 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
                
        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)
        .mnuListEditMenu(13).Caption = "成批打印(&Y)"        '
        .mnuListEditMenu(13).Enabled = True
        
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(0)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditCopy, .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditPaste, .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        .mnuListEditMenu(0).Caption = "新增单据(&N)"
        .mnuListEditMenu(1).Caption = "删除单据(&D)"
        .mnuListEditMenu(3).Caption = "复制" & lblHead(3).Caption & "单据(&C)"
        .mnuListEditMenu(4).Caption = "粘贴" & lblHead(3).Caption & "单据(&P)"
        .mnuListEditMenu(3).Visible = True
        .mnuListEditMenu(4).Visible = True
        If GrdCol.Rows >= 2 Then
            .mnuListEditMenu(3).Enabled = True
        Else
            .mnuListEditMenu(3).Enabled = False
        End If
        If clsBill.CollectionNotEmpty = False Then
            .mnuListEditMenu(4).Enabled = False
        ElseIf chkPrint(1).Value = 1 Or clsBill.blnMayChange = False Then
            .mnuListEditMenu(4).Enabled = False
        Else
            .mnuListEditMenu(4).Enabled = True
        End If
        
        
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Visible = True
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(6)       ' 搜索
        .mnuListEditMenu(7).Caption = "编号查询及整理(&Q)"
        .mnuListEditMenu(7).Enabled = True
        .mnuListEditMenu(8).Caption = "单据模板表体列宽恢复(&W)"
        .mnuListEditMenu(8).Enabled = True
        .mnuListEditMenu(10).Caption = "筛选(&F)"        '
        .mnuListEditMenu(10).Enabled = True
        .mnuListEditMenu(11).Caption = "单据列表(&L)"        '
        .mnuListEditMenu(11).Enabled = True
        .mnuListEditMenu(12).Caption = "单据定位(&B)"        '
        .mnuListEditMenu(12).Enabled = True
        .SetToolBar True
    End With
End Sub

'ID号变化(单据修改进入时有效)
Public Sub ShowAOldBill(ByVal intReceiptType As Integer, ByVal ActivityID As Long, Optional ByVal blnCancel As Boolean = False)
    On Error GoTo ErrHandle
    ReceiptType = intReceiptType
    blnNotRaiseEvents = True
    frmMain.Enabled = False
    If chkPrint(0).Visible Then
    End If
    frmMain.Enabled = True
    If clsBill Is Nothing Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    If ActivityID = 0 Then
        ShowANewTypeBill ReceiptType
        blnNotRaiseEvents = False
        Unload MsgForm
        Exit Sub
    End If
    
    If Me.Visible Then
        Me.ZOrder
        If clsBill.cmdButton_Click(0) = False Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
    End If
    If clsBill.blnIsChanged Then
        Me.ZOrder 0
        If Not ChangeSaveNote() Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
    End If
    
    clsBill.blnRefresh = False
    clsBill.lngNowID = ActivityID
    Debug.Print "loadbill" & Time
    LoadBill clsBill.lngNowID, blnCancel
    Debug.Print "loadbill" & Time
    clsBill.blnRefresh = True
    clsBill.blnMayChange = True

    blnEdit = IsCanDo(EditNO(C2lng(lblHead(2).Tag)))   '设置blnEdit标志
    blnView = IsCanDo(EditNO(C2lng(lblHead(2).Tag), False))   '设置blnView标志
    If blnEdit = False And blnView = False Then
        Unload MsgForm
        Unload Me
        Exit Sub
    End If
    If blnCancel Then '冲销
        Dim lngDec As Long
        Dim lngDec1 As Long
        Dim dblTmp As Double
        lngVoucherID = 0
'        lngCancelActivityID = clsBill.lngNowID
        clsBill.lngNowID = 0
        mlngItemActivityID = 0
            
        clsBill.strCancelDate = lblField(2).Caption
        lblField(2).Caption = Format(gclsBase.BaseDate, "YYYY-MM-DD")
        'ReceiptNo
        
        lblField(1).Caption = strGetMaxNO(clsBill.intAccountYear, clsBill.bytAccountPeriod, ReceiptType, strAlphaOfStr(lblField(1).Caption), lblField(2).Caption)
        lngDec = C2lng(strDigitOfStr(lblField(1).Caption))
        
        clsBill.blnIsChanged = True
        blnPrinted = False
        LblMemo(5).Tag = gclsBase.OperatorID
        LblMemo(5).Caption = gclsBase.OperatorName
        WriteLabel lblField(9), Format$(-1 * C2Dbl(GetLabel(lblField(9))), FormatString(gclsBase.NaturalCurDec))
        lngDec = Len(lblField(10).Caption) - InStr(1, lblField(10).Caption, ".")
        WriteLabel lblField(10), Format$(-1 * C2Dbl(GetLabel(lblField(10))), FormatString(lngDec))
'        For lngDec = 1 To grdCol.Rows - 1
'            TextMatrix(lngDec, 6) = Format$(C2Dbl(TextMatrix(lngDec, 6)) - C2Dbl(TextMatrix(lngDec, 7)) - C2Dbl(TextMatrix(lngDec, 9)), FormatString(C2lng(TextMatrix(lngDec, 36))))
'            TextMatrix(lngDec, 8) = Format$(C2Dbl(TextMatrix(lngDec, 8)) - C2Dbl(TextMatrix(lngDec, 9)), FormatString(C2lng(TextMatrix(lngDec, 36))))
'            TextMatrix(lngDec, 7) = Format$(-C2Dbl(TextMatrix(lngDec, 7)), FormatString(C2lng(TextMatrix(lngDec, 36))))
'            TextMatrix(lngDec, 9) = Format$(-C2Dbl(TextMatrix(lngDec, 9)), FormatString(C2lng(TextMatrix(lngDec, 36))))
'
'            TextMatrix(lngDec, 10) = Format$(C2Dbl(TextMatrix(lngDec, 10)) - C2Dbl(TextMatrix(lngDec, 11)) - C2Dbl(TextMatrix(lngDec, 13)), FormatString(gclsBase.NaturalCurDec))
'            TextMatrix(lngDec, 12) = Format$(C2Dbl(TextMatrix(lngDec, 12)) - C2Dbl(TextMatrix(lngDec, 13)), FormatString(gclsBase.NaturalCurDec))
'            TextMatrix(lngDec, 11) = Format$(-C2Dbl(TextMatrix(lngDec, 11)), FormatString(gclsBase.NaturalCurDec))
'            TextMatrix(lngDec, 13) = Format$(-C2Dbl(TextMatrix(lngDec, 13)), FormatString(gclsBase.NaturalCurDec))
'
'            dblTmp = C2Dbl(NumberConvert(TextMatrix(lngDec, 19), C2Dbl(TextMatrix(lngDec, 35)), True)) - C2Dbl(NumberConvert(TextMatrix(lngDec, 20), C2Dbl(TextMatrix(lngDec, 35)), True))
'
'            TextMatrix(lngDec, 19) = Format$(NumberConvert(dblTmp, C2Dbl(TextMatrix(lngDec, 35)), False), FormatString(gclsBase.NaturalCurDec))
'
'            If InStr(1, TextMatrix(lngDec, 20), ".") > 0 Then
'                lngDec1 = Len(TextMatrix(lngDec, 20)) - InStr(1, TextMatrix(lngDec, 20), ".")
'            Else
'                lngDec1 = 0
'            End If
'            TextMatrix(lngDec, 20) = Format$(-C2Dbl(TextMatrix(lngDec, 20)), FormatString(lngDec1))
'
'        Next
'        clsBill.WriteTotalRow
    Else
            clsBill.strCancelDate = GetReceiptDate(35, lngCancelActivityID)
    End If

'设置可修改标志
'    chkPrint(1).Visible = True
    If mlngItemActivityID = 0 And blnEdit And C2lng(LblMemo(5).Tag) = gclsBase.OperatorID Then
        If blnCancel Then
            clsBill.blnMayChange = True
        Else
            '----------------------------------------------------
            If intBillState > 0 Then
                clsBill.blnMayChange = False
            ElseIf lngVoucherID > 0 Then '有凭证
                clsBill.blnMayChange = False
            ElseIf blnPeriodClosed(lblField(2).Caption) Then '期间结帐
                clsBill.blnMayChange = False
            ElseIf blnPrinted And BillRePrintRight(ReceiptType, True) = False Then
                clsBill.blnMayChange = False
            Else
                clsBill.blnMayChange = True
            End If
            '----------------------------------------------------
            
        End If
        If blnCancel Then '冲销
            chkPrint(1).Enabled = False   '设置作废按纽,已作废单据不能取消作废
        Else
            chkPrint(1).Enabled = (chkPrint(1).Value = 0 And clsBill.blnMayChange)   '设置作废按纽,已作废单据不能取消作废
        End If
    Else
        clsBill.blnMayChange = False
        chkPrint(1).Enabled = False
    End If
    If lngVoucherID > 0 Then '筛选
        cmdButton(5).Enabled = False
    Else
        cmdButton(5).Enabled = True
    End If
    If WanNeng Then
        tblReceipt.Buttons(ToolBarIndex(5, Me.Name)).Enabled = cmdButton(5).Enabled
    End If
    If lngVoucherID > 0 Then '关联凭证
        cmdButton(6).Enabled = True
    Else
        cmdButton(6).Enabled = False
    End If
    If WanNeng Then
        tblReceipt.Buttons(ToolBarIndex(6, Me.Name)).Enabled = cmdButton(6).Enabled
    End If
    If C2lng(lblHead(0).Tag) = 0 Then '记事薄
        cmdButton(7).Enabled = False
    Else
        cmdButton(7).Enabled = True
    End If
    If WanNeng Then
        tblReceipt.Buttons(ToolBarIndex(7, Me.Name)).Enabled = cmdButton(7).Enabled
    End If
    '----------------------------------------------------
    If blnCancel Then '冲销
            cmdButton(8).Enabled = True
    Else
        If blnPrinted And BillRePrintRight(ReceiptType) = False Then '打印
            cmdButton(8).Enabled = False
        Else
            cmdButton(8).Enabled = True
        End If
    End If
    If WanNeng Then
        tblReceipt.Buttons(ToolBarIndex(8, Me.Name)).Enabled = cmdButton(8).Enabled
    End If
    '----------------------------------------------------
    U
上一页 1 2 3 45
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -