frmcross.frm

金算盘软件代码

       LstRow.Selected(intLoc) = True
    End If
End Sub

Private Sub LstRow_KeyPress(KeyAscii As Integer)
    '回车键：删除选中行项目
    If KeyAscii <> vbKeySpace Then Exit Sub
    If LstRow.SelCount = 1 Then cmdDelete_Click
End Sub

Private Sub LstRow_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mDragSource = 1             '拖动源
    LblDrag.Move LstRow.Left, LstRow.top + y - mlngDragHeight \ 2, mlngDragWidth, mlngDragHeight
    LblDrag.Drag
    mblnIsDrag = True           '开始拖动
End Sub


Private Sub sstCross_Click(PreviousTab As Integer)
    Dim intCount As Integer
    
    InitCrossWizard sstCross.Tab    '初始化页面
    ''判断按钮可用性
      cmdBrowse(1).Enabled = False
      cmdBrowse(0).Enabled = False
      CmdReset.Visible = False
    Select Case sstCross.Tab
    Case 0
      picWizard.ZOrder 0
    Case 1
      mblnFieldChanged = False
      If LstDataField.SelCount = 1 Then cmdBrowse(0).Enabled = True
      picWizard.ZOrder 0
    Case 2
      picWizard.ZOrder 1
      CmdReset.Visible = True
    Case 3
      picWizard.ZOrder 0
      If LstField.SelCount = 1 Then cmdBrowse(1).Enabled = True
    End Select
    Select Case PreviousTab
    Case 0
    Case 1
    '重选项目后，重新组织行，列，数据列表选择
     If mblnFieldChanged Then
        InitCrossWizard 3
        LstField.Clear
        LstRow.Clear
        LstCol.Clear
        LstData.Clear
        For intCount = 0 To LstReport.ListCount - 1
          LstField.AddItem LstReport.list(intCount)
        Next intCount
     End If
    Case 2
    Case 3
    End Select
    '是否可完成
    IsComplete
    CmdISEnabled sstCross.Tab
End Sub

Private Sub txtList_Change()
    Dim strSel As String
    Dim strTail As String
    Dim blnIsSame As Boolean
    If LstReport.ListIndex = -1 Or Trim(txtList.Text) = "" Then Exit Sub
    '如果已初始化
    If mblnIsInited(1) Then
        '判断是否重名
        strSel = LstReport.list(LstReport.ListIndex)
        blnIsSame = FindSameField(txtList.Text, LstReport.ListIndex)
        If blnIsSame Then
            Utility.ShowMsg Me.hwnd, "已有名称'" & txtList.Text & "'了,请重新命名!", vbOKOnly, App.title
            txtList.Text = StringOut(strSel, Space(100))
        End If
        '项目名称不能太长
        If Len(txtList.Text) > 30 Then
           Utility.ShowMsg Me.hwnd, "项目名称太长了,请重新命名!", vbOKOnly, App.title
           txtList.Text = Left(txtList.Text, 30)
        Else
          strTail = LstReport.list(LstReport.ListIndex)
          strSel = StringOut(strTail, Space(100))
          LstReport.list(LstReport.ListIndex) = txtList.Text & Space(100) & strTail
        End If
        '项目已改变
        mblnFieldChanged = True
    End If
End Sub

Private Sub txtList_LostFocus()
  Dim strSel As String
  Dim blnErr As Boolean
    If Me.ActiveControl Is cmdCancel Then Exit Sub
    If sstCross.Tab <> 1 Then Exit Sub
    '名称不能为空
    If Trim(txtList.Text) = "" Then
     strSel = LstReport.list(LstReport.ListIndex)
     txtList.Text = StringOut(strSel, Space(100))
    End If
    '是否有非法字符
    blnErr = NameIsErr(txtList.Text, strSel)
    If blnErr Then
        Utility.ShowMsg Me.hwnd, "列名不能有非法字符:'" & strSel & "'!", vbOKOnly, App.title
        sstCross.Tab = 1
        txtList.SetFocus
        Exit Sub
    End If
End Sub
Private Sub txtName_Change()
    '报表名称不能为空,也不能太长
    If strLen(txtName.Text) > 40 Then
       Utility.ShowMsg Me.hwnd, "报表名称太长了,请重新命名!", vbOKOnly, App.title
       txtName.Text = strLeft(txtName.Text, 40)
       Exit Sub
    ElseIf Trim(txtName.Text) = "" Then
       Utility.ShowMsg Me.hwnd, "报表名称不能为空!", vbOKOnly, App.title
       cmdComplete.Enabled = False
       Exit Sub
    End If
    mclsCross.TitleWidth = 0
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'         以下为自定义过程

'设置向导按钮的可用性
'intIndex 页面索引
Private Sub CmdISEnabled(intIndex As Integer)
    Select Case intIndex
    Case 0
      cmdPrevious.Enabled = False
      cmdnext.Enabled = True
    Case 1
      cmdnext.Enabled = True
      cmdPrevious.Enabled = True
      cmdComplete.Enabled = False
    Case 2
      cmdnext.Enabled = True
      cmdPrevious.Enabled = True
    Case 3
      cmdnext.Enabled = False
      cmdPrevious.Enabled = True
    End Select
End Sub
'查找同名项目
' strName：项目名称       intIndex:项目索引
Private Function FindSameField(strName As String, intIndex As Integer) As Boolean
Dim intCount As Integer
Dim strTemp As String
    '寻找数据列表
    intCount = 0
    Do While intCount < LstDataField.ListCount
        If intCount <> intIndex Then
            strTemp = LstDataField.list(intCount)
            strTemp = StringOut(strTemp, Space(100))
            If strTemp = strName Then
                FindSameField = True
                Exit Function
            End If
        End If
        intCount = intCount + 1
    Loop
    '寻找报表项目列表
    intCount = 0
    Do While intCount < LstReport.ListCount
        If intCount <> intIndex Then
            strTemp = LstReport.list(intCount)
            strTemp = StringOut(strTemp, Space(100))
            If strTemp = strName Then
                FindSameField = True
                Exit Function
            End If
        End If
        intCount = intCount + 1
    Loop
    FindSameField = False
End Function

'完成按钮是否有效
Private Sub IsComplete()
  If Trim(txtName.Text) = "" Or LstData.ListCount = 0 Or LstRow.ListCount = 0 _
      Or LstCol.ListCount = 0 Then
      cmdComplete.Enabled = False
  Else
      cmdComplete.Enabled = True
  End If
End Sub

'初始化向导
Private Sub InitCrossWizard(intTab As Integer)
   Dim intCount As Integer, intColumn As Integer
   Dim strItem As String, Strsql As String
   Dim rstData As rdoResultset
     
     If mblnIsInited(intTab) = True Then Exit Sub
     Select Case intTab
     Case 0
         '对组合框初始化
         cboRowSum.Clear
         cboColSum.Clear
         cboRowSum.AddItem "不参与" & Space(100) & "0"
         cboRowSum.AddItem "求和" & Space(100) & "1"
         cboRowSum.AddItem "平均" & Space(100) & "2"
         cboRowSum.AddItem "最小值" & Space(100) & "3"
         cboRowSum.AddItem "最大值" & Space(100) & "4"
        
         cboColSum.AddItem "不参与" & Space(100) & "0"
         cboColSum.AddItem "求和" & Space(100) & "1"
         cboColSum.AddItem "平均" & Space(100) & "2"
         cboColSum.AddItem "最小值" & Space(100) & "3"
         cboColSum.AddItem "最大值" & Space(100) & "4"
         
         '对报表名称，行列合计初始化
         If mclsCross.ReportPrep = 0 Then
            txtName.Text = "未命名"
         Else
            
         End If
         txtName.Text = mclsCross.ReportName
         Me.Caption = mclsCross.ReportName
         chkRow.Value = IIf(mclsCross.IsRowSum, 1, 0)
         chkCol.Value = IIf(mclsCross.IsColSum, 1, 0)
         cboRowSum.Text = cboRowSum.list(mclsCross.RowTotalMethod)
         cboColSum.Text = cboColSum.list(mclsCross.ColTotalMethod)
         mblnIsInited(0) = True
      Case 2
'        mclsFilter.InitCondArr mclsCross.ReportID, mclsCross.ViewId, 2
        mclsFilter.ShowFilter Me, mclsCross.ReportID, 2, 64, , "日期"
        CmdReset.Visible = True
        mblnIsInited(2) = True
        
     Case Else
        '初始化列表
        '对数据项目列表初始化
        LstDataField.Clear
        Strsql = "SELECT   ReportField.*,ViewField.* FROM ReportField ,ViewField " _
               & " WHERE ReportField.lngViewFieldID = ViewField.lngViewFieldID" _
               & " And ReportField.lngReportID =" & mclsCross.ReportID
        Set rstData = gclsBase.basedb.OpenResultset(Strsql, rdOpenStatic)
        With rstData
         Do While Not .EOF
           If !strViewFieldDesc <> "年" And !strViewFieldDesc <> "月" And !strViewFieldDesc <> "日" Then
           LstDataField.AddItem !strReportFieldDesc & Space(100) & .rdoColumns("ViewField.lngViewFieldID") & "\" _
                    & !strTableName & "\" & !strFieldName & "\" & !strFieldType & "\" _
                    & !bytFieldSize & "\" & !strViewFieldDesc & "\" & !lngDisplayWidth
           End If
           .MoveNext
        Loop
        End With
        '对报表列表初始化(已选项目)
        LstReport.Clear
        LstField.Clear
        intColumn = 0
        Do While intColumn < mclsCross.Columns
            intCount = 0
            Do While intCount < LstDataField.ListCount
                strItem = LstDataField.list(intCount)
                Strsql = StringOut(strItem, Space(100))
                Strsql = GetNoXString(strItem, 3, "\")
                If Strsql = mclsCross.ColumnFieldName(intColumn) Then
                   LstReport.AddItem mclsCross.ColumnDesc(intColumn) & Space(100) & strItem
                   LstField.AddItem mclsCross.ColumnDesc(intColumn) & Space(100) & strItem
                   LstDataField.RemoveItem intCount
                   Exit Do
                Else
                   intCount = intCount + 1
                End If
            Loop
            intColumn = intColumn + 1
        Loop
        '判断按钮是否可用
        txtList.Enabled = False
        LblList.Enabled = False
        CmdEnabled LstDataField, cmdArrow(0), cmdArrow(1)
        CmdEnabled LstReport, cmdArrow(2), cmdArrow(3)
        mblnIsInited(1) = True
    
        '对行列表初始化(已选项目中的行项目,类型值为3)
           LstRow.Clear
           intColumn = 0
            Do While intColumn < mclsCross.RowColumns
            intCount = 0
                Do While intCount < LstField.ListCount
                    strItem = LstField.list(intCount)
                    strItem = StringOut(strItem, Space(100))
                    If strItem = mclsCross.ColumnDesc(mclsCross.RowLoc(intColumn)) Then
                       LstRow.AddItem LstField.list(intCount)
                       LstField.RemoveItem intCount
                       Exit Do
                    Else
                        intCount = intCount + 1
                    End If
                 Loop
                 intColumn = intColumn + 1
            Loop

        '对列列表初始化(已选项目中的列项目,类型值为4)
        LstCol.Clear
        intColumn = 0
        Do While intColumn < mclsCross.ColColumns
        intCount = 0
            Do While intCount < LstField.ListCount
                strItem = LstField.list(intCount)
                strItem = StringOut(strItem, Space(100))
                If strItem = mclsCross.ColumnDesc(mclsCross.ColLoc(intColumn)) Then
                   LstCol.AddItem LstField.list(intCount)
                   LstField.RemoveItem intCount
                   Exit Do
                Else
                    intCount = intCount + 1
                End If
             Loop
             intColumn = intColumn + 1
        Loop

        '对数据列表初始化(已选项目中的数据项目,类型值为8,只有一个)
        LstData.Clear
        intColumn = 0
        Do While intColumn < mclsCross.DataColumns
            intCount = 0
            Do While intCount < LstField.ListCount
                strItem = LstField.list(intCount)
                strItem = StringOut(strItem, Space(100))
                If strItem = mclsCross.ColumnDesc(mclsCross.DataLoc) Then
                   LstData.AddItem LstField.list(intCount)
                   LstField.RemoveItem intCount
                   Exit Do
                Else
                   intCount = intCount + 1
                End If
            Loop
            intColumn = intColumn + 1
        Loop
        mblnIsInited(3) = True
     End Select
     '是否可完成
     IsComplete
 End Sub
   
 
'列表下的数据浏览
Private Sub LstBrowse(Lst As ListBox)
    Dim frm As New frmBrowse
    Dim intCount As Integer
    Dim rstBrowse As rdoResultset
    Dim Strsql As String, strTail As String, strHead As String
    Dim strType As String, strLen As String
    
    On Error Resume Next
    strTail = Lst.list(Lst.ListIndex)             '项目名称
    strHead = StringOut(strTail, Space(100))      '项目属性
    
    frm.LstBrowse.Clear
    '生成记录集
    Strsql = "SELECT DISTINCT " & GetNoXString(strTail, 3, "\") & " as [Name]  " _
            & mclsCross.FROM
    Set rstBrowse = gclsBase.basedb.OpenResultset(Strsql, rdOpenStatic)
'     If rstBrowse.rowcount = 0 Then
'        Utility.ShowMsg Me.hwnd, "选