frmfinancereport.frm

金算盘软件代码

         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   4095
      Left            =   90
      TabIndex        =   20
      Top             =   900
      Width           =   9660
   End
   Begin VB.Label lblTo 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "到"
      Height          =   180
      Index           =   1
      Left            =   3375
      TabIndex        =   19
      Top             =   540
      Width           =   180
   End
   Begin VB.Label lblTo 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "到"
      Height          =   180
      Index           =   0
      Left            =   8415
      TabIndex        =   18
      Top             =   540
      Width           =   180
   End
   Begin VB.Label lblFrom 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "从"
      Height          =   180
      Index           =   1
      Left            =   1890
      TabIndex        =   15
      Top             =   540
      Width           =   180
   End
   Begin VB.Label lblAnalyPeriod 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "分析期"
      Height          =   180
      Left            =   45
      TabIndex        =   14
      Top             =   540
      Width           =   540
   End
   Begin VB.Label lblReportPeriod 
      AutoSize        =   -1  'True
      BackColor       =   &H8000000B&
      BackStyle       =   0  'Transparent
      Caption         =   "报告期"
      Height          =   180
      Left            =   6660
      TabIndex        =   13
      Top             =   2790
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      BackColor       =   &H80000009&
      BackStyle       =   0  'Transparent
      Caption         =   "财务分析表"
      Height          =   195
      Left            =   3645
      TabIndex        =   12
      Top             =   1485
      Width           =   915
   End
   Begin VB.Label lblShadow 
      Appearance      =   0  'Flat
      BackColor       =   &H00808080&
      ForeColor       =   &H80000008&
      Height          =   4095
      Left            =   45
      TabIndex        =   11
      Top             =   990
      Width           =   9660
   End
   Begin VB.Label lblD 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "比较期"
      Height          =   180
      Left            =   4995
      TabIndex        =   10
      Top             =   555
      Width           =   540
   End
   Begin VB.Label lblFrom 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "从"
      Height          =   180
      Index           =   0
      Left            =   6885
      TabIndex        =   9
      Top             =   555
      Width           =   180
   End
End
Attribute VB_Name = "frmFinanceReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                               财务分析表窗体代码
'   作者:雷宇
'   时间:1998-07-01
'
'   接口函数(过程):
'   Public Function ShowFinanceReport(ByVal lngReportId As Long, ByVal ViewId As Long, Optional clsFinanceReport As FinanceReportWizard = Nothing)
'   功能:调入财务分析表窗体
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Const lngFormWidth As Long = 10080                               '窗体最小宽度
Const lngFormHeight As Long = 5775                              '窗体最小高度
Const lngGridTop As Long = 735                                  '表格与帐表顶部距离
Const lngGridTopNoTitle As Long = 400                           '表格与帐表顶部距离（无标题时）
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsFinanceReport As FinanceReportWizard                               '帐表设置对象
Private mblnHaveHead As Boolean                                 '是否需要标题
Private WithEvents mclsHook As Hook
Attribute mclsHook.VB_VarHelpID = -1
Private mOldCol As Integer
Private mbytBookType As Byte                                    '帐册类型 1=三栏帐 2=多栏帐
Private mblnLoad As Boolean                                     '窗体是否已经加载
Private mstrDateCond As String                                  '日期条件
Private mstrAccountCond As String                               '科目条件
Private mintAmountBanCol As Integer                             '金额余额列
Private mintQuantityBanCol As Integer                           '数量余额列
Private mintCurrencyBanCol As Integer                           '外币余额列
Private mintRemarkCol As Integer                                '摘要列
Private mintDirectCol As Integer                                '方向列
Private mintMastDealRow As Integer                              '已进行数据处理的最大行
Private mstrMonth As String                                     '上一行的月
Private mstrDay As String                                       '上一行的日
Private mintMonthCol As Integer                                 '月对应的列号
Private mintDayCol As Integer                                   '日对应的列号
Private mblnIsOver As Boolean                                   '是否处理到帐册的最后一列
Private mblnIsReLoad As Boolean
Private mblnIsAnaly As Boolean                                  '是否已经生成了数据
Private mstrAccountDataType As String                           '是财务帐还是业务帐
Private rstTemp As rdoResultset                                    '模块内有效的查询
Private dblAnalyData() As Single                                '保存参与分析的数据的二维数组
Private dblAnalySum() As Single                                 '保存每列的合计数
Private strGrdDataText() As String                              '保存表格的标题
Private strRateCols() As String                                 '保存那些属于比率的列
Private strSumData() As String                                  '保存那些属于"合计"的列
Private dblColSumData() As Double
Private dblColPartData() As Double
Private mblnQueryHasRecord As Boolean                           '查询是否有数据
Private lngOldGridTop As Long                                   '表格原来的顶端位置,备恢复用
Private lngOldGridHeight As Long                                '表格原来的高度,备恢复用
Private mblnIsReferPeriod As Boolean                            '是比较期还是报告期起作用
Private mlngReportID As Long                                    '当前报表的ID
Private mlngAnalyFieldID As Long                                '分析期的ID
Private mstrAnalyDateOP As String                               '分析期的类型
Private mdtmAnalyDate1 As String                                '分析期的起始时间
Private mdtmAnalyDate2 As String                                '分析期的终止时间
Private mlngReferFieldID As Long                                '比较期的ID
Private mstrReferDateOP As String                               '比较期的类型
Private mdtmReferDate1 As String                                '比较期的起始时间
Private mdtmReferDate2 As String                                '比较期的终止时间
Private mstrCodeID As String                                    '报告期的ID
Private mstrKeyName As String                                   '报告期的类型名称
Private mblnIsPeriodChanged As Boolean                          '检测当前的期间类型是否改变
Private mblnResponseChange As Boolean
Private mblnFirstChange As Boolean
Private mblnReportReset As Boolean
Private mintReferRow1 As Long
Private mintReferRow2 As Long
Private mblnIsCheckPlan As Boolean
Private mblnJustChooseWeek As Boolean
Private mblnErrHappened As Boolean
Private mstrRptPeriod As String
Private mstrGridData() As String
Private Sub AnalyBeginDate_LostFocus()
    If AnalyBeginDate.Text = "" Then
        MsgBox "请输入一个日期!", vbExclamation
    End If
    If AnalyBeginDate.Value > AnalyEndDate.Value Then
        MsgBox "请输入小于截止时间的日期!", vbExclamation
    ElseIf AnalyEndDate.Text = "" Then
        AnalyEndDate.SetFocus
    Else
        mblnIsPeriodChanged = True
        If mblnResponseChange = False And CDate(AnalyBeginDate.Text) <> CDate(mclsFinanceReport.DateBegin) Then
            cmbAnalyDate_Choose
            cmbAnalyDate.Text = "自定义"
        End If
        mblnResponseChange = False
    End If
End Sub

Private Sub AnalyEndDate_LostFocus()
    If AnalyEndDate.Text = "" Then
        MsgBox "请输入一个日期!", vbExclamation
    End If
    If AnalyBeginDate.Value > AnalyEndDate.Value Then
        MsgBox "请输入大于开始时间的日期!", vbExclamation
    ElseIf AnalyBeginDate.Text = "" Then
        AnalyBeginDate.SetFocus
    Else
        mblnIsPeriodChanged = True
        If mblnResponseChange = False And CDate(AnalyEndDate.Text) <> CDate(mclsFinanceReport.DateEnd) Then
            cmbAnalyDate_Choose
            cmbAnalyDate.Text = "自定义"
        End If
        mblnResponseChange = False
    End If
End Sub

Private Sub cmbAnalyDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    Dim rs As rdoResultset
    Dim Strsql As String
    On Error GoTo ErrHandler
    If mblnFirstChange = True Or mblnReportReset = True Or (cmbAnalyDate.Text = mclsFinanceReport.DateCond And cmbAnalyDate.Text <> "自定义") Then
        Exit Sub
    End If
    If CDate(AnalyBeginDate.Text) = CDate(mclsFinanceReport.DateBegin) And CDate(AnalyEndDate.Text) = CDate(mclsFinanceReport.DateEnd) And cmbAnalyDate.Text = "自定义" Then
        Exit Sub
    End If
    If cmbAnalyDate.Text = cmbReferDate.Text And cmbAnalyDate.Text <> "自定义" Then
        MsgBox "分析期类型与比较期类型重复!", vbExclamation
        cmbAnalyDate.ReferRow = mintReferRow1
        Me.Refresh
        Exit Sub
    End If
    mstrAnalyDateOP = mclsFinanceReport.ExgPeriodType(cmbAnalyDate.Text)
    If Trim(cmbAnalyDate.Text) = "自定义" Then
        mdtmAnalyDate1 = AnalyBeginDate.Text
        mdtmAnalyDate2 = AnalyEndDate.Text
        UpdateCond "AnalyPeriod"
        mblnIsPeriodChanged = True
        Exit Sub
    End If
    If Trim(cmbAnalyDate.Text) = "所有" Then
        Strsql = "SELECT MAX(Cdate(" & mstrAccountDataType & ".strDate)) AS MaxDate,MIN(Cdate(" & mstrAccountDataType & ".strDate)) AS MinDate " & _
                " FROM " & mstrAccountDataType
        Set rs = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
        With rs
            AnalyBeginDate.Value = !MinDate
            AnalyEndDate.Value = !MaxDate
            .Close
        End With
    Else
        gclsBase.GetBeginAndEndDate cmbAnalyDate.Text, Date, D1, D2
        AnalyBeginDate.Value = D1
        AnalyEndDate.Value = D2
    End If
    mdtmAnalyDate1 = AnalyBeginDate.Text
    mdtmAnalyDate2 = AnalyEndDate.Text
    mblnIsPeriodChanged = True
    UpdateCond "AnalyPeriod"
    mblnResponseChange = True
    Exit Sub
ErrHandler:
    cmbAnalyDate.Text = mclsFinanceReport.DateCond
End Sub

Private Sub cmbReferDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    Dim rs As rdoResultset
    Dim Strsql As String
    On Error GoTo ErrHandler
    If mblnFirstChange = True Or mblnReportReset = True Or (cmbReferDate.Text = mclsFinanceReport.DateCond1 And cmbReferDate.Text <> "自定义") Then
        Exit Sub
    End If
    If CDate(ReferBeginDate.Text) = CDate(mclsFinanceReport.DateBegin1) And CDate(ReferEndDate.Text) = CDate(mclsFinanceReport.DateEnd1) And cmbReferDate.Text = "自定义" Then
        Exit Sub
    End If
    If cmbReferDate.Text = cmbAnalyDate.Text And cmbReferDate.Text <> "自定义" Then
        MsgBox "比较期类型与分析期类型重复!", vbExclamation
        cmbReferDate.ReferRow = mintReferRow2
        Me.Refresh
        Exit Sub
    End If
    mstrReferDateOP = mclsFinanceReport.ExgPeriodType(cmbReferDate.Text)
    If Trim(cmbReferDate.Text) = "自定义" Then
        mdtmReferDate1 = ReferBeginDate.Text
        mdtmReferDate2 = ReferEndDate.Text
        UpdateCond "ReferPeriod"
        Exit Sub
    End If
    If Trim(cmbReferDate.Text) = "所有" Then
        Strsql = "SELECT MAX(Cdate(" & mstrAccountDataType & ".strDate)) AS MaxDate,MIN(Cdate(" & mstrAccountDataType & ".strDate)) AS MinDate " & _
                " FROM " & mstrAccountDataType
        Set rs = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
        With rs
            ReferBeginDate.Value = !MinDate
            ReferEndDate.Value = !MaxDate
            .Close
        End With
    Else
        gclsBase.GetBeginAndEndDate cmbReferDate.Text, Date, D1, D2
        ReferBeginDate.Value = D1
        ReferEndDate.Value = D2
    End If
    mdtmReferDate1 = ReferBeginDate.Text
    mdtmReferDate2 = ReferEndDate.Text
    mblnIsPeriodChanged = True
    UpdateCond "ReferPeriod"
    Exit Sub
ErrHandler:
    ReferBeginDate.Text = mclsFinanceReport.DateCond1
End Sub

Private Sub cmdDefine_Click()
    If mclsFinanceReport.ShowReportSet(mclsFinanceReport.ReportID, mclsFinanceReport.ViewId) = True Then
        mblnReportReset = True
        ChangeDate
        Set rstTemp = Nothing
        Me.Hide
        RefreshData
        mblnReportReset = False
    Else
        Me.Show
    End If
End Sub

Private Sub cmdHide_Click()
    grdAcntBook.Redraw = False
    grdTitle.Redraw = False
    If mblnHaveHead Then
        cmdHide.Caption = "隐藏标题(&H)"
        lblCaption.Visible = True
        grdAcntBook.top = lngOldGridTop
        grdAcntBook.Height = lblBorder.Height - 600 - lblCaption.Height - 200
        grdTitle.Width = grdAcntBook.Width
        If mblnQueryHasRecord = False Then
            grdTitle.Visible = True
        End If
        Me.Refresh
    Else
        lngOldGridTop = grdAcntBook.top
        lngOldGridHeight = lblBorder.Height - 600 - lblCaption.Height - 200
        cmdHide.Caption = "显示标题(&I)"