frmmultibookwizard.frm

金算盘软件代码

    mclsMultiReportSet.PaperID = cmbOnlyData.ID
    mclsMultiReportSet.GetReportTdSet
    lstChoosed.Clear
    lstBeChoose.Clear
    ReGetChoosed
    GetMayChoose
  End If
  mstrPaperCode = GetNoXString(cmbOnlyData.Text, 1)
End Sub

Private Sub cmbPosition_Click()
    If Not mblnLoaded Then
       AddExample
       Exit Sub
    End If
    If chkDebit(1).Value = 1 Then
        chkDebit_Click 1
    Else
        chkDebit_Click 0
    End If
    AddExample
End Sub

Private Sub cmbShowCode_Click()
  Dim strText As String
   strText = Left(lstChoosed2.Text, Len(lstChoosed2.Text) - 1)
   strText = strText & CStr(cmbShowCode.ListIndex + 1)
   lstChoosed2.list(lstChoosed2.ListIndex) = strText
End Sub

Private Sub cmbType_Click()
    On Error Resume Next
    mclsMultiReportSet.ReportType = cmbType.ListIndex + 1
End Sub

Private Sub cmdAdd_Click()
    grdAcnt.LeftCol = 0
    mblnAdd = True
    With grdAcnt
        If .RowHeight(1) = 0 Then
             .RowHeight(1) = 255
             '''.TextMatrix(1, conSortCol) = 1
        Else
             .AddItem ""
        End If
        cmdDel.Enabled = True
        .Row = .Rows - 1
        If Not .RowIsVisible(.Row) Then
           .TopRow = .Row
        End If
        If .Rows >= 9 Then
           .TopRow = .Rows - 2
        End If
        .col = 1
        .TextMatrix(.Row, 3) = "借"
        .TextMatrix(.Row, 4) = "√"
        '''.TextMatrix(.Row, conSortCol) = .Row
        grdAcnt_KeyDown vbKeySpace, 0
    End With
    mblnAdd = False
End Sub

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdDel_Click()
  Dim intCol As Integer
    If ShowMsg(Me.hwnd, "你确认删除该子栏目吗?", vbOKCancel + vbQuestion, App.title) = vbCancel Then
        If txtEdit.Visible Then
           txtEdit.SetFocus
        Else
           grdAcnt.SetFocus
           If grdAcnt.col = conNameCol Then
              grdAcnt_DblClick
           End If
        End If
        If litEdit.Visible Then
           litEdit.SetFocus
        End If
        Exit Sub
    End If
    If litEdit.Visible Then
       litEdit.Visible = False
    End If
    With grdAcnt
         If txtEdit.Visible Then
            txtEdit.Text = ""
            txtEdit.Visible = False
         End If
         If .Rows = 2 And .Row = 1 Then
              .RowHeight(1) = 0
              For intCol = 0 To .Cols - 1
                  .TextMatrix(1, intCol) = ""
              Next intCol
              cmdDel.Enabled = False
         Else
              .RemoveItem .Row
         End If
         .SetFocus
    End With
End Sub

Private Sub cmdNext_Click()
    If mlngStepNum < mintMaxStep Then
       mlngStepNum = mlngStepNum + 1
    End If
    ShowStep
    ComEnabled
End Sub

'涮新按钮的 Enabled 属性
Private Sub ComEnabled()
    If mlngStepNum = 2 Then
       picWizard.Visible = False
       CmdReset.Visible = True
    Else
       picWizard.Visible = True
       CmdReset.Visible = False
    End If
    If mlngStepNum = 1 Then
       CmdPrev.Enabled = False
    Else
       CmdPrev.Enabled = True
    End If
    If mlngStepNum = mintMaxStep Then
       cmdNext.Enabled = False
    Else
       cmdNext.Enabled = True
    End If
    If mlngStepNum >= mintMaxStep - 1 And mbytInitStep = 31 Then
       cmdOK.Enabled = True
    Else
       cmdOK.Enabled = False
    End If
End Sub

Private Function SuperLeft(ByVal strText As String, Index As Integer, Optional tSep As String = "-") As String
  Dim strTemp As String
  Dim intCount As Integer
    
    intCount = 1
    strTemp = GetNoXString(strText, intCount, "-")
    Do While strTemp <> "" And intCount <= Index
        If SuperLeft = "" Then
           SuperLeft = strTemp
        Else
           SuperLeft = SuperLeft & tSep & strTemp
        End If
        intCount = intCount + 1
        strTemp = GetNoXString(strText, intCount, "-")
    Loop
End Function

Private Function SetVerify() As Boolean
  Dim intCount As Integer, intRow As Integer, intLevel As Integer, intLevel2 As Integer
  Dim blnCurr As Boolean, blnCurrHead As Boolean
  Dim colTemp As New Collection
  Dim colTemp2 As New Collection
  Dim colTemp3 As New Collection
  Dim intErrType As Integer
  Dim strTemp As String
  Dim colAccount As New Collection, colLevel As New Collection
   
   On Error GoTo ErrHandle
   With grdAcnt
      If .RowHeight(1) > 0 Then
        For intRow = 1 To .Rows - 1
           intErrType = 1
           colTemp.Add intRow, UCase(Trim(grdAcnt.TextMatrix(intRow, conNameCol)))
           intErrType = 2
           colTemp2.Add intRow, UCase(Trim(grdAcnt.TextMatrix(intRow, conIDCol)))
           strTemp = GetNoXString(.TextMatrix(intRow, conCodeCol), 1, " ")
           intLevel = Utility.StringCount2(strTemp, "-") + 1
           colAccount.Add strTemp, strTemp
           colLevel.Add CStr(intLevel), strTemp
           
           If .TextMatrix(intRow, conNameCol) = "" Then
               Utility.ShowMsg Me.hwnd, "子栏目名称不能为空!", vbOKOnly + vbInformation, Me.Caption
               SSTab1.Tab = 2
               txtEdit.Visible = False
               SetVerify = False
               Set colTemp = Nothing
               Exit Function
           End If
           If .TextMatrix(intRow, conCodeCol) = "" Then
               Utility.ShowMsg Me.hwnd, Trim(.TextMatrix(0, conCodeCol)) & "名称不能为空!", vbOKOnly + vbInformation, Me.Caption
               SSTab1.Tab = 2
               SetVerify = False
               Set colTemp = Nothing
               Exit Function
           End If
           If .TextMatrix(intRow, 4) = "" And .TextMatrix(intRow, 5) = "" And .TextMatrix(intRow, 6) = "" Then
               Utility.ShowMsg Me.hwnd, "子栏目数据类型不能为空!", vbOKOnly + vbInformation, Me.Caption
               SSTab1.Tab = 2
               SetVerify = False
               Set colTemp = Nothing
               Exit Function
           End If
        Next intRow
      End If
   End With
   
   intErrType = 3
   For intRow = 1 To colAccount.Count
       For intLevel = 1 To colLevel.Item(intRow)
           strTemp = SuperLeft(colAccount.Item(intRow), intLevel)
           For intCount = 1 To colAccount.Count
               If colAccount.Item(intCount) <> colAccount.Item(intRow) And colLevel.Item(intCount) < colLevel.Item(intRow) Then
                   If colAccount.Item(intCount) = strTemp Then
                      GoTo ErrHandle
                   End If
               End If
           Next intCount
       Next intLevel
   Next intRow
   
   '是否选择展开方式
   If mclsMultiReportSet.ExpandStyle <= 0 Then
      Utility.ShowMsg Me.hwnd, "请选择一种展开方式!", vbOKOnly + vbInformation, Me.Caption
      SSTab1.Tab = 3
      SetVerify = False
      Set colTemp = Nothing
      Exit Function
   End If
   
   blnCurr = False
   blnCurrHead = False
   For intCount = 1 To grdAcnt.Rows - 1
       If Trim(grdAcnt.TextMatrix(intCount, 6)) = "√" Then
          blnCurr = True
          Exit For
       End If
   Next intCount
   
   If blnCurr Then
       For intCount = 1 To lstChoosed2.ListCount
            If GetNoXString(lstChoosed2.list(intCount - 1), 1, Space(100)) = "币种" Then
                blnCurrHead = True
                Exit For
            End If
       Next intCount
       If Not blnCurrHead Then
           ShowMsg Me.hwnd, "请选择币种为表头栏目!", vbOKOnly + vbInformation, App.title
           SetVerify = False
           Set colTemp = Nothing
           Exit Function
       End If
   End If
   Set colTemp = Nothing
   Set colTemp2 = Nothing
   Set colTemp3 = Nothing
   SetVerify = True
   Exit Function
ErrHandle:
   If intErrType = 2 Then
      Utility.ShowMsg Me.hwnd, "分析栏目不能选同一个" & cmbContent.Text & "!", vbOKOnly + vbInformation, Me.Caption
   Else
      If intErrType = 1 Then
         Utility.ShowMsg Me.hwnd, "子栏目名称重复!", vbOKOnly + vbInformation, Me.Caption
      Else
         Utility.ShowMsg Me.hwnd, "有上下级次关系的" & cmbContent.Text & "不能同时作为子栏目条件!", vbOKOnly + vbInformation, Me.Caption
      End If
   End If
   SSTab1.Tab = 2
   grdAcnt.col = conNameCol
   grdAcnt.Row = intRow
   Set colTemp = Nothing
   Set colTemp2 = Nothing
   Set colTemp3 = Nothing
   SetVerify = False
End Function

Private Sub CmdPrev_Click()
    If mlngStepNum > 1 Then
       mlngStepNum = mlngStepNum - 1
    End If
    ShowStep
    ComEnabled
End Sub

Private Sub cmdOK_Click()
  Dim intCount As Integer, intRow As Integer
  Dim intDebit As Integer, intCredit As Integer
   If Not SetVerify Then
      Exit Sub
   End If
   If cmbOnlyData.ID <> 0 And cmbOnlyData.Visible And lstChoosed2.ListCount > 5 Then
      ShowMsg Me.hwnd, "套打方式下最多只能选择5个表头栏目!", vbOKOnly + vbInformation, App.title
      Exit Sub
   End If
   
   If mstrPaperCode = "JTR241" Then
      If mclsMultiReportSet.ExpandStyle <> 20 Then
         ShowMsg Me.hwnd, "应交增值税明细帐套打只能选择借贷方发生额同时展开!", vbOKOnly + vbInformation, App.title
         Exit Sub
      Else
         intDebit = 0
         intCredit = 0
         For intCount = 1 To grdAcnt.Rows - 1
             If grdAcnt.TextMatrix(intCount, 3) = "借" Then
                intDebit = intDebit + 1
             Else
                intCredit = intCredit + 1
             End If
             If intDebit > 3 Or intCredit > 3 Then
                ShowMsg Me.hwnd, "应交增值税明细帐套打借贷方最多各有三个分析栏目!", vbOKOnly + vbInformation, App.title
                Exit Sub
             End If
         Next intCount
      End If
   End If
   
   If mstrPaperCode = "JTR231" Then
      If mclsMultiReportSet.ExpandStyle > 2 Then
         ShowMsg Me.hwnd, "多栏式明细帐套打只能选择借(贷)方余额分析!", vbOKOnly + vbInformation, App.title
         Exit Sub
      Else
         If grdAcnt.Rows > 20 Then
            ShowMsg Me.hwnd, "多栏式明细帐套打最多有19个分析栏目!", vbOKOnly + vbInformation, App.title
            Exit Sub
         End If
      End If
   End If
   mblnOk = True
   mclsMultiReportSet.ReportName = txtName
   mclsMultiReportSet.Content = Trim(cmbContent.Text)
   With lstChoosed
        mclsMultiReportSet.Columns = .ListCount
        For intCount = 0 To .ListCount - 1
            mclsMultiReportSet.ColumnDesc(intCount + 1) = GetNoXString(.list(intCount), 1, Space(100))
            mclsMultiReportSet.ColumnFieldName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 1, "/")
            mclsMultiReportSet.ColumnWidth(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 2, "/")
            mclsMultiReportSet.ColumnOrderType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 3, "/")
            mclsMultiReportSet.ColumnIsFix(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 4, "/")
            mclsMultiReportSet.ColumnFieldID(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 5, "/")
            mclsMultiReportSet.ColumnFieldType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 6, "/")
            mclsMultiReportSet.ColumnFieldSize(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 7, "/")
            mclsMultiReportSet.ColumnCombine(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 9, "/")
        Next intCount
   End With
   
   With grdAcnt
        If Not (.RowHeight(1) = 0 And .Rows = 2) Then
            mclsMultiReportSet.SubColumns = .Rows - 1
            For intCount = 1 To grdAcnt.Rows - 1
                mclsMultiReportSet.SubDesc(intCount) = .TextMatrix(intCount, conNameCol)
                mclsMultiReportSet.SubDirect(intCount) = IIf(.TextMatrix(intCount, 3) = "借", 1, -1)
                mclsMultiReportSet.SubCond(intCount) = .TextMatrix(intCount, conIDCol)
                mclsMultiReportSet.SubCode(intCount) = GetNoXString(.TextMatrix(intCount, conCodeCol), 1, " ")
                mclsMultiReportSet.SubData