frmbudgetanalize.frm

金算盘软件代码

         Height          =   180
         Left            =   -72585
         TabIndex        =   48
         Top             =   600
         Visible         =   0   'False
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "预算年度"
         Height          =   180
         Left            =   5004
         TabIndex        =   50
         Top             =   4056
         Visible         =   0   'False
         Width           =   720
      End
   End
   Begin VB.CommandButton cmdNextStep 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   350
      Left            =   5076
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   4272
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdPriorStep 
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   350
      Left            =   3768
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   4272
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdComplete 
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   350
      Left            =   6384
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   4272
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   350
      Left            =   2472
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   4272
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton CmdReset 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   350
      Left            =   1056
      Style           =   1  'Graphical
      TabIndex        =   28
      Top             =   4272
      UseMaskColor    =   -1  'True
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   444
      Left            =   1008
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   4212
      Visible         =   0   'False
      Width           =   1200
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      Index           =   0
      X1              =   0
      X2              =   8505
      Y1              =   4140
      Y2              =   4140
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   1
      X1              =   0
      X2              =   8910
      Y1              =   4140
      Y2              =   4140
   End
End
Attribute VB_Name = "frmBudgetAnalize"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'名称:预算分析向导窗体
'作者:雷宇
'时间:1998-10-07
'调用函数:Public Function SetReport(clsReportSet As FinanceReportWizard) As Boolean
'返回值:布尔型:如果向导完成为真,否则为假
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Const mlngFormHeight = 5028
Private Const mlngFormWidth = 7740
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                      查询条件变量
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private clsFset As ClsFormatset
Private WithEvents mclsGrid As Grid
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsHook As Hook
Attribute mclsHook.VB_VarHelpID = -1
Private mclsFilter As FormCond                           '查询条件类
Private mstrSelected() As String
Private mclsFinanceRptWiz As FinanceReportWizard            '定义类模块变量,从数据库中读取数据
Private Const mintMaxStep = 4                               '本向导共有4步
Private mbytPrep As Integer                                 '向导，预设，还是自定义表
Private mlngStepNum As Long                                 '当前的页面
Private mblnIsPeriodOver As Boolean                         '选择的条件是否合法
Private mbytDataSource As Byte                              '数据来源
Private mblnOk As Boolean                                   '是否完成了向导,而不是取消向导
Private MaxNodesNumber As Long                              '"条件树"的最大接点数
Private mstrAnalyPeriodType As String                       '分析期类型
Private mstrReferPeriodType As String                      '报告期类型
Private mblnHasDeleted As Boolean                           '条件是否被删除过
Private mblnIsComplete As Boolean                           '是否可以完成报表并且生成报表
Private mstrOldName As String                               '旧报表名称
Private mblnNewReport As Boolean                            '新报表名称
Private mbytAccountType As Byte                             '帐务类型
Private mlngBudgetID As Long                                '预算ID
Private mlngCurMousePositionY As Long                       '鼠标当前纵坐标
Private mlngCurMousePositionX As Long                       '鼠标当前横坐标
Private mstrBudgetNameOfCurRow As String                    '当前行的预算方案名称
Private mstrBudgetDataTypeOfCurRow As String                '当前行的预算数据类型
Private mbytBudgetObjectID() As Byte                          '当前行的预算数据类型
Private mbytSelectedBudgetObjectID As Byte                          '当前行的被选择的预算数据类型
Private mblnIsGetDataSource As Boolean
Private mblnTriggerChoose As Boolean
Private mblnHasCurrencyCond As Boolean
Private mblnHasDeletedCurrency As Boolean
Private mblnHasChooseBudget As Boolean
Private mstrBudgetObjectName() As String                            '(经营分析)当前行的预算对象
Private mblnBudgetIsTax() As Boolean                                '(经营分析)当前行的预算数据是否含税
Private mstrSelectedBudgetObjectName As String                            '(经营分析)当前行的被选择的预算对象
Private mstrSelectedBudgetIsTax As Boolean                            '(经营分析)当前行的被选择的预算数据是否含税
Private mintTempMaxStep As Integer '最后一页是否隐藏
Private mblnIsKeyPress As Boolean
Private mblnIsload As Boolean

Private Sub cboCond_Click()
    mclsFinanceRptWiz.CondShow = cboCond.ListIndex
End Sub

Private Sub chkType_Click(Index As Integer)
    Dim intCount As Integer
    Dim strTempString As String
    If lstSelectedItem.ListCount > 0 Then
        If CountDatatype > 0 Then
            cmdComplete.Enabled = True
            For intCount = 0 To 2
                If chkType(intCount).Value = 1 Then
                    If strTempString = "" Then
                        strTempString = chkType(intCount).Caption
                    Else
                        strTempString = strTempString & "," & chkType(intCount).Caption
                    End If
                End If
            Next
        Else
            cmdComplete.Enabled = False
        End If
    End If
    If strTempString <> "" Then
        mstrSelectedBudgetObjectName = strTempString
    End If
End Sub

'将已选栏目全部加入到可选栏目中
Private Sub cmdAllToLeft_Click()
    Dim intListCount As Integer
    Dim blnIsIn As Boolean
    Dim intFixedCount As Integer
    For intListCount = 0 To lstSelectedItem.ListCount - 1
        lstAll.AddItem lstSelectedItem.list(intListCount)
    Next intListCount
    intListCount = lstSelectedItem.ListCount - 1
    Do While intListCount >= 0
        lstSelectedItem.RemoveItem intListCount
        intListCount = intListCount - 1
    Loop
    cmdToRight.Enabled = False
    cmdAllToRight.Enabled = True
    cmdAllToLeft.Enabled = False
    If lstSelectedItem.ListCount <= 0 Then
        cmdToLeft.Enabled = False
        cmdUpWard.Enabled = False
        cmdDownWard.Enabled = False
        cmdComplete.Enabled = False
    End If
    If comBudgetYear.Text = "" Then
        cmdComplete.Enabled = False
    End If
End Sub

Private Sub cmdAllToRight_Click()
    Dim intListCount As Integer
    Dim blnIsComplete As Boolean
    For intListCount = 0 To lstAll.ListCount - 1
        lstSelectedItem.AddItem lstAll.list(intListCount)
    Next intListCount
    intListCount = lstAll.ListCount - 1
    Do While intListCount >= 0
        lstAll.RemoveItem intListCount
        intListCount = intListCount - 1
    Loop
    cmdToLeft.Enabled = False
    cmdAllToLeft.Enabled = True
    If lstAll.ListCount <= 0 Then
        cmdToRight.Enabled = False
        cmdAllToRight.Enabled = False
    End If
    ComEnabled
    If mblnIsComplete = True Then
        cmdComplete.Enabled = True
    Else
        cmdComplete.Enabled = False
    End If
    If CountDatatype = 0 Then
        cmdComplete.Enabled = False
    Else
        cmdComplete.Enabled = True
    End If
End Sub

Private Sub CmdCancel_Click()
    mblnOk = False
    Unload Me
End Sub

Private Sub cmdComplete_Click()
    Dim intCount As Integer
    Dim intArrIndex As Integer
    Dim strReportName As String
    Dim strErrString As String
    Dim blnIsSameName As Boolean
    Dim frmNewReportName As New frmReportSameName
    If CondIsValid = False Then
        Exit Sub
    End If
    mblnOk = True
    With lstSelectedItem
        mclsFinanceRptWiz.Columns = .ListCount
        For intCount = 0 To .ListCount - 1
            mclsFinanceRptWiz.ColumnDesc(intCount + 1) = GetNoXString(.list(intCount), 1, Space(100))
            mclsFinanceRptWiz.ColumnFieldName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 1, "`")
            mclsFinanceRptWiz.ColumnWidth(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 2, "`")
            mclsFinanceRptWiz.ColumnIsFix(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 4, "`")
            mclsFinanceRptWiz.ColumnFieldID(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 5, "`")
            mclsFinanceRptWiz.ColumnFieldType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 6, "`")
            mclsFinanceRptWiz.ColumnFieldSize(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 7, "`")
            mclsFinanceRptWiz.ColumnCombine(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 9, "`")
            mclsFinanceRptWiz.ColumnIsChoosed(intCount + 1) = 1
            mclsFinanceRptWiz.IsHeadColumn(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 10, "`")
            mclsFinanceRptWiz.ColumnTableName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 12, "`")
            If Not mclsFinanceRptWiz.IsHeadColumn(intCount + 1) Then
                mclsFinanceRptWiz.DataColumns = mclsFinanceRptWiz.DataColumns + 1
            End If
        Next intCount
    End With
    mclsFilter.KeyID = mclsFinanceRptWiz.ReportID
    UpdateCond
    Unload Me
End Sub
'同一目录下报表是否同名同类型
Public Function FindSameName(ByVal strName As String, ByVal bytGroup As Byte) As Boolean
    Dim strSql As String
    Dim rstName As rdoResultset
    strSql = "SELECT * FROM Report WHERE Report.strReportName='" & strName _
             & "' And Report.bytGroup= " & bytGroup
    Set rstName = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rstName.RowCount = 0 Then
        FindSameName = False
    Else
        FindSameName = True
    End If
    rstName.Close
End Function
'设置栏目顺序(向下)
Private Sub cmdDownWard_Click()
    '设置一些中间变量
    Dim intTempIndex1 As Integer
    Dim intTempIndex2 As Integer
    Dim strTempText As String
    intTempIndex1 = lstSelectedItem.ListIndex                       '当前所选项目的ListIndex
    strTempText = lstSelectedItem.Text                              '当前项目的Text值
    intTempIndex2 = lstSelectedItem.ListIndex + 1                   '当前项目的后一个项目