frmfinancereport.frm

金算盘软件代码

        lblCaption.Visible = False
        grdAcntBook.top = lblCaption.top
        grdAcntBook.Height = lngOldGridHeight + lngOldGridTop - lblCaption.top
        grdTitle.Width = grdAcntBook.Width
        If mblnQueryHasRecord = False Then
            grdTitle.Visible = False
        End If
        Me.Refresh
    End If
    grdTitle.Redraw = True
    grdAcntBook.Redraw = True
    mblnHaveHead = Not mblnHaveHead
End Sub

Private Sub cmdSave_Click()
    mclsFinanceReport.SaveList
End Sub

'图形分析
Private Sub cmdGraphical_Click()
    Dim clsAna As New GraphAnalysisClass
    GenerateArr
    clsAna.ShowArrayGraph gclsBase.BaseDB, mstrGridData, mclsFinanceReport.AccountTypeID, 0
    Set clsAna = Nothing
End Sub
'生成图形分析所需的数组参数。
Private Sub GenerateArr()
    Dim intRows As Integer
    Dim intCols As Integer
    Dim intRowIndex As Integer
    Dim intColIndex As Integer
    Dim intRateCols As Integer
    Dim intRateRows As Integer
    intRows = grdAcntBook.Rows
    intCols = grdAcntBook.Cols
    grdTitle.Row = 1
    For intColIndex = mclsFinanceReport.Columns To intCols - 1
        grdTitle.col = intColIndex
        If Trim(Right(grdTitle.Text, 3)) = "(%)" Then
            intRateCols = intRateCols + 1
        End If
    Next
    grdAcntBook.col = 0
    For intRowIndex = 0 To intRows - 1
        grdAcntBook.Row = intRowIndex
        If Trim(Right(grdAcntBook.Text, 3)) = "(%)" Then
            intRateRows = intRateRows + 1
        End If
    Next
    ReDim mstrGridData(1 To intRows - intRateRows, 1 To intCols - mclsFinanceReport.Columns - intRateCols + 1)
    grdAcntBook.col = 0
    intRateRows = 0
    For intRowIndex = 0 To intRows - 1
        grdAcntBook.Row = intRowIndex
        If Trim(Right(grdAcntBook.Text, 3)) <> "(%)" Then
            mstrGridData(intRowIndex + 1 - intRateRows, 1) = grdAcntBook.Text
        Else
            intRateRows = intRateRows + 1
        End If
    Next
    intRateRows = 0
    For intRowIndex = 0 To intRows - 1
        intRateCols = 0
        grdAcntBook.Row = intRowIndex
        grdAcntBook.col = 0
        If Trim(Right(grdAcntBook.Text, 3)) <> "(%)" Then
            For intColIndex = mclsFinanceReport.Columns To intCols - 1
                grdAcntBook.col = intColIndex
                grdTitle.col = intColIndex
                If Trim(Right(grdTitle.Text, 3)) <> "(%)" Then
                    mstrGridData(intRowIndex + 1 - intRateRows, intColIndex - mclsFinanceReport.Columns - intRateCols + 2) = grdAcntBook.Text
                Else
                    intRateCols = intRateCols + 1
                End If
            Next
        Else
            intRateRows = intRateRows + 1
        End If
    Next
End Sub

'显示帐册
Public Sub ShowFinanceReport(ByVal lngReportId As Long, ByVal ViewId As Long, Optional clsFinanceReport As FinanceReportWizard = Nothing)
  Dim Strsql As String
  Dim strSubId As String
    mblnIsAnaly = False
    mblnLoad = False
    mbytBookType = 1
    '显示已存盘的帐表
    If clsFinanceReport Is Nothing Then
        Set mclsFinanceReport = New FinanceReportWizard
        mclsFinanceReport.GetReportSet lngReportId, ViewId
    '显示才由向导生成的帐表
    Else
        Set mclsFinanceReport = clsFinanceReport
    End If
    Set clsFinanceReport = Nothing
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    On Error Resume Next
    mstrAccountDataType = mclsFinanceReport.AccountDataType
    mlngReportID = mclsFinanceReport.ReportID
    If mclsFinanceReport.AccountTypeID = 1 Then
        mblnIsCheckPlan = PlanIsCheck
    Else
        mblnIsCheckPlan = False
    End If
    mblnFirstChange = True
    ShowFilter
    ChangeDate
    mblnFirstChange = False
    On Error GoTo 0
    mblnLoad = True
    Me.Hide
    RefreshData
End Sub

'涮新数据
Private Sub RefreshData(Optional mstrNewSelect As String = "")
    Dim Strsql As String
    'On Error GoTo ErrHandler
    lblCaption.Caption = "[" & mclsFinanceReport.ViewName & "]" & mclsFinanceReport.ReportName
    If Not mblnLoad Then
        Exit Sub
    End If
    mblnIsAnaly = False
    mblnLoad = False
    grdAcntBook.FixedCols = 0
    If mblnIsPeriodChanged = True Or mblnReportReset = True Then
        grdAcntBook.Rows = grdAcntBook.Rows + 1
    End If
    If grdAcntBook.Rows > 1 Then
        grdAcntBook.FixedRows = 1
    End If
    If mstrNewSelect = "" Then
       Strsql = "Select " & mclsFinanceReport.SelectOfSql & " FROM " & mclsFinanceReport.FromOfSql & _
                 " Where " & mclsFinanceReport.WhereOfSql & " GROUP BY " & mclsFinanceReport.GroupBy
    Else
       Strsql = "Select " & mstrNewSelect & " FROM " & mclsFinanceReport.FromOfSql & _
                 " Where " & mclsFinanceReport.WhereOfSql & " GROUP BY " & mclsFinanceReport.GroupBy
    End If
    Set rstTemp = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    Set Data1.Recordset = rstTemp
    grdAcntBook.Redraw = False
    grdAcntBook.Refresh
    grdAcntBook.Redraw = True
    If rstTemp.EOF = False Then
        mblnQueryHasRecord = True
    Else
        mblnQueryHasRecord = False
    End If
    If mblnIsAnaly = False And mblnQueryHasRecord = True Then
        AddZero
        ColumnAnanly
        StrucAnaly
        ClearZero
        AdjustColWidth
        AdjustColOrder
        mblnIsAnaly = True
    End If
        mblnLoad = True
        ChangeDate
        AdjustColWidth
        If grdAcntBook.Cols <= 1 Then
            grdAcntBook.Cols = 2
        End If
        grdAcntBook.FixedCols = mclsFinanceReport.Columns
        AdjustColOrder
        InitTitle
        InitTitleText
        If mblnIsReferPeriod = False Then
            ResetTitleText
            grdTitle.Refresh
        End If
        ResetGrdWidth
        DeleteZeroRow
        Me.Show
    Exit Sub
ErrHandler:
        MsgBox "发生第" & Err.Number & "号错误：" & Chr(13) & Err.Description & Chr(13) & "该操作不能执行！"
        mblnErrHappened = False
        mblnLoad = True
        If Trim(mstrRptPeriod) = "周" Then
            txtReportPeriod.Text = "季"
        Else
            txtReportPeriod.Text = mstrRptPeriod
        End If
        Exit Sub
End Sub

Private Sub Form_Activate()
    If mblnIsAnaly = False Then
        AddZero
        ColumnAnanly
        StrucAnaly
        ClearZero
        AdjustColWidth
        AdjustColOrder
        mblnIsAnaly = True
        grdAcntBook.FixedCols = mclsFinanceReport.Columns
    End If
End Sub

Private Sub Form_Load()
    Set mclsHook = New Hook
    mclsHook.SetHook grdTitle.hwnd
    txtReportPeriod.SeekCol = "0,1"
    cmbReferDate.SeekCol = "0,1"
    cmbAnalyDate.SeekCol = "0,1"
End Sub

Private Sub Form_Resize()
   grdAcntBook.Redraw = False
   If Me.WindowState = vbMinimized Then
       Exit Sub
   End If
   If Me.Width < lngFormWidth Then
       Me.Width = lngFormWidth
   End If
   If Me.Height < lngFormHeight Then
       Me.Height = lngFormHeight
   End If
   lblBorder.Width = Me.Width - 250
   lblShadow.Width = lblBorder.Width
   lblBorder.Height = Me.Height - lblBorder.top - 450
   lblShadow.Height = lblBorder.Height
   lblCaption.top = lblBorder.top + 200
   grdAcntBook.top = lblCaption.top + lblCaption.Height + 100
   grdAcntBook.Left = lblBorder.Left + 100
   grdTitle.Left = grdAcntBook.Left
   grdAcntBook.Width = lblBorder.Width - 220
   lblCaption.Left = (lblBorder.Width - lblCaption.Width) \ 2
   grdAcntBook.Height = lblBorder.Height - 600
    'grdTitle的位置
    grdTitle.top = grdAcntBook.top
    grdTitle.Height = grdAcntBook.Height
    grdTitle.Left = grdAcntBook.Left
    grdTitle.Width = grdAcntBook.Width
    'grdAcntBook的位置
    grdAcntBook.top = grdTitle.top + Me.TextHeight("科目") * 2.5
    grdAcntBook.Height = lblBorder.Height - 600 - Me.TextHeight("科目") * 2.5
    grdAcntBook.ZOrder
    AdjustColWidth
    grdAcntBook.Redraw = True
    ReSetColWidth
    If mblnHaveHead = True Then
        mblnHaveHead = False
        cmdHide_Click
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gclsSys.MainControls.Remove Me
    mblnIsPeriodChanged = False
    Set mclsFinanceReport = Nothing
    Set rstTemp = Nothing
    Erase dblColSumData()
    Erase dblColPartData()
    Erase dblAnalyData()
    Erase dblAnalySum()
    Erase strRateCols()
End Sub

'调整FlexGrid的列宽(以该列中最宽的一个单元的宽度作为整列的宽度)
Private Sub AdjustColWidth()
    Dim intGridRows As Integer
    Dim intGridCols As Integer
    Dim intRowIndex As Integer
    Dim intColIndex As Integer
    Dim lngMaxWidth As Long
    Dim lngTempWidth As Long
    grdAcntBook.Redraw = False
    intGridRows = grdAcntBook.Rows
    intGridCols = grdAcntBook.Cols
    grdTitle.Cols = intGridCols
    For intColIndex = 0 To intGridCols - 1
        grdAcntBook.col = intColIndex
        grdAcntBook.Row = 0
        lngMaxWidth = Me.TextWidth(Trim(grdAcntBook.Text)) + 100
        For intRowIndex = 0 To intGridRows - 1
            grdAcntBook.Row = intRowIndex
            lngTempWidth = Me.TextWidth(Trim(grdAcntBook.Text)) + 100
            If lngTempWidth > lngMaxWidth Then
                lngMaxWidth = lngTempWidth
            End If
        Next
            grdAcntBook.ColWidth(intColIndex) = lngMaxWidth
    Next
    grdAcntBook.Row = 0
    grdAcntBook.CellAlignment = flexAlignCenterCenter
    For intColIndex = 0 To intGridCols - 1
        grdTitle.col = intColIndex
        grdTitle.CellAlignment = flexAlignCenterCenter
    Next
    grdAcntBook.Redraw = True
    grdAcntBook.Row = 0
End Sub

'刷新与期间有关的控件
Private Sub ChangeDate()
    If mclsFinanceReport.AccountTypeID = 1 Then
        mblnIsCheckPlan = PlanIsCheck
    Else
        mblnIsCheckPlan = False
    End If
    '分析期
    If mclsFinanceReport.DateCond <> "" Then
        cmbAnalyDate.Text = mclsFinanceReport.DateCond
        mintReferRow1 = cmbAnalyDate.ReferRow
        AnalyBeginDate.Value = CDate(mclsFinanceReport.DateBegin)
        AnalyEndDate.Value = CDate(mclsFinanceReport.DateEnd)
    End If
    '比较期
    If mclsFinanceReport.DateCond1 <> "" Then
        cmbReferDate.Visible = True
        cmbReferDate.Text = mclsFinanceReport.DateCond1
        mintReferRow2 = cmbReferDate.ReferRow
        ReferBeginDate.Visible = True
        ReferEndDate.Visible = True
        lblD.Visible = True
        lblFrom(0).Visible = True
        lblTo(0).Visible = True
        lblReportPeriod.Visible = False
        txtReportPeriod.Visible = False
        ReferBeginDate.Value = CDate(mclsFinanceReport.DateBegin1)
        ReferEndDate.Value = CDate(mclsFinanceReport.DateEnd1)
        mblnIsReferPeriod = True
    '报告期
    Else
        ReferBeginDate.Visible = False
        ReferEndDate.Visible = False
        lblD.Visible = False
        lblFrom(0).Visible = False
        lblTo(0).Visible = False
        cmbReferDate.Visible = False
        lblReportPeriod.Visible = True
        txtReportPeriod.Visible = True
        lblReportPeriod.top = lblD.top
        lblReportPeriod.Left = lblD.Left + 200
        txtReportPeriod.top = lblD.top - 50
        txtReportPeriod.Left = cmbReferDate.Left + 250
        txtReportPeriod.Text = mclsFinanceReport.RptPeriod
        cmbReferDate.Text = "自定义"
        If mblnErrHappened = False Then
            mstrRptPeriod = mclsFinanceReport.RptPeriod
        End If
        mblnIsReferPeriod = False
    End If
    If mblnIsCheckPlan = True Then
        txtReportPeriod.Enabled = False