单据格式定义.frm

财务信息管理系统,适合做毕业论文的人使用

    Dim i   As Integer
    
    If EndCol = 0 Then EndCol = StartCol
    If IsMatching Then
'        For Each oFO In m_EO.Fields
        For i = 1 To m_EO.Fields.count
            Set oFO = m_EO.Fields.Item(i)
            With oFO
                If .Row = Row And .StartCol = StartCol And .EndCol >= EndCol Then
                    Set FieldObjectRC = oFO
                    Exit For
                End If
            End With
        Next
    Else
        If StartCol = 0 Then
'            For Each oFO In m_EO.Fields
            For i = 1 To m_EO.Fields.count
                Set oFO = m_EO.Fields.Item(i)
                With oFO
                    If .Row = Row Then
                        Set FieldObjectRC = oFO
                        Exit For
                    End If
                End With
            Next
        Else
'            For Each oFO In m_EO.Fields
            For i = 1 To m_EO.Fields.count
                Set oFO = m_EO.Fields.Item(i)
                With oFO
                    If .Row = Row And .StartCol <= StartCol And .EndCol >= EndCol Then
                        Set FieldObjectRC = oFO
                        Exit For
                    End If
                End With
            Next
        End If
    End If
End Function

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandler
    Dim ShiftDown, AltDown, CtrlDown
    ShiftDown = (Shift And vbShiftMask) > 0
    AltDown = (Shift And vbAltMask) > 0
    CtrlDown = (Shift And vbCtrlMask) > 0
    
    Select Case KeyCode
        Case vbKeyF1
            SendKeys "{F1 3}"
        Case vbKeyF8
            If Me.tlbAction.Buttons("Edit").Enabled Then
                Me.objF1Book.AllowDesigner = True
                Me.objF1Book.AllowObjSelections = True
                Me.objF1Book.AllowSelections = True
                Me.objF1Book.EnableProtection = False
                Me.objF1Book.ShowColHeading = True
                Me.objF1Book.ShowRowHeading = True
                
                Me.tlbAction.Buttons("Edit").Enabled = False
                Me.tlbAction.Buttons("Save").Enabled = True
                Me.objF1Book.Enabled = True
                
                lDownRow = 0: lDownCol = 0: lUpRow = 0: lUpCol = 0
                
                Me.objF1Book.SetFocus
                
                If frmVchDefine.objF1Book.AllowSelections Then frmMain.mnuFormat.Visible = True
            End If
        Case vbKeyF6
            If Me.tlbAction.Buttons("Save").Enabled Then
                SaveFile
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
ErrHandler:
    Exit Sub
End Sub

Private Sub objF1Book_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        Me.objF1Book.TwipsToRC x, y, lDownRow, lDownCol
        
        TopLeft = False
        If lDownRow = 0 And lDownCol = 0 Then TopLeft = True
        If lDownRow = 0 Then lDownRow = 1
        If lDownCol = 0 Then lDownCol = 1
    End If
    If Button = vbRightButton And TopLeft = False And lDownRow * lDownCol <> 0 Then
        If Me.objF1Book.AllowSelections Then
            If lDownRow = lUpRow And lDownCol = lUpCol Then
                frmMain.mnuCut.Enabled = True
                frmMain.mnuPaste.Enabled = True
                frmMain.mnuItemOperate.Enabled = True
                If Not FieldObjectRC(lDownRow, lDownCol, lUpCol) Is Nothing Then
                    frmMain.mnuItemAdd.Enabled = False
                    If FieldObjectRC(lDownRow, lDownCol, lUpCol).FieldOption = U8FDEso.esoMustBeSelected Then
                        frmMain.mnuItemDelete.Enabled = False
                    Else
                        frmMain.mnuItemDelete.Enabled = True
                    End If
                    frmMain.mnuItemEdit.Enabled = True
                Else
                    frmMain.mnuItemAdd.Enabled = True
                    frmMain.mnuItemDelete.Enabled = False
                    frmMain.mnuItemEdit.Enabled = False
                End If
                frmMain.mnuRowOperate.Enabled = True
                frmMain.mnuColOperate.Enabled = True
            ElseIf lDownRow = lUpRow Then
                frmMain.mnuItemOperate.Enabled = True
                If Not FieldObjectRC(lDownRow, lDownCol, lUpCol) Is Nothing Then
                    frmMain.mnuItemAdd.Enabled = False
                    If FieldObjectRC(lDownRow, lDownCol, lUpCol).FieldOption = U8FDEso.esoMustBeSelected Then
                        frmMain.mnuItemDelete.Enabled = False
                    Else
                        frmMain.mnuItemDelete.Enabled = True
                    End If
                    frmMain.mnuCut.Enabled = True
                    frmMain.mnuPaste.Enabled = True
                    frmMain.mnuItemEdit.Enabled = True
                Else
                    frmMain.mnuCut.Enabled = False
                    frmMain.mnuPaste.Enabled = False
                    frmMain.mnuItemOperate.Enabled = False
                End If
                frmMain.mnuRowOperate.Enabled = True
                frmMain.mnuColOperate.Enabled = False
            ElseIf lDownCol = lUpCol Then
                frmMain.mnuCut.Enabled = False
                frmMain.mnuPaste.Enabled = False
                frmMain.mnuItemOperate.Enabled = False
                frmMain.mnuRowOperate.Enabled = False
                frmMain.mnuColOperate.Enabled = True
            Else
                frmMain.mnuCut.Enabled = False
                frmMain.mnuPaste.Enabled = False
                frmMain.mnuItemOperate.Enabled = False
                frmMain.mnuRowOperate.Enabled = False
                frmMain.mnuColOperate.Enabled = False
            End If
            Me.PopupMenu frmMain.mnuFormat
        End If
    Else
    
    End If
End Sub

Private Sub objF1Book_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lRowTmp As Long, lColTmp As Long
    Dim iSelection As Integer
    
    If Button = vbLeftButton Then
        Me.objF1Book.TwipsToRC x, y, lUpRow, lUpCol
        If lUpRow = 0 And lUpCol = 0 And TopLeft Then lUpRow = m_EO.Rows: lUpCol = m_EO.Cols
        If lUpRow = 0 Then lUpRow = 1
        If lUpCol = 0 Then lUpCol = 1
        
        If lDownRow > lUpRow Then
            lRowTmp = lDownRow
            lDownRow = lUpRow
            lUpRow = lRowTmp
        End If
        
        If lDownCol > lUpCol Then
            lColTmp = lDownCol
            lDownCol = lUpCol
            lUpCol = lColTmp
        End If
        
        Me.objF1Book.SetSelection lDownRow, lDownCol, lUpRow, lUpCol
        Me.objF1Book.GetSelection iSelection, lDownRow, lDownCol, lUpRow, lUpCol
    End If
End Sub

Private Sub Form_Activate()
    If frmVchDefine.objF1Book.AllowSelections Then frmMain.mnuFormat.Visible = True
End Sub

Private Sub Form_Deactivate()
    frmMain.mnuFormat.Visible = False
End Sub

Private Sub Form_Load()
    Dim F1File        As New clsF1File
    Dim IsRootageNode As Integer
    Dim objVchDefBI   As New U8FDBso.clsVchDefBI
    Dim key(43)       As Byte
    Dim objEOS        As U8FDEso.entities
    
    MSImageList_Initialize ilsTlb
    'MSToolBar_Initialize tlbAction, "Print", TB_PRINT
    'MSToolBar_Initialize tlbAction, "Preview", TB_PREVIEW
    'MSToolBar_Initialize tlbAction, "Export", TB_Export
    'MSToolBar_Initialize tlbAction, "AddNew", TB_AddNew
    MSToolBar_Initialize tlbAction, "Edit", TB_Edit
    'MSToolBar_Initialize tlbAction, "Delete", TB_Delete
    MSToolBar_Initialize tlbAction, "Save", TB_Save
    'MSToolBar_Initialize tlbAction, "Cancel", TB_Cancel
    'MSToolBar_Initialize tlbAction, "Refresh", TB_Refresh
    MSToolBar_Initialize tlbAction, "Help", TB_HELP
    MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
    
    SetTlbStyle Me, False
    ocxCtbTool.RefreshEnable
    Me.jkrTree.width = 100
    IsRootageNode = 0
    Set objEOS = Nothing
    Set objEOS = objVchDefBI.LoadVchEOs(g_sDataSourceName, True)
    Dim i As Integer
    For i = 1 To 43 '43为固定的单据子节点总数
        If i < 11 Then
            key(i) = 10 + 0 + i '10为起点(起点应为11,因为i从1开始,所以这里为10),0为本节点下固定的子节点数
        ElseIf i < 13 Then
            key(i) = 20 + 8 + i - 10 '20为起点,8为本节点下固定的子节点数,10(11-1)是为了与数组索引对齐,以下类推
        ElseIf i < 19 Then
            key(i) = 30 + 4 + i - 12
        ElseIf i < 23 Then
            key(i) = 40 + 6 + i - 18
        ElseIf i < 28 Then
            key(i) = 50 + 5 + i - 22
        ElseIf i < 34 Then
            key(i) = 60 + 4 + i - 27
        ElseIf i < 44 Then
            key(i) = 70 + 0 + i - 33 '这一列为公用单据号71-80
        End If
    Next
    For i = 1 To objEOS.count
        Set m_EO = objEOS.Item(i)
        If m_EO.IsUsed Then
            If left$(Me.EO.VchType, 1) = "1" Then
                If IsRootageNode <= 0 Then IsRootageNode = 1
                If IsRootageNode = 1 Then Me.treStyle.Nodes.Add , , "Contract", "合同": IsRootageNode = 2
                Me.treStyle.Nodes.Add "Contract", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            ElseIf left$(Me.EO.VchType, 1) = "2" Then
                If IsRootageNode <= 2 Then IsRootageNode = 3
                If IsRootageNode = 3 Then Me.treStyle.Nodes.Add , , "Settle", "结算": IsRootageNode = 4
                Me.treStyle.Nodes.Add "Settle", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            ElseIf left$(Me.EO.VchType, 1) = "3" Then
                If IsRootageNode <= 4 Then IsRootageNode = 5
                If IsRootageNode = 5 Then Me.treStyle.Nodes.Add , , "Fix", "定期存取款": IsRootageNode = 6
                Me.treStyle.Nodes.Add "Fix", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            ElseIf left$(Me.EO.VchType, 1) = "4" Then
                If IsRootageNode <= 6 Then IsRootageNode = 7
                If IsRootageNode = 7 Then Me.treStyle.Nodes.Add , , "Loan", "贷还款": IsRootageNode = 8
                Me.treStyle.Nodes.Add "Loan", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            ElseIf left$(Me.EO.VchType, 1) = "5" Then
                If IsRootageNode <= 8 Then IsRootageNode = 9
                If IsRootageNode = 9 Then Me.treStyle.Nodes.Add , , "Accrual", "利息": IsRootageNode = 10
                Me.treStyle.Nodes.Add "Accrual", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            ElseIf left$(Me.EO.VchType, 1) = "6" Then
                If IsRootageNode <= 10 Then IsRootageNode = 11
                If IsRootageNode = 11 Then Me.treStyle.Nodes.Add , , "Else", "其它": IsRootageNode = 12
                Me.treStyle.Nodes.Add "Else", tvwChild, "K" & Me.EO.BIType, Me.EO.Caption
            End If
        End If
        
        '如果单据号已经使用,设置为0
        If CInt(Me.EO.BIType) >= 11 And CInt(Me.EO.BIType) <= 20 Then
            key(Me.EO.BIType - (20 - 10)) = 0
        End If
        If CInt(Me.EO.BIType) >= 29 And CInt(Me.EO.BIType) <= 30 Then
            key(Me.EO.BIType - (30 - 12)) = 0
        End If
        If CInt(Me.EO.BIType) >= 35 And CInt(Me.EO.BIType) <= 40 Then
            key(Me.EO.BIType - (40 - 18)) = 0
        End If
        If CInt(Me.EO.BIType) >= 47 And CInt(Me.EO.BIType) <= 50 Then
            key(Me.EO.BIType - (50 - 22)) = 0
        End If
        If CInt(Me.EO.BIType) >= 56 And CInt(Me.EO.BIType) <= 60 Then
            key(Me.EO.BIType - (60 - 27)) = 0
        End If
        If CInt(Me.EO.BIType) >= 65 And CInt(Me.EO.BIType) <= 70 Then
            key(Me.EO.BIType - (70 - 33)) = 0
        End If
        If CInt(Me.EO.BIType) >= 71 And CInt(Me.EO.BIType) <= 80 Then
            key(Me.EO.BIType - (80 - 43)) = 0
        End If
    Next
    
    Set objEOS = Nothing
    Set objVchDefBI = Nothing
    
    Me.treStyle.LineStyle = tvwRootLines
    Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
    Me.treStyle.LabelEdit = tvwManual
    
    For i = 1 To treStyle.Nodes.count
        If treStyle.Nodes(i).children > 0 Then
            treStyle.Nodes(i).Image = 1
        Else
            treStyle.Nodes(i).Image = 3
        End If
    Next i
    
    g_sF1FileName = GetTmpPath & g_conF1FileName
    'g_sF1FileName = "e:\" & g_conF1FileName
    F1File.F1Export g_sDataSourceName, g_sF1FileName
    Me.objF1Book.ReadEx g_sF1FileName
    Set F1File = Nothing
    
    F1Book_Show NodeKey
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '----录入时，将F1Book.Enable置为False, 利用Form的鼠标事件来定位行列号
    Dim R As Long, C As Long
    
    Me.objF1Book.TwipsToRC x - Me.objF1Book.left, y - Me.objF1Book.top, R, C
'    Me.Caption = R & ", " & C
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim iAnswer As Long
    If Me.objF1Book.Enabled = True Then
        iAnswer = MsgBox("还有尚未保存的数据，保存吗？", vbQuestion + vbYesNoCancel)
        If iAnswer = vbNo Then
            NodeKey = 0
            Unload Me
        ElseIf iAnswer = vbYes Then
            NodeKey = 0
            SaveFile
            Unload Me
        ElseIf iAnswer = vbCancel Then
            Cancel = 1
        End If
    Else
        NodeKey = 0
        Unload Me
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.jkrTree.maxLeft = Me.ScaleWidth - g_conMoveLimit
    Me.jkrTree.minLeft = g_conMoveLimit
    
    Me.treStyle.Move 0, Me.tlbAction.Height, Me.jkrTree.left, Me.ScaleHeight - Me.tlbAction.Height
    Me.jkrTree.Move Me.jkrTree.left, Me.tlbAction.Height, 50, Me.ScaleHeight
    Me.picContainer.Move Me.jkrTree.left + 50, Me.tlbAction.Height, Me.ScaleWidth - Me.jkrTree.left - 50, Me.ScaleHeight - Me.tlbAction.Height