frmac_indexresult.frm

一个用VB写的财务软件源码

End Property


'是否包括未记账凭证
Public Property Let ubIncludeNotRecordVoucher(ByVal bIncludeNotRecordVoucher As Boolean)
    m_bIncludeNotRecordVoucher = bIncludeNotRecordVoucher
End Property
'是否包括未记账凭证
Public Property Let ubIncludeBlankKm(ByVal bIncludeBlankKm As Boolean)
    m_bIncludeBlankKm = bIncludeBlankKm
End Property

Public Sub uPreview()
    Dim i As Integer
    mIsPrint = True
    i = Cllr.GetCurSheet
    SetGrid i + 1, Cllr.GetRows(i) - 1
    Cllr.PrintPreview 1, Cllr.GetCurSheet
    mIsPrint = False
    SetGrid i + 1, Cllr.GetRows(i) - 1
    If Cllr.SaveFile(App.Path & "\CellFiles\Index.cll", 1) = 0 Then
       MsgBox "CELL文件保存失败！", vbOKOnly
    End If
    
End Sub

Public Sub uPrint()
    Dim frmPage As frmPageSet
    Dim lTotalPages As Long, i As Long
    Dim j As Integer
    lTotalPages = Cllr.GetTotalSheets
    Set frmPage = New frmPageSet
    With frmPage
        .uiMaxPage = lTotalPages
        .uiPresentPage = Cllr.GetCurSheet + 1
        .Show 1
        If .Ok Then
            For i = .uiFromPage To .uiToPage
                If Not .uiSzFsSet Then
                  MsgBox "请插入纸张...", vbInformation
                End If
'                按照打印字体大小重新设置
                mIsPrint = True
                Cllr.SetCurSheet i - 1
'                按照显示字体大小重新设置
                Cllr.PrintSheet 0, i - 1
                mIsPrint = False
                SetGrid i, Cllr.GetRows(i - 1) - 1
            Next i
        End If
    End With
    Unload frmPage
End Sub

'账页格式被改变时触发
Private Sub cboAccountFormat_Click()
    Dim sOldAccountFormat As String     '账页原先格式
    
    If Not m_bFormLoad Then
        sOldAccountFormat = usAccountFormat
        usAccountFormat = cboAccountFormat.List(cboAccountFormat.ListIndex)
        If IsColChange(Me.Cllr, m_iColWidth) = True Then
            If MsgBox(sOldAccountFormat & "索引表格式已经改变，是否保存？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
                Call SaveColChange(m_iColWidth, usAccountType, sOldAccountFormat)
            End If
        End If
        Select Case usAccountFormat
            Case "金额式"
                m_sDefaultColWidth = COLWIDTH_MONEY
            Case "数量式"
                m_sDefaultColWidth = COLWIDTH_AMOUNT
            Case "外币式"
                m_sDefaultColWidth = COLWIDTH_FOREIGN
        End Select
        m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
        m_iColWidthTemp = m_iColWidth
        
        Call DoRedrawCellHead(m_iColWidth)
    End If
End Sub

'调整列宽时触发
Private Sub Cllr_AllowSizeCol(ByVal col As Long, ByVal row As Long, approve As Long)
    Dim vCurColWidth As Variant
    Dim lCurChangeCol As Long
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim bChangeColWidth As Boolean
    Dim i As Long
    Dim j As Long
    
    Select Case usAccountFormat
        Case "金额式"
            If ((col - COL_BEGIN_DEBIT_MONEY) Mod 3) <> 0 And (col - COL_BEGIN_DEBIT_MONEY) > 0 Then
                approve = False
            Else
                approve = True
            End If
        Case "数量式"
            If ((col - COL_BEGIN_DEBIT_AMOUNT) Mod 3) <> 0 And (col - COL_BEGIN_DEBIT_AMOUNT) > 0 Then
                approve = False
            Else
                approve = True
            End If
        Case "外币式"
            If ((col - COL_BEGIN_DEBIT_FOREIGN) Mod 3) <> 0 And (col - COL_BEGIN_DEBIT_FOREIGN) > 0 Then
                approve = False
            Else
                approve = True
            End If
    End Select
    If col = Cllr.GetCols(0) - 1 Then
        approve = False
    End If
    
    For i = LBound(m_iColWidthTemp) To UBound(m_iColWidthTemp)
'        If COL_HAPPEN_CREDIT_MONEY >= i Then
            vCurColWidth = Cllr.GetColWidth(1, i, Cllr.GetCurSheet)
'        Else
'            vCurColWidth = CllR.GetColWidth(1, i + (mColMonth - 1) * 6, CllR.GetCurSheet)
'        End If
        If vCurColWidth <> "" Then
            If vCurColWidth <> m_iColWidthTemp(i) Then
                bChangeColWidth = True
                m_iColWidthTemp(i) = vCurColWidth
                lCurChangeCol = i
            End If
        End If
    Next i

    With Cllr
        If bChangeColWidth Then
            lCurrentPage = .GetCurSheet
            iTotalPages = .GetTotalSheets
            For i = 0 To iTotalPages - 1
                .SetCurSheet i
                For lCurChangeCol = LBound(m_iColWidthTemp) To UBound(m_iColWidthTemp)
'                    If COL_BEGIN_CREDIT_MONEY >= lCurChangeCol Then
                        .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol, i
'                    ElseIf lCurChangeCol >= COL_END_DEBIT_AMOUNT Then
'                        .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol + (mColMonth - 1) * 6, i
'                    Else
'                        For j = 1 To mColMonth
'                            .SetColWidth 1, m_iColWidthTemp(lCurChangeCol), lCurChangeCol + (j - 1) * 6, i
'                        Next
'                    End If
                Next lCurChangeCol
            Next i
            .SetCurSheet lCurrentPage
        End If
    End With
End Sub

'调整行高时触发
Private Sub cllR_allowsizerow(ByVal col As Long, ByVal row As Long, approve As Long)
    approve = False
End Sub

Private Sub cllR_MouseRClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
PopupMenu fMainForm.mnuPopupMenu
End Sub

Private Sub Form_Activate()
TbrControl False
End Sub

Private Sub Form_Deactivate()
TbrControl True
End Sub

Private Sub Form_Initialize()
'uIsDisplayBalance = True
'uIsDisplayVoucherInfo = False
'uIsForceDisplayTotal = False
End Sub

Private Sub form_load()
'    uIsDisplayBalance = IsDisplayBalance
'    uIsDisplayVoucherInfo = IsDisplayVoucherInfo
    mIsPrint = False
    m_bFormLoad = True
    TbrControl False
    usAccountType = "索引表"
    usAccountFormat = "金额式"
    Select Case usAccountFormat
    Case "金额式"
        m_sDefaultColWidth = COLWIDTH_MONEY
    Case "数量式"
        m_sDefaultColWidth = COLWIDTH_AMOUNT
    Case "外币式"
        m_sDefaultColWidth = COLWIDTH_FOREIGN
    End Select
    '求出各列的宽度
    m_iColWidth = GetColWidth(usAccountType, usAccountFormat, m_sDefaultColWidth)
    m_iColWidthTemp = m_iColWidth
    
    With cboAccountFormat
        .AddItem "金额式"
        .AddItem "数量式"
        .AddItem "外币式"
        .ListIndex = 0
    End With
    With Cllr
     '将CELL不可见，防止清除CELL控件内容时屏幕闪烁；
        .Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        If .OpenFile(App.Path & "\CellFiles\Index.cll", "") = -1 Then
            MsgBox "CELL文件不存在！", vbOKOnly
        End If
        .ResetContent
        .SetCols COL_END + 2, 0
        .SetRows ROW_GRID_START + ROWS_PAGE, 0
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
        .WorkbookReadonly = True
        .AllowSizeColInGrid = True
    End With
    LoadPrintSetting
    m_bFormLoad = False
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Cllr.Width = Me.ScaleWidth - 100
    Cllr.Height = Me.ScaleHeight - 200
End Sub

'窗体卸载前, 检查账页的列宽是否被调整
Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    If IsColChange(Me.Cllr, m_iColWidth) = True Then
        If MsgBox(usAccountFormat & "余额表格式已经改变，是否保存？", _
                    vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
            Call SaveColChange(m_iColWidth, usAccountType, usAccountFormat)
        End If
    End If
    SavePrintSetting
    TbrControl True
    m_Mutex.DeleteMutexID gloSys.sSubSysId, glo.sAccountID, "mnuAccountBalance", m_iID
End Sub

'参数 PageNo - 当前页数;    FactRows - 实际行数
Private Sub SetGrid(ByVal PageNo As Long, ByVal FactRows As Long)
    Dim i As Long, j As Long, k As Long
    Dim pTitle As New clsRowType
    Dim pData As New clsRowType
    Dim pHead As New clsRowType
    If mIsPrint Then
        '标题
        pTitle.FontName = PrintTitleFontName
        pTitle.FontSize = PrintTitleFontSize
        pTitle.High = PrintTitleRowHigh
        '表头
        pHead.FontName = PrintHeadFontName
        pHead.FontSize = PrintHeadFontSize