frmmultibookwizard.frm

金算盘软件代码

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  多栏帐向导
'  作者：魏 然
'  日期：1998.05.21
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Const conIDCol = 0      'ID列
Const conCodeCol = 1    '编码列
Const conNameCol = 2    '子栏目名称列
'Const conSortCol = 7    '排序列

'多栏帐分析类型(1:科目 2:单位 3:部门 4:员工 5:工程 6:统计 7:项目)
Private Enum AnalysisType
   ayAccount = 1
   ayCutomer = 2
   ayDepartment = 3
   ayEmployee = 4
   ayJob = 5
   ayClass1 = 6
   ayClass2 = 7
End Enum

Private mclsFilter As FormCond
Private mclsMultiReportSet As MultiReportSet

Private mlngStepNum As Long      '当前向导步数
Private mintMaxStep As Integer   '最大向导步数
Private mintIndex As Integer     '上次设置条件的字段在列表中的 ListIndex
Private mblnReset As Boolean
Private mbytInitStep As Byte      '已经初始的步数
Private mblnOk As Boolean
Private mlngLastRow As Long
Private mlngLastCol As Long
Private mblnLoaded As Boolean
Private mAnalyType As AnalysisType
Private mblnAdd As Boolean
Private mblnErr As Boolean
Private mblnHeadChange As Boolean
Private WithEvents mclsHook As Hook        '响应msgFilter中vbUp 和vbDown
Attribute mclsHook.VB_VarHelpID = -1
Private mstrPaperCode As String
Private mintOldExpand As Integer

Private Sub InitDirect()
    Select Case mclsMultiReportSet.Direct
       Case 1
          cmbDirect.ListIndex = 0
       Case -1
          cmbDirect.ListIndex = 1
       Case 0
          cmbDirect.ListIndex = 2
    End Select
End Sub

'初始化子栏目设置表表头
Private Sub InitColume(Optional ByVal ColumnType As String = "科目")
  Dim Count As Integer
    With grdAcnt
         If .TextMatrix(0, 2) = ColumnType Then
              Exit Sub
         End If
         .Rows = 2
         .Cols = 7
         .FixedCols = 0
         .FixedRows = 1
         For Count = 0 To .Cols - 1
             .FixedAlignment(Count) = 4
         Next Count
         .ColAlignment(3) = 1
         .ColAlignment(conNameCol) = 1
         .ColAlignment(conCodeCol) = 1
         .RowHeight(0) = 400
         .TextMatrix(0, conNameCol) = "子栏目名称"
         .TextMatrix(0, conCodeCol) = ColumnType
         .TextMatrix(0, 3) = "方向"
         .TextMatrix(0, 4) = "金额"
         .TextMatrix(0, 5) = "数量"
         .TextMatrix(0, 6) = "原币"
         .TextMatrix(1, conNameCol) = ""
         .TextMatrix(1, conCodeCol) = ""
         .TextMatrix(1, 3) = ""
         .TextMatrix(1, 4) = ""
         .TextMatrix(1, 5) = ""
         .TextMatrix(1, 6) = ""
         .ColWidth(0) = 0
         
         .ColWidth(conNameCol) = 2300
         .ColWidth(conCodeCol) = 1800
         .ColWidth(3) = 500
         .ColWidth(4) = 500
         .ColWidth(5) = 500
         .ColWidth(6) = 500
         .RowHeight(1) = 0
    End With
End Sub

Private Sub InitContent()
   With cmbContent
      .AddItem "科目"
      .AddItem "单位"
      .AddItem "部门"
      .AddItem "员工"
      .AddItem "工程"
      .AddItem "统计"
      .AddItem "项目"
      .ListIndex = 0
   End With
   AddAccountRefer
End Sub

Private Sub AddAccountRefer(Optional ByVal strType As String = "科目")
    Select Case strType
      Case "科目"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtAccount)
      Case "单位"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtCustomer)
      Case "部门"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtDepartment)
      Case "员工"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtEmployee)
      Case "统计"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtClass1)
      Case "工程"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtJob)
      Case "项目"
         Set litEdit.Resultset = Utility.GetListRecordSet(lrtClass2)
    End Select
End Sub

'加入科目子栏目
Private Sub AddAcountColumn()
  Dim strSql As String
  Dim rstAccount As rdoResultset
  Dim SubAccount As String
  Dim intRow As Integer
  Dim NoCommaSubCode As String
  Dim strAccountCode As String, strAccountId As String
  Dim strAccountName As String, strAccountDirect As String
  Dim strWhere As String, strFrom As String
  Dim arrCode() As String, arrShow() As Boolean, lngCount As Long, lngNo As Long
  
   If Not (grdAcnt.Rows = 2 And grdAcnt.RowHeight(1) = 0) Then
      Exit Sub
   End If
   
   mclsFilter.GetCond strWhere
   strWhere = GetNoXString(strWhere, 1, "`")
   If strWhere = "" Then
      Exit Sub
   End If
   InitColume
   strFrom = "Account,AccountType"
   strWhere = "Account.lngAccountTypeID=AccountType.lngAccountTypeID" & " And (" & strWhere & ")"
   strSql = "Select lngAccountID,strAccountCode,strAccountName,Account.strFullName,Account.intDirection From " & strFrom & " Where " & strWhere & " Order By strAccountCode"
   Set rstAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
   With rstAccount
       If Not .EOF Then
          .MoveLast
          .MoveFirst
          '** IF 选择了一个科目 **
          If .RowCount = 1 Then
                '** IF 不是明细科目 **
                If Not gclsBase.AccountIsDetail(!lngAccountID, True, SubAccount, NoCommaSubCode, strAccountName, strAccountDirect) Then
                    intRow = 1
                    strAccountCode = GetNoXString(NoCommaSubCode, intRow, " ")
                    Do While strAccountCode <> ""
                        If strAccountCode <> !strAccountCode Then
                            If grdAcnt.RowHeight(1) = 0 Then
                                grdAcnt.RowHeight(1) = 255
                            Else
                                grdAcnt.AddItem ""
                            End If
                            grdAcnt.TextMatrix(intRow, conIDCol) = GetNoXString(SubAccount, intRow, ",")
                            grdAcnt.TextMatrix(intRow, conNameCol) = GetNoXString(strAccountName, intRow, " ")
                            grdAcnt.TextMatrix(intRow, conCodeCol) = strAccountCode
                            grdAcnt.TextMatrix(intRow, 3) = IIf(Val(GetNoXString(strAccountDirect, intRow, " ")) = 1, "借", "贷")
                            grdAcnt.TextMatrix(1, 4) = "√"
                            intRow = intRow + 1
                        End If
                        strAccountCode = GetNoXString(NoCommaSubCode, intRow, " ")
                    Loop
                '** ELSE OF IF 不是明细科目 **
                Else
                        If grdAcnt.RowHeight(1) = 0 Then
                            grdAcnt.RowHeight(1) = 255
                        Else
                            grdAcnt.AddItem ""
                        End If
                        grdAcnt.TextMatrix(1, conIDCol) = GetNoXString(SubAccount, 1, ",")
                        grdAcnt.TextMatrix(1, conNameCol) = strAccountName
                        grdAcnt.TextMatrix(1, conCodeCol) = NoCommaSubCode
                        grdAcnt.TextMatrix(1, 3) = IIf(Val(strAccountDirect) = 1, "借", "贷")
                        grdAcnt.TextMatrix(1, 4) = "√"
                '** END OF IF 不是明细科目 **
                End If
          '** ELSE OF IF 选择了一个科目 **
          Else
                ReDim arrCode(.RowCount)
                ReDim arrShow(.RowCount)
                intRow = 1
                Do While Not .EOF
                   arrCode(intRow) = !strAccountCode
                   arrShow(intRow) = True
                   .MoveNext
                   intRow = intRow + 1
                Loop
                
                For intRow = .RowCount To 1 Step -1
                    If arrShow(intRow) Then
                        lngNo = 1
                        strAccountCode = GetNoXString(arrCode(intRow), lngNo, "-")
                        Do While strAccountCode <> ""
                           For lngCount = intRow - 1 To 1 Step -1
                              If arrCode(lngCount) = strAccountCode Then
                                  arrShow(lngCount) = False
                              End If
                           Next lngCount
                           lngNo = lngNo + 1
                           If lngNo >= strCount(arrCode(intRow), "-") + 1 Then
                              strAccountCode = ""
                           Else
                              strAccountCode = GetNoXString(arrCode(intRow), lngNo, "-")
                           End If
                        Loop
                    End If
                Next intRow
                
                intRow = 1
                lngCount = 1
                .MoveFirst
                Do While Not .EOF
                    If arrShow(lngCount) Then
                        If grdAcnt.RowHeight(1) = 0 Then
                            grdAcnt.RowHeight(1) = 255
                        Else
                            grdAcnt.AddItem ""
                        End If
                        grdAcnt.TextMatrix(intRow, conIDCol) = !lngAccountID
                        grdAcnt.TextMatrix(intRow, conNameCol) = !strAccountName
                        grdAcnt.TextMatrix(intRow, conCodeCol) = !strAccountCode
                        grdAcnt.TextMatrix(intRow, 3) = IIf(!intDirection = 1, "借", "贷")
                        grdAcnt.TextMatrix(intRow, 4) = "√"
                        intRow = intRow + 1
                    End If
                    lngCount = lngCount + 1
                    .MoveNext
                Loop
          '** END OF IF 选择了一个科目 **
          End If
       End If
   End With
End Sub

Private Sub ShowStep()
    SSTab1.Tab = mlngStepNum - 1
End Sub

Private Sub chkDebit_Click(Index As Integer)
    mclsMultiReportSet.ExpandStyle = 0
    If cmbPosition.ListIndex = 0 Then
        If chkDebit(0).Value = 1 And chkDebit(1).Value = 0 Then
            mclsMultiReportSet.ExpandStyle = 4
        End If
        If chkDebit(0).Value = 1 And chkDebit(1).Value = 1 Then
            mclsMultiReportSet.ExpandStyle = 20
        End If
        If chkDebit(0).Value = 0 And chkDebit(1).Value = 1 Then
            mclsMultiReportSet.ExpandStyle = 16
        End If
    End If
    
    If cmbPosition.ListIndex = 1 Then
        If chkDebit(0).Value = 1 And chkDebit(1).Value = 0 Then
            mclsMultiReportSet.ExpandStyle = 8
        End If
        If chkDebit(0).Value = 1 And chkDebit(1).Value = 1 Then
            mclsMultiReportSet.ExpandStyle = 40
        End If
        If chkDebit(0).Value = 0 And chkDebit(1).Value = 1 Then
            mclsMultiReportSet.ExpandStyle = 32
        End If
    End If
    
    AddExample
End Sub

Private Sub chkOnlyData_Click()
  If chkOnlyData.Value = 1 Then
     cmbOnlyData.Visible = True
     If cmbOnlyData.ReferRow = -1 Then
        cmbOnlyData.ReferRow = 0
     Else
        cmbOnlyData_Choose
     End If
     lstBeChoose.Enabled = False
     lstChoosed.Enabled = False
     cmdSerial(0).Enabled = False
     cmdSerial(1).Enabled = False
     cmdRightOne.Enabled = False
     cmdRightAll.Enabled = False
     cmdLeftOne.Enabled = False
     cmdLeftAll.Enabled = False
  Else
     cmbOnlyData.Visible = False
     mstrPaperCode = ""
     mclsMultiReportSet.PaperID = 0
     lstBeChoose.Enabled = True
     lstChoosed.Enabled = True
     cmdSerial(0).Enabled = True
     cmdSerial(1).Enabled = True
     cmdRightOne.Enabled = True
     cmdRightAll.Enabled = True
     cmdLeftOne.Enabled = True
     cmdLeftAll.Enabled = True
  End If
End Sub

Private Sub cmbContent_Click()
    If mAnalyType = cmbContent.ListIndex + 1 Then
        Exit Sub
    End If
    mAnalyType = cmbContent.ListIndex + 1
    InitColume cmbContent.Text
    AddAccountRefer Trim(cmbContent.Text)
End Sub

Private Sub cmbExpand_Click()
    If Not mblnLoaded Then
       AddExample
       Exit Sub
    End If
    mclsMultiReportSet.ExpandStyle = 0
    picExpandStyle(cmbExpand.ListIndex).ZOrder
    If cmbExpand.ListIndex = 1 Then
       optExpand_Click (0)
    Else
       If chkDebit(0).Enabled Then
          chkDebit(0).Value = 1
       End If
       chkDebit(1).Value = 0
       chkDebit_Click (0)
    End If
    AddExample
End Sub

Private Sub cmbOnlyData_Choose()
  If mblnLoaded Then