frmacntbookwizard.frm

金算盘软件代码

   End With
End Sub

'加载固定、已选栏目
Private Sub AddColumn(lstDesc As ListBox, rstSource As rdoResultset)
  Dim lngWidth As Long
   With rstSource
        mclsReportSet.FixColumns = 0
        If .RowCount > 0 Then
            Do While Not .EOF
                If Trim(!strReportFieldDesc) = "" Or IsNull(!strReportFieldDesc) Then
                    lngWidth = Utility.GetDisplayWidth(!strViewFieldDesc, !bytFieldSize)
                    lngWidth = IIf(lngWidth > !lngDisplayWidth, lngWidth, !lngDisplayWidth)
                    
                    lstDesc.AddItem !strViewFieldDesc & Space(40) & !strFieldName & "`" & _
                                    lngWidth & "`" & !bytsort & "`" & !blnIsFixed & "`" & _
                                    .rdoColumns("ViewField.lngViewFieldID") & "`" & _
                                    !strFieldType & "`" & !bytFieldSize & "`" & _
                                    !blnIsHeaded & "`" & !strCombine & "`" & !bytReportSumMethod & "`" & _
                                    !bytPageSumMethod & "`" & !strTableName & "`" & !blnIsMust
                Else
                    lngWidth = Utility.GetDisplayWidth(!strReportFieldDesc, !bytFieldSize)
                    lngWidth = IIf(lngWidth > !lngDisplayWidth, lngWidth, !lngDisplayWidth)
                    
                    lstDesc.AddItem !strReportFieldDesc & Space(40) & !strFieldName & "`" & _
                                    lngWidth & "`" & !bytsort & "`" & !blnIsFixed & "`" & _
                                    .rdoColumns("ViewField.lngViewFieldID") & "`" & _
                                    !strFieldType & "`" & !bytFieldSize & "`" & _
                                    !blnIsHeaded & "`" & !strCombine & "`" & !bytReportSumMethod & "`" & _
                                    !bytPageSumMethod & "`" & !strTableName & "`" & !blnIsMust
                End If
                If !blnIsFixed Then
                    mclsReportSet.FixColumns = mclsReportSet.FixColumns + 1
                End If
                .MoveNext
            Loop
            lstDesc.ListIndex = 0
        End If
   End With
End Sub

Private Sub txtNum1_Change()
    mblnChanged = True
End Sub

Private Sub txtNum2_Change()
    mblnChanged = True
End Sub

'复制所有预置向导的字段信息
Private Sub CopyWizard()
  Dim rstSource As rdoResultset
  Dim rstDesc As rdoResultset
  Dim strSql As String
  Dim intAcntStyle As Integer
  
  intAcntStyle = 1
End Sub

Private Sub cmdLeftAll_Click()
    Dim i As Integer
    Dim Count As Integer
    Dim DelCol As Integer

    With lstChoosed
        DelCol = mclsReportSet.FixColumns
        Count = .ListCount - DelCol
        For i = 0 To Count - 1
            If GetNoXString(GetNoXString(.list(DelCol), 2, Space(40)), 13, "`") Then
                DelCol = DelCol + 1
            Else
                lstBeChoose.AddItem .list(DelCol)
                .RemoveItem DelCol
            End If
        Next
        On Error Resume Next
        .ListIndex = 0
        lstBeChoose.ListIndex = lstBeChoose.ListCount - 1
    End With
    RefreshButton
    RefreshUpDown
End Sub

Private Sub cmdLeftOne_Click()
    Dim Index As Integer
    Dim blnValid As Boolean
    Dim strText As String

    With lstChoosed
        Index = .ListIndex
        strText = GetNoXString(.Text, 1, Space(40))
        If GetNoXString(GetNoXString(.Text, 2, Space(40)), 13, "`") Then
            MsgBox "“" & strText & "”是必选栏目！", vbOKOnly, Me.Caption
        Else
            If mclsReportSet.FixColumns <= Index Then
                lstBeChoose.AddItem .Text
                lstBeChoose.Text = .Text
                .RemoveItem Index
            Else
                MsgBox "“" & strText & "”是固定栏目！", vbOKOnly, Me.Caption
            End If
        End If

        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton
    RefreshUpDown
End Sub

Private Sub cmdRightAll_Click()
    Dim i As Integer
    Dim Count As Integer

    With lstBeChoose
        Count = .ListCount
        For i = 0 To Count - 1
            lstChoosed.AddItem .list(0)
            .RemoveItem 0
        Next
        lstChoosed.ListIndex = 0
    End With
    RefreshButton
    RefreshUpDown
End Sub

Private Sub cmdRightOne_Click()
    Dim Index As Integer

    With lstBeChoose
        Index = .ListIndex
        lstChoosed.AddItem .Text
        lstChoosed.Text = .Text
        .RemoveItem Index
        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton
    RefreshUpDown
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'筛选条件设置
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub CmdReset_Click()
      mclsFilter.CmdReset_Click Me
End Sub

Private Sub dateone_lostfocus()
     mclsFilter.dateone_lostfocus Me
End Sub

Private Sub ReferText1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     mclsFilter.ReferText1_MouseDown Me, Button, Shift, x, y
End Sub

Private Sub ReferText2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mclsFilter.ReferText2_MouseDown Me, Button, Shift, x, y
End Sub

Private Sub tvwFilter_Collapse(ByVal Node As msComctlLib.Node)
    mclsFilter.tvwFilter_Collapse Me, Node
End Sub

Private Sub tvwFilter_Expand(ByVal Node As msComctlLib.Node)
    mclsFilter.tvwFilter_Expand Me, Node
End Sub

'单击树或者,MsgFilter.Row 改变或者单击
Private Sub tvwFilter_nodeClick(ByVal Node As msComctlLib.Node)
    mclsFilter.tvwFilter_nodeClick Me, Node
End Sub

Private Sub MsgFilter_click()
    mclsFilter.MsgFilter_click Me
End Sub

Private Sub refertext1_Choose()
    mclsFilter.refertext1_Choose Me
End Sub

Private Sub TxtFrom_KeyDown(KeyCode As Integer, Shift As Integer)
    mclsFilter.TxtFrom_KeyDown Me, KeyCode, Shift
End Sub

Private Sub txtfrom_LostFocus()
    mclsFilter.txtfrom_LostFocus Me
End Sub

Private Sub refertext2_Choose()
    mclsFilter.refertext2_Choose Me
End Sub

Private Sub dateto_lostfocus()
    mclsFilter.dateto_lostfocus Me
End Sub

Private Sub datefrom_lostfocus()
   mclsFilter.datefrom_lostfocus Me
End Sub

Private Sub txtName_LostFocus()
  Dim strErr As String
    If Trim(txtName) = "" And Not Me.ActiveControl Is cmdCancel Then
       Utility.ShowMsg Me.hwnd, "帐册名称不能为空!", vbOKOnly, App.title
       SSTab1.Tab = 0
       txtName.SetFocus
    End If
    If Report.NameIsErr(txtName.Text, strErr) Then
       Utility.ShowMsg Me.hwnd, "帐表名称中包含非法字符“" & strErr & "”!", vbOKOnly, App.title
       txtName.SetFocus
    End If
End Sub

Private Sub TxtTo_KeyDown(KeyCode As Integer, Shift As Integer)
    mclsFilter.TxtTo_KeyDown Me, KeyCode, Shift
End Sub

Private Sub TxtTo_lostfocus()
   mclsFilter.TxtTo_lostfocus Me
End Sub

'************** 表头处理 ****************

Private Sub GetHead()
   Dim intCount As Integer
   Dim strHead As String
   
   With lstChoosed2
       If mclsReportSet.HeadFields <> .ListCount Then
          mblnHeadChange = True
       End If
       mclsReportSet.HeadFields = .ListCount
       For intCount = 1 To .ListCount
           .ListIndex = intCount - 1
           mclsReportSet.HeadFieldId(intCount) = GetNoXString(.Text, 2, "/")
           strHead = Trim(GetNoXString(.Text, 1, "/"))
           If strHead <> mclsReportSet.HeadFieldName(intCount) Then
               mblnHeadChange = True
           End If
           mclsReportSet.HeadFieldName(intCount) = strHead
           mclsReportSet.HeadType(intCount) = GetNoXString(.Text, 3, "/")
           mclsReportSet.HeadTop(intCount) = GetNoXString(.Text, 4, "/")
           mclsReportSet.HeadLeft(intCount) = GetNoXString(.Text, 5, "/")
           mclsReportSet.HeadHeight(intCount) = GetNoXString(.Text, 6, "/")
           mclsReportSet.HeadWidth(intCount) = GetNoXString(.Text, 7, "/")
           mclsReportSet.HeadAlign(intCount) = GetNoXString(.Text, 8, "/")
           mclsReportSet.CodeShowType(intCount) = GetNoXString(.Text, 9, "/")
       Next intCount
   End With
End Sub

Private Sub cmdLeftAll2_Click()
    Dim i As Integer
    Dim intCount As Integer
    Dim intIndex As Integer

    With lstChoosed2
        intCount = .ListCount - 1
        intIndex = 0
        For i = 0 To intCount
            If Val(GetNoXString(.list(intIndex), 3, "/")) <> 1 Then
                lstBeChoose2.AddItem .list(intIndex)
                .RemoveItem intIndex
            Else
                intIndex = intIndex + 1
            End If
        Next
        On Error Resume Next
        .ListIndex = 0
        lstBeChoose2.ListIndex = 0
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdLeftOne2_Click()
    Dim Index As Integer
    Dim blnValid As Boolean

    With lstChoosed2
        Index = .ListIndex
        If Val(GetNoXString(.Text, 3, "/")) <> 1 Then
            lstBeChoose2.AddItem .Text
            lstBeChoose2.Text = .Text
            .RemoveItem Index
        Else
            MsgBox "“" & Trim(GetNoXString(.Text, 1, "/")) & "”是必选表头栏目!", vbOKOnly, Me.Caption
        End If

        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdRightAll2_Click()
    Dim i As Integer
    Dim Count As Integer

    With lstBeChoose2
        Count = .ListCount
        For i = 0 To Count - 1
            lstChoosed2.AddItem .list(0)
            .RemoveItem 0
        Next
        lstChoosed2.ListIndex = 0
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdRightOne2_Click()
    Dim Index As Integer

    With lstBeChoose2
        Index = .ListIndex
        lstChoosed2.AddItem .Text
        lstChoosed2.Text = .Text
        .RemoveItem Index
        If .ListCount > 0 Then
            .ListIndex = IIf(Index < .ListCount, Index, .ListCount - 1)
        End If
    End With
    RefreshButton2
    RefreshUpDown2
End Sub

Private Sub cmdSerial2_Click(Index As Integer)
    Dim strTemp As String

    With lstChoosed2
        Select Case Index
            Case 0
                strTemp = .list(.ListIndex)
                .list(.ListIndex) = .list(.ListIndex - 1)
                .list(.ListIndex - 1) = strTemp
                .ListIndex = .ListIndex - 1
            Case 1
                strTemp = .list(.ListIndex)
                .list(.ListIndex) = .list(.ListIndex + 1)
                .list(.ListIndex + 1) = strTemp
                .ListIndex = .ListIndex + 1
        End Select
    End With
    RefreshUpDown2
End Sub

Private Sub RefreshButton2()
   If lstBeChoose2.ListCount = 0 Then
      cmdRightAll2.Enabled = False
   Else
      cmdRightAll2.Enabled = True
   End If
   If lstBeChoose2.ListIndex = -1 Then
      cmdRightOne2.Enabled = False
   Else
      cmdRightOne2.Enabled = True
   End If

   If lstChoosed2.ListCount = 0 Then
      cmdLeftAll2.Enabled = False
   Else
      cmdLeftAll2.Enabled = True
   End If
   If lstChoosed2.ListIndex = -1 Then
      cmdLeftOne2.Enabled = False
   Else
      cmdLeftOne2.Enabled = True
   End If
End Sub

Private Sub RefreshUpDown2()
   With lstChoosed2
       If .ListIndex > 0