📄 frmstartperiod.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
        Else
            '----------------------------------------------------
            If blnPrinted And BillRePrintRight(C2lng(lblHead(2).Tag), True) = False Then
                clsBill.blnMayChange = False
            ElseIf blnPeriodClosed() Then
                clsBill.blnMayChange = False '已有结帐期间
            Else
                clsBill.blnMayChange = True
            End If
            '----------------------------------------------------
            
        End If
        chkPrint(1).Enabled = (chkPrint(1).Value = 0 And clsBill.blnMayChange)   '设置作废按纽,已作废单据不能取消作废
    Else
        clsBill.blnMayChange = False
        chkPrint(1).Enabled = False
    End If
    '----------------------------------------------------
    If blnPrinted And BillRePrintRight(C2lng(lblHead(2).Tag)) = False Then
        cmdButton(6).Enabled = False
    Else
        cmdButton(6).Enabled = True
    End If
    If WanNeng Then
        tblReceipt.Buttons(7).Enabled = cmdButton(6).Enabled
    End If
    '----------------------------------------------------
    Unload MsgForm
    SetHelp
    blnNotRaiseEvents = False
    If Me.Visible = False Then
        blnFirstIn = True
        Me.Visible = True
    End If
    Me.ZOrder
    If chkPrint(1).Value <> 1 Then
        With Me.GrdCol
            RefreshRect .hWnd, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2 + 140 * Screen.TwipsPerPixelX, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2 + 70 * Screen.TwipsPerPixelY
        End With
    Else
        blnEdit = False
    End If
    MakeListActivityMenu
    MakeListEditMenu
    
    If clsBill.blnMayChange And chkPrint(1).Value <> 1 Then
        Select Case C2lng(lblHead(2).Tag)
            Case 42
                clsBill.Field_Click 2
            Case 43, 44, 45, 46, 47 '受托、委托、分歧、直运、加工
                clsBill.Head_Click 0
            Case Else
                clsBill.Head_Click 0
        End Select
    Else
        clsBill.SetAFocus
    End If
    Exit Sub
ErrHandle:
    Screen.MousePointer = vbDefault
    If clsBill.blnRefresh = False Then clsBill.blnRefresh = True
    If Errors.ErrorsDeal = edtResume Then
         Resume
    Else
         On Error Resume Next
        blnNotRaiseEvents = False
        Unload Me
    End If
End Sub

Public Sub ShowANewBill(Optional ByVal CurrentActivityID As Long = 0, Optional ByVal blnGetBillNo As Boolean = True)
    On Error GoTo ErrHandle
    Dim recTmp As rdoResultset
    Dim strNo As String
    Dim lngTypeID As Long
    Dim lngID As Long
    Dim intI As Integer
    blnNotRaiseEvents = True
    If chkPrint(0).Visible Then
    End If
    If clsBill Is Nothing Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    If Me.Visible Then
        Me.ZOrder 0
        If clsBill.cmdButton_Click(0) = False Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
    End If
    If clsBill.blnIsChanged Then
        If Not ChangeSaveNote() Then
            blnNotRaiseEvents = False
            Exit Sub
        End If
    End If
    If clsBill.lngNowID = 0 Then
        If CurrentActivityID <> 0 Then
        '取上一张单据的单据号和模板ID
            Set recTmp = gclsBase.BaseDB.OpenResultset( _
                    " SELECT strReceiptNo,lngTemplateID ,lngReceiptTypeID,lngTemplateID" & _
                    " FROM Itemactivity WHERE lngActivityID=" & CurrentActivityID, _
                    rdOpenStatic)
                    
            If recTmp Is Nothing Then
                GoTo DefaultProc
            End If
            If recTmp.EOF Then
                recTmp.Close
                Set recTmp = Nothing
                GoTo DefaultProc
            End If
            strNo = recTmp!strReceiptNo
            lngTypeID = recTmp!lngReceiptTypeID
            lngID = recTmp!lngTemplateID
            recTmp.Close
            Set recTmp = Nothing
        Else
DefaultProc:
           strNo = ""
           Dim strNm As String
            FirstReceiptTypeIDAndName ReceiptTypeID, lngTypeID, strNm
            lngID = FirstId(xTemplatE, lngTypeID)
        End If
    Else
        strNo = lblField(1).Caption
        lngTypeID = lblHead(2).Tag
        lngID = lblHead(4).Tag
    End If
    If cmdButton(0).Visible Then
    End If
    If Not ChangeSaveNote() Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    clsBill.GetANewBill lngID, lngTypeID, strNo, blnGetBillNo
    SetHelp
    blnNotRaiseEvents = False
    
    '----------------------------------------------------
    cmdButton(6).Enabled = True
    If WanNeng Then
        tblReceipt.Buttons(7).Enabled = cmdButton(6).Enabled
    End If
    '----------------------------------------------------
    
    
    If Me.Visible = False Then
'        blnFirstIn = True
        Me.Visible = True
        Me.ZOrder 0
    End If
    
    Select Case lngTypeID
        Case 42
        Case 43
        Case 44
        Case 45
        Case 46 '直运
            clsBill.Head_Click 0
    End Select
    Exit Sub
ErrHandle:
    If Errors.ErrorsDeal = edtResume Then
         Resume
    Else
         On Error Resume Next
        blnNotRaiseEvents = False
        Unload Me
    End If
End Sub

Public Function ChangeSaveNote() As Boolean
    Dim blnT As Boolean
    Dim dtmDate1 As Date
    Dim intReturn As Integer
    Dim strMsg As String
    
    If clsBill Is Nothing Then
        ChangeSaveNote = True
        Exit Function
    End If
    If Me.Visible = False Then
        ChangeSaveNote = True
        Exit Function
    End If
    BillPublic.SaveColWidthDefault Me
    If clsBill.blnIsChanged Then
        If Len(Trim(lblField(1).Caption)) = 0 Then
            strMsg = "该张" & lblCaption.Caption & "数据已经发生改变，是否需要保存？"
        Else
            strMsg = "“" & lblField(1).Caption & "”号" & lblCaption.Caption _
                & "数据已经发生改变，是否需要保存？"
        End If
        intReturn = ShowMsg(Me.hWnd, strMsg, MB_YESNOCANCEL + MB_DEFBUTTON1 _
            + MB_ICONQUESTION + MB_SYSTEMMODAL, "修改单据")
        If intReturn = IDYES Then
            blnT = BillSave()
            If blnT Then
                clsBill.blnIsChanged = False
            End If
            ChangeSaveNote = blnT
        ElseIf intReturn = IDNO Then
            clsBill.blnIsChanged = False
            ChangeSaveNote = True
            If clsBill.lngNowID = 0 Then
                dtmDate1 = C2Date(lblField(2).Caption)
                clsBill.intAccountYear = 0 'gclsBase.FYearOfDate(dtmDate1)   '会计年度
                clsBill.bytAccountPeriod = 0 ' gclsBase.PeriodOfDate(dtmDate1)   '会计期间
                blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
            End If
        Else
            blnT = False
        End If
    Else
            If clsBill.lngNowID = 0 Then
                clsBill.intAccountYear = 0 'gclsBase.FYearOfDate(Date)   '会计年度
                clsBill.bytAccountPeriod = 0 ' gclsBase.PeriodOfDate(Date)   '会计期间
                blnMaxNODecrease clsBill.intAccountYear, clsBill.bytAccountPeriod, C2lng(lblHead(2).Tag), strAlphaOfStr(lblField(1).Caption), C2lng(strDigitOfStr(lblField(1).Caption))
            End If
            ChangeSaveNote = True
    End If
End Function

Public Function getID() As Long
    If clsBill Is Nothing Then Exit Function
    getID = clsBill.lngNowID
End Function

Public Sub ResponseMessage()
    Dim vntMessage As Variant
    Dim lngOldID As Long
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgItem Then  '接收到商品改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            lngOldID = refInput1.ID
            clsBill.AddReferOfItem
            refInput1.SeekId lngOldID
        ElseIf vntMessage = Message.msgCustomer Then   '接收到单位改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除付款条件改变消息
            lngOldID = refInput2.ID
            clsBill.AddReferOfCustomer
            refInput2.SeekId lngOldID
        End If
    Next
End Sub

Private Sub mclsMainControl_ToolRefresh()
    clsBill.setAllItemproperty
    clsBill.BuildNoteMsg True
End Sub

Private Sub refInput_AddNew()
    clsBill.refNewEditDel 0
End Sub

Private Sub refInput_Choose()
    clsBill.refInput_Choose
End Sub
Private Sub refInput_Delete()
    clsBill.refNewEditDel 2
End Sub

Private Sub refInput_Edit()
    clsBill.refNewEditDel 1
End Sub

Private Sub refInput1_AddNew()
    clsBill.refNewEditDel 0
End Sub

Private Sub refInput1_Choose()
    clsBill.refInput_Choose
End Sub
Private Sub refInput1_Delete()
    clsBill.refNewEditDel 2
End Sub

Private Sub refInput1_Edit()
    clsBill.refNewEditDel 1
End Sub

Private Sub refInput2_AddNew()
    clsBill.refNewEditDel 0
End Sub

Private Sub refInput2_Choose()
    clsBill.refInput_Choose
End Sub
Private Sub refInput2_Delete()
    clsBill.refNewEditDel 2
End Sub

Private Sub refInput2_Edit()
    clsBill.refNewEditDel 1
End Sub


Public Sub ShowANewTypeBill(ByVal intReceiptType As Integer, Optional ByVal lngTakeStockActivityID As Long = 0)
    '新增一指定类型单据
    Dim strNo As String
    Dim lngTypeID As Long
    Dim lngID As Long
    On Error GoTo ErrHandle
    frmMain.Enabled = False
    blnNotRaiseEvents = True
    If chkPrint(0).Visible Then
    End If
    frmMain.Enabled = True
    If clsBill Is Nothing Then
        blnNotRaiseEvents = False
        Exit Sub
    End If
    lngTypeID = intReceiptType
    
    If Me.Visible Then
        Me.ZOrder
        If clsBill.cmdButton_Click(0) = False Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
        If clsBill.blnIsChanged = False And clsBill.lngNowID <= 0 Then
            If C2lng(lblHead(2).Tag) = intReceiptType Then
                blnNotRaiseEvents = False
                GoTo EndProc
            End If
        End If
    End If
    If clsBill.blnIsChanged = True And Me.Visible Then
        If Not ChangeSaveNote() Then
            blnNotRaiseEvents = False
            Unload MsgForm
            Exit Sub
        End If
    End If
    If blnPeriodClosed() Then
            clsBill.blnRefresh = True
            Unload MsgForm
            ShowMsg Me.hWnd, "已有会计期间已结帐，不能新增期初单据！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "新增单据"
            blnNotRaiseEvents = False
            Unload Me
            Exit Sub
    End If
    '取可增加单据类型
    If Not IsCanDo(EditNO(lngTypeID)) Then
        If Not clsBill Is Nothing Then clsBill.blnRefresh = True
        If Not IsCanDo(EditNO(lngTypeID, False)) Then
            Unload MsgForm
            ShowMsg Me.hWnd, gclsBase.OperatorName & "无新增及查询本单据权限！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "新增单据"
            blnNotRaiseEvents = False
            Unload Me
            Exit Sub
        Else
            Dim lngLastID As Long
            lngLastID = GetLastActivityID(lngTypeID, True)
            If lngLastID > 0 Then
                ShowAOldBill lngLastID
                Exit Sub
            End If
            Unload MsgForm
            ShowMsg Me.hWnd, gclsBase.OperatorName & "无新增本单据权限，并且系统中无可查询单据！", MB_OK + MB_SYSTEMMODAL + MB_ICONHAND, "新增单据"
            blnNotRaiseEvents = False
            Unload Me
            Exit Sub
        End If
    End If
    Unload MsgForm
    If clsBill.lngNowID = 0 Or lngTypeID <> lblHead(2).Tag Then
        LastReceiptBill lngTypeID, strNo, lngID
    Else
        strNo = lblField(1).Caption
        lngTypeID = lblHead(2).Tag
        lngID = lblHead(4).Tag
    End If
    blnView = IsCanDo(EditNO(lngTypeID, False))
    blnEdit = IsCanDo(EditNO(lngTypeID))
    intBillState = 0
    clsBill.blnMayChange = True
    clsBill.GetANewBill lngID, lngTypeID, strNo, True
    clsBill.blnRefresh = True
    If gclsBase Is Nothing Then Exit Sub
    SetHelp
EndProc:
    clsBill.blnRefresh = True
    blnNotRaiseEvents = False
    If Me.Visible = False Then
        blnFirstIn = True
        Me.Visible = True
    End If
    Me.ZOrder 0
    If gclsBase Is Nothing Then Exit Sub
上一页 1 2 3 45
⌨️ 快捷键说明

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