单据格式定义.frm

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

    'CellFormat.AlignHorizontal
    'CellFormat.AlignVertical
    'CellFormat.BorderColor
    'CellFormat.BorderStyle (F1BottomBorder)
    'CellFormat.FontBold
    'CellFormat.FontCharSet
    'CellFormat.FontColor
    'CellFormat.FontItalic
    'CellFormat.FontName
    'CellFormat.FontSize
    'CellFormat.FontStrikeout
    'CellFormat.FontUnderline
    'CellFormat.IsBorderDefined
    'CellFormat.MergeCells
    'CellFormat.PatternBG
    'CellFormat.PatternFG
    'CellFormat.PatternStyle
    'CellFormat.WordWrap = False
    
    'objF1Book.GetLineStyle pStyle, perColor, pHeight
    'objF1Book.GetBorder lBorder, rBorder, tBorder, bBorder, shade, lColor, rColor, tColor, bColor
    frmCellFormat.Show vbModal
End Sub

Public Sub mnuPaste_Click()
    If Clipboard.GetFormat(vbCFText) Then
        Me.objF1Book.EditPaste
    End If
End Sub

Public Sub mnuRowHeight_Click()
    objF1Book.SetSelection lDownRow, lDownCol, lUpRow, lUpCol
    frmRowHColW.Status = 0
    frmRowHColW.Show vbModal
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbAction_ButtonClick tlbAction.Buttons(cButtonId)
End Sub

Private Sub tlbAction_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Caption
        Case "修改"
            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
        Case "保存"
            SaveFile
        Case "帮助"
'            Dim nRet As Integer
'            If Len(App.HelpFile) = 0 Then
'                MsgBox "不能找到帮助文件.", vbInformation, App.ProductName
'            Else
'                On Error Resume Next
'                nRet = WinHelp(Me.hwnd, App.HelpFile, 3, 0)
'                If Err Then
'                    MsgBox Err.Description, vbInformation, App.ProductName
'                End If
'            End If
            SendKeys "{F1 3}"
        Case "退出"
            ExitForm
    End Select
    If UCase(Button.key) <> "EXIT" Then SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

Private Sub treStyle_Collapse(ByVal Node As MSComctlLib.Node)
    Node.Image = 1
End Sub

Private Sub treStyle_Expand(ByVal Node As MSComctlLib.Node)
    Node.Image = 2
End Sub

Private Sub treStyle_LostFocus()
    Me.treStyle.Nodes("K" & NodeKey).Selected = True
End Sub

Private Sub treStyle_NodeClick(ByVal Node As MSComctlLib.Node)
'    If Node.Expanded Then
'        Node.Expanded = False
'    Else
'        Node.Expanded = True
'    End If
    
    If IsNumeric(mID(Node.key, 2)) Then
        If NodeKey <> CLng(right(Node.key, 2)) Then
            If Me.objF1Book.Enabled = True Then
                If MsgBox("放弃当前工作吗?", vbQuestion + vbYesNo) = vbNo Then
                    Me.treStyle.Nodes("K" & NodeKey).Selected = True
                    Me.objF1Book.SetFocus
                    Exit Sub
                Else
                    Me.objF1Book.CancelEdit
                    frmMain.mnuFormat.Visible = False
                    Me.treStyle.Nodes("K" & NodeKey).Text = m_EO.Caption
                    Me.tlbAction.Buttons("Edit").Enabled = True
                    Me.tlbAction.Buttons("Save").Enabled = False
                    Me.objF1Book.Enabled = False
                End If
            End If
            
            If IsNumeric(right(Node.key, 2)) Then NodeKey = CLng(right(Node.key, 2))
            F1Book_Show NodeKey
        End If
    End If
End Sub

Private Sub F1Book_Show(Optional ByVal Node_Key As String)
    Dim i As Integer
    Dim objDataMgr  As New U8FDMgr.DataManager

    If Node_Key = "" Or Node_Key = "0" Then
        If Me.treStyle.Nodes.count > 0 Then
            '要求单据必须分类,2表示第一个类下面的第一个节点
            Node_Key = Me.treStyle.Nodes(2).key
        End If
    End If
    If IsNumeric(left(Node_Key, 1)) Then Node_Key = "K" & Node_Key
    
    If Not IsNumeric(mID(Node_Key, 2)) Then Exit Sub
    NodeKey = CLng(mID(Node_Key, 2))
    
    For i = 1 To Me.treStyle.Nodes.count
        If Me.treStyle.Nodes(i).children = 0 Then
            If NodeKey = CLng(mID(Me.treStyle.Nodes(i).key, 2)) Then
                Exit For
            End If
        End If
        If i = Me.treStyle.Nodes.count Then Exit Sub
    Next
    
    Me.treStyle.Nodes(Node_Key).Parent.Expanded = True
    Me.treStyle.Nodes(Node_Key).Selected = True
    
    Set Me.EO = objDataMgr.LoadEOMetaData(g_sDataSourceName, NodeKey)
    Me.objF1Book.Sheet = Me.EO.SheetID
    Me.objF1Book.MaxCol = Me.EO.Cols
    Me.objF1Book.MaxRow = Me.EO.Rows
    SetF1Book
End Sub

Private Sub SetF1Book()
    Me.objF1Book.ExtraColor = &HFFFFFF
    
    Me.objF1Book.AllowArrows = False
    Me.objF1Book.AllowAutoFill = False
    Me.objF1Book.AllowCellTextDlg = False
    Me.objF1Book.AllowDelete = False
    Me.objF1Book.AllowDesigner = False
    Me.objF1Book.AllowEditHeaders = False
    Me.objF1Book.AllowFillRange = False
    Me.objF1Book.AllowFormatByEntry = False
    Me.objF1Book.AllowFormulas = False
    Me.objF1Book.AllowInCellEditing = False
    Me.objF1Book.AllowMoveRange = False
    Me.objF1Book.AllowObjSelections = False
    Me.objF1Book.AllowResize = True
    Me.objF1Book.AllowSelections = False
    Me.objF1Book.AllowTabs = False
    Me.objF1Book.AppName = App.ProductName ' "U8资金管理"
    
    Me.objF1Book.SelHdrTopLeft = False
    Me.objF1Book.ShowColHeading = False
    Me.objF1Book.ShowRowHeading = False
    Me.objF1Book.ShowLockedCellsError = False
    Me.objF1Book.SetProtection False, True
    
    Me.tlbAction.Buttons("Edit").Enabled = True
    Me.tlbAction.Buttons("Save").Enabled = False
    
    Me.objF1Book.Enabled = False
    Me.objF1Book.EnableProtection = True
    
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

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

Private Sub SaveData()
    Dim objDataMgr  As New U8FDMgr.DataManager
    
    Me.objF1Book.AllowDesigner = False
    Me.objF1Book.AllowSelections = False
    Me.objF1Book.AllowObjSelections = False
    Me.objF1Book.Enabled = False
    Me.objF1Book.SelHdrTopLeft = False
    Me.objF1Book.ShowColHeading = False
    Me.objF1Book.ShowRowHeading = False
    
    Me.tlbAction.Buttons("Edit").Enabled = True
    Me.tlbAction.Buttons("Save").Enabled = False
    
    If Not frmVchDefine.objF1Book.AllowSelections Then frmMain.mnuFormat.Visible = False
    
    Coordinate
    
    If objDataMgr.SaveEOMetaData(g_sDataSourceName, m_EO, False) Then
        'MsgBox "保存成功!", vbInformation, App.ProductName
    Else
        MsgBox "保存不成功!", vbInformation, App.ProductName
    End If
End Sub

Private Sub SaveFile()
    Dim F1File As New clsF1File
    
    If Me.tlbAction.Buttons("Save").Enabled Then SaveData
    objF1Book.WriteEx g_sF1FileName, F1FileFormulaOne6
    F1File.F1Import g_sDataSourceName, g_sF1FileName
    Set F1File = Nothing
End Sub

Public Sub CopyF1Book(AddEdit As Boolean, FromBIType As Long, ToBIType As Long, Rows As Long, Cols As Long)
    Dim F1File  As New clsF1File
    Dim F1Sheet As Integer
    
    On Error Resume Next
    If AddEdit Then
        F1Sheet = Me.objF1Book.Sheet
        Me.objF1Book.Sheet = FromBIType - 10
        Me.objF1Book.SetSelection 1, 1, Rows, Cols
        Me.objF1Book.EditCopy
        
        Me.objF1Book.Sheet = ToBIType - 10
        Me.objF1Book.ClearRange 1, 1, Rows, Cols, F1ClearAll
        Me.objF1Book.MaxCol = Cols
        Me.objF1Book.MaxRow = Rows
        Me.objF1Book.SetSelection 1, 1, Rows, Cols
        Set CellFormat = objF1Book.GetCellFormat
        CellFormat.ProtectionLocked = False
        Me.objF1Book.EditPaste
        Me.objF1Book.EnableProtection = False
        Me.objF1Book.SetProtection False, True
        'Me.objF1Book.CopyRangeEx ToBIType - 10, 1, 1, Rows, Cols, Me.objF1Book.hwnd, FromBIType - 10, 1, 1, Rows, Cols
        objF1Book.WriteEx g_sF1FileName, F1FileFormulaOne6
        F1File.F1Import g_sDataSourceName, g_sF1FileName
        Me.objF1Book.Sheet = F1Sheet
    Else
        g_sF1FileName = GetTmpPath & g_conF1FileName
        F1File.F1Export g_sDataSourceName, g_sF1FileName
        Me.objF1Book.ReadEx g_sF1FileName
        Me.objF1Book.Sheet = FromBIType - 10
        Me.objF1Book.SetSelection 1, 1, Rows, Cols
        Me.objF1Book.EditCopy
        
        Me.objF1Book.Sheet = ToBIType - 10
        Me.objF1Book.ClearRange 1, 1, Rows, Cols, F1ClearAll
        Me.objF1Book.MaxCol = Cols
        Me.objF1Book.MaxRow = Rows
        Me.objF1Book.SetSelection 1, 1, Rows, Cols
        Me.objF1Book.EnableProtection = False
        Me.objF1Book.SetProtection False, True
        Me.objF1Book.EditPaste
        'Me.objF1Book.CopyRangeEx ToBIType - 10, 1, 1, Rows, Cols, Me.objF1Book.hwnd, FromBIType - 10, 1, 1, Rows, Cols
        objF1Book.WriteEx g_sF1FileName, F1FileFormulaOne6
        F1File.F1Import g_sDataSourceName, g_sF1FileName
    End If
    Set F1File = Nothing
End Sub

Private Sub Coordinate()
    ReDim ColWidth(m_EO.Cols) As Double
    ReDim RowHeight(m_EO.Rows) As Double
    Dim i As Integer
    
    RowHeight(0) = 0: ColWidth(0) = 0
    RowHeight(1) = objF1Book.RowHeight(1): ColWidth(1) = objF1Book.ColWidth(1)
    
    For i = 1 To UBound(ColWidth) - 1
        ColWidth(i + 1) = ColWidth(i) + objF1Book.ColWidth(i + 1)
    Next
    
    For i = 1 To UBound(RowHeight) - 1
        RowHeight(i + 1) = RowHeight(i) + objF1Book.RowHeight(i + 1)
    Next
    
    '设置m_EO的坐标值
    For i = 1 To m_EO.Fields.count
        If m_EO.Fields(i).IsUsed And m_EO.Fields(i).EditProp <> U8FDEso.esoNotVisible Then
            If m_EO.Fields(i).DataType <> U8FDEso.esoLabel Then
                m_EO.Fields(i).left = ColWidth(m_EO.Fields(i).StartCol - 1)
                m_EO.Fields(i).width = ColWidth(m_EO.Fields(i).StartCol) - ColWidth(m_EO.Fields(i).StartCol - 1)
                m_EO.Fields(i).InputLeft = ColWidth(m_EO.Fields(i).StartCol)
                m_EO.Fields(i).InputWidth = ColWidth(m_EO.Fields(i).EndCol) - ColWidth(m_EO.Fields(i).StartCol)
                m_EO.Fields(i).top = RowHeight(m_EO.Fields(i).Row - 1)
                m_EO.Fields(i).Height = RowHeight(m_EO.Fields(i).Row) - RowHeight(m_EO.Fields(i).Row - 1)
            Else
                m_EO.Fields(i).left = ColWidth(m_EO.Fields(i).StartCol - 1)
                m_EO.Fields(i).width = ColWidth(m_EO.Fields(i).EndCol) - ColWidth(m_EO.Fields(i).StartCol - 1)
                m_EO.Fields(i).InputLeft = 0
                m_EO.Fields(i).InputWidth = 0
                m_EO.Fields(i).top = RowHeight(m_EO.Fields(i).Row - 1)
                m_EO.Fields(i).Height = objF1Book.RowHeight(i) 'RowHeight(m_EO.Fields(i).Row) - RowHeight(m_EO.Fields(i).Row - 1)
            End If
        End If
    Next
    
    '设置m_EO的总长度总宽度
    Dim temp As Double
    For i = 1 To m_EO.Rows
        temp = temp + objF1Book.RowHeight(i)
    Next
    m_EO.Height = temp
    temp = 0
    For i = 1 To m_EO.Cols
        temp = temp + objF1Book.ColWidth(i)
    Next
    m_EO.width = temp
End Sub