frmbanreportset.frm

金算盘软件代码

            Height          =   2745
            Left            =   120
            TabIndex        =   8
            Top             =   210
            Width           =   2415
            _ExtentX        =   4260
            _ExtentY        =   4842
            _Version        =   393217
            HideSelection   =   0   'False
            Indentation     =   529
            LineStyle       =   1
            Style           =   7
            SingleSel       =   -1  'True
            BorderStyle     =   1
            Appearance      =   1
         End
      End
      Begin ListRefer.ListText cmbOnlyData 
         Height          =   285
         Left            =   -71655
         TabIndex        =   60
         Top             =   1980
         Width           =   3915
         _ExtentX        =   6906
         _ExtentY        =   503
         CodeSort        =   -1  'True
         AutoPop         =   0   'False
         BackColor       =   -2147483643
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label lblCond 
         AutoSize        =   -1  'True
         Caption         =   "条件显示"
         Height          =   180
         Left            =   300
         TabIndex        =   9
         Top             =   3810
         Width           =   720
      End
      Begin VB.Label Label11 
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         Caption         =   "报表名称(&N)"
         ForeColor       =   &H00000000&
         Height          =   180
         Left            =   -72840
         TabIndex        =   1
         Top             =   1380
         Width           =   1005
      End
   End
   Begin VB.Line linSep 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   0
      X2              =   8130
      Y1              =   4545
      Y2              =   4545
   End
   Begin VB.Line linSep 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   0
      X2              =   8130
      Y1              =   4530
      Y2              =   4530
   End
End
Attribute VB_Name = "frmBanReportSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  余额表设置窗体
'  作者：魏 然
'  日期：1998.10.24
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mclsFilterCond As FormCond           '查询条件类
Private mclsReportSet As banreport

Private mlngStepNum As Long      '当前向导步数
Private mintMaxStep As Integer   '最大向导步数
Private mintIndex As Integer     '上次设置条件的字段在列表中的 ListIndex

Private mblnChanged As Boolean       '条件是否改变
Private mblnOk As Boolean            '是否完成
Private mblnLoaded As Boolean
Private mblnHeadChange As Boolean
Private WithEvents mclsHook As Hook        '响应msgFilter中vbUp 和vbDown
Attribute mclsHook.VB_VarHelpID = -1


'''''''''''''''''''''''''''''
'
'        属     性
'
'''''''''''''''''''''''''''''

Public Property Get Filtercond() As FormCond
   Set Filtercond = mclsFilterCond
End Property

Public Property Set Filtercond(New_Filter As FormCond)
   Set mclsFilterCond = New_Filter
End Property

Public Property Get banreport() As banreport
   Set banreport = mclsReportSet
End Property

Public Property Set banreport(New_banreport As banreport)
   Set mclsReportSet = New_banreport
End Property


'''''''''''''''''''''''''''''
'
'       方     法
'
'''''''''''''''''''''''''''''


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

Private Sub cmbDateBegin_Change()
    mblnChanged = True
End Sub

Private Sub cmbDateEnd_Change()
    mblnChanged = True
End Sub

Private Sub chkOnlyData_Click()
  If chkOnlyData.Value = 1 Then
     cmbOnlyData.Visible = True
     chkQuantity.Value = 0
     chkQuantity.Visible = False
     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
    If mclsReportSet.ViewId = 636 Or mclsReportSet.ViewId = 632 Or mclsReportSet.ViewId = 680 Then
        chkQuantity.Visible = True
     End If
     cmbOnlyData.Visible = False
     mclsReportSet.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 chkQuantity_Click()
  If chkQuantity = 1 Then
     mclsReportSet.ColType = mclsReportSet.ColType Or 1
  Else
     mclsReportSet.ColType = mclsReportSet.ColType - 1
  End If
End Sub

Private Sub AddPaperInfo()
  Dim strSql As String
  Dim rstPaper As rdoResultset
  
    strSql = "Select lngPaperID,strPaperCode,strPaperName From ReportPaper Where bytType=" & mclsReportSet.ViewId
    Set rstPaper = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    cmbOnlyData.ClearRefer
    Set cmbOnlyData.Recordset = rstPaper
    
    If mclsReportSet.OnlyData Then
       chkOnlyData.Value = 1
       cmbOnlyData.Visible = True
       cmbOnlyData.SeekId mclsReportSet.PaperID
    Else
       chkOnlyData.Value = 0
       cmbOnlyData.Visible = False
    End If
End Sub

Private Sub cmbOnlyData_Choose()
  If mblnLoaded Then
    Select Case mclsReportSet.ViewId
      Case 636, 662
         mclsReportSet.ColType = 216
    End Select
    mclsReportSet.PaperID = cmbOnlyData.ID
    mclsReportSet.GetReportTdSet
    lstChoosed.Clear
    lstBeChoose.Clear
    ReGetChoosed
    GetMayChoose
  End If
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 CmdCancel_Click()
  mblnOk = False
  Unload Me
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 Then
       cmdOk.Enabled = True
    Else
       cmdOk.Enabled = False
    End If
End Sub

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, intHead As Integer, intCol As Integer
  Dim blnCurr As Boolean
  Dim strName As String
  
   If lstChoosed.ListCount = 0 Then
      ShowMsg Me.hwnd, "你至少要选择一个栏目!", vbInformation + vbOKOnly, App.title
      Exit Sub
   End If
   
   If mclsReportSet.PaperID <> 0 Then
      If lstChoosed2.ListCount > 2 Then
         ShowMsg Me.hwnd, "套打时只能选择两个表头栏目!", vbInformation + vbOKOnly, App.title
         Exit Sub
      End If
   End If
   
   mclsReportSet.ReportName = txtName
   
   With lstChoosed
            intCol = 0
            mclsReportSet.ColType = 0
            For intCount = 0 To .ListCount - 1
               If InStr(1, .list(intCount), "期初") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 8
               End If
               If InStr(1, .list(intCount), "本期借方发生") > 0 Or InStr(1, .list(intCount), "本期应收") > 0 Or InStr(1, .list(intCount), "本期已付") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 16
               End If
               If InStr(1, .list(intCount), "本期贷方发生") > 0 Or InStr(1, .list(intCount), "本期已收") > 0 Or InStr(1, .list(intCount), "本期应付") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 128
               End If
               If InStr(1, .list(intCount), "借方累计发生") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 32
               End If
               If InStr(1, .list(intCount), "贷方累计发生") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 256
               End If
               If InStr(1, .list(intCount), "期末") > 0 Then
                  intCol = intCol + 1
                  mclsReportSet.ColType = mclsReportSet.ColType Or 64
               End If
            Next intCount
            
            '包含数量栏
            If chkQuantity = 1 Then
               mclsReportSet.ColType = mclsReportSet.ColType Or 1
            End If
            
            If intCol = 0 Then
               ShowMsg Me.hwnd, "至少选择一个数据栏目!", vbQuestion + vbOKOnly, App.title
               Exit Sub
            End If
            
            If intCol = .ListCount Then
               ShowMsg Me.hwnd, "至少选择一个非数据栏目!", vbQuestion + vbOKOnly, App.title
               Exit Sub
            End If
            
            mclsReportSet.Columns = .ListCount - intCol
            intCount = 0
            For intCol = 0 To .ListCount - 1
               If InStr(1, .list(intCol), "期初余额") = 0 And InStr(1, .list(intCol), "本期借方发生") = 0 And InStr(1, .list(intCol), "本期贷方发生") = 0 _
                  And InStr(1, .list(intCol), "借方累计发生") = 0 And InStr(1, .list(intCol), "贷方累计发生") = 0 And InStr(1, .list(intCol), "期末余额") = 0 _
                  And InStr(1, .list(intCol), "应收") = 0 And InStr(1, .list(intCol), "应付") = 0 _
                  And InStr(1, .list(intCol), "已收") = 0 And InStr(1, .list(intCol), "已付") = 0 Then
                    mclsReportSet.ColumnDesc(intCount + 1) = GetNoXString(.list(intCol), 1, Space(100))
                    mclsReportSet.ColumnFieldName(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 1, "`")
                    mclsReportSet.ColumnWidth(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 2, "`")
                    mclsReportSet.ColumnOrderType(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 3, "`")
                    mclsReportSet.ColumnIsFix(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 4, "`")
                    mclsReportSet.ColumnFieldID(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 5, "`")
                    mclsReportSet.ColumnFieldType(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 6, "`")
                    mclsReportSet.ColumnFieldSize(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 7, "`")
                    mclsReportSet.ColumnCombine(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 9, "`")
                    mclsReportSet.ColumnIsMust(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 13, "`")
                    mclsReportSet.ColumnGroup(intCount + 1) = GetNoXString(GetNoXString(.list(intCol), 2, Space(100)), 14, "`")
                    mclsReportSet.ColumnMayChoose(intCount + 1) = True
                    intCount = intCount + 1
               End If
            Next intCol
   End With
   GetHead
   If mclsReportSet.CondShow <> cmbCond.ListIndex Then
      mblnHeadChange = True
   End If
   mclsReportSet.CondShow = cmbCond.ListIndex
   mblnOk = True
   Unload Me
End Sub

Private Sub RefreshUpDown()