frmbanreportset.frm

金算盘软件代码

      If (lngColType And 128) = 0 Then
          lstBeChoose.AddItem "本期应付"
      End If
      If (lngColType And 16) = 0 Then
          lstBeChoose.AddItem "本期已付"
      End If
      If (lngColType And 64) = 0 Then
          lstBeChoose.AddItem "期末应付余额"
      End If
   End Select
End Sub

'通过类的属性取已选栏目
Private Sub ReGetChoosed()
  Dim intCount As Integer
  Dim strAdd As String
  Dim lngColType As Long
  
   With mclsReportSet
      For intCount = 1 To .Columns
         If .ColumnMayChoose(intCount) Then
            strAdd = .ColumnDesc(intCount) & Space(100) & .ColumnFieldName(intCount) & "`" & .ColumnWidth(intCount) & _
                     "`" & .ColumnOrderType(intCount) & "`" & .ColumnIsFix(intCount) & "`" & .ColumnFieldID(intCount) & _
                     "`" & .ColumnFieldType(intCount) & "`" & .ColumnFieldSize(intCount) & "`" & False & "`" & _
                     .ColumnCombine(intCount) & "`" & 0 & "`" & 0 & "`" & " " & "`" & .ColumnIsMust(intCount) & "`" & .ColumnGroup(intCount)
            lstChoosed.AddItem strAdd
         End If
      Next intCount
   End With
   Select Case mclsReportSet.ViewId
      Case 632, 636, 662, 680
        lngColType = mclsReportSet.ColType
        If (lngColType And 8) <> 0 Then
            lstChoosed.AddItem "期初余额"
        End If
        If (lngColType And 16) <> 0 Then
            lstChoosed.AddItem "本期借方发生"
        End If
        If (lngColType And 128) <> 0 Then
            lstChoosed.AddItem "本期贷方发生"
        End If
        If (lngColType And 32) <> 0 Then
            lstChoosed.AddItem "借方累计发生"
        End If
        If (lngColType And 256) <> 0 Then
            lstChoosed.AddItem "贷方累计发生"
        End If
        If (lngColType And 64) <> 0 Then
            lstChoosed.AddItem "期末余额"
        End If
      Case 638
        lngColType = mclsReportSet.ColType
        If (lngColType And 8) <> 0 Then
            lstChoosed.AddItem "期初应收余额"
        End If
        If (lngColType And 16) <> 0 Then
            lstChoosed.AddItem "本期应收"
        End If
        If (lngColType And 128) <> 0 Then
            lstChoosed.AddItem "本期已收"
        End If
        If (lngColType And 64) <> 0 Then
            lstChoosed.AddItem "期末应收余额"
        End If
      Case 639
        lngColType = mclsReportSet.ColType
        If (lngColType And 8) <> 0 Then
            lstChoosed.AddItem "期初应付余额"
        End If
        If (lngColType And 128) <> 0 Then
            lstChoosed.AddItem "本期应付"
        End If
        If (lngColType And 16) <> 0 Then
            lstChoosed.AddItem "本期已付"
        End If
        If (lngColType And 64) <> 0 Then
            lstChoosed.AddItem "期末应付余额"
        End If
   End Select
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(100) & !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(100) & !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 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 InStr(1, .list(DelCol), " ") = 0 Then
                lstBeChoose.AddItem .list(DelCol)
                lstBeChoose.Text = .list(DelCol)
                .RemoveItem DelCol
            Else
                If GetNoXString(GetNoXString(.list(DelCol), 2, Space(100)), 13, "`") Then
                    DelCol = DelCol + 1
                Else
                    lstBeChoose.AddItem .list(DelCol)
                    .RemoveItem DelCol
                End If
            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
        If Index = -1 Then
           Exit Sub
        End If
        If InStr(1, .Text, " ") = 0 Then
            lstBeChoose.AddItem .Text
            lstBeChoose.Text = .Text
            .RemoveItem Index
        Else
            strText = GetNoXString(.Text, 1, Space(100))
            If GetNoXString(GetNoXString(.Text, 2, Space(100)), 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
        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()
      mclsFilterCond.CmdReset_Click Me
End Sub

Private Sub dateone_lostfocus()
     mclsFilterCond.dateone_lostfocus Me
End Sub

Private Sub ReferText1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     mclsFilterCond.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)
    mclsFilterCond.ReferText2_MouseDown Me, Button, Shift, x, y
End Sub

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

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

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

Private Sub MsgFilter_click()
    mclsFilterCond.MsgFilter_click Me
End Sub

Private Sub refertext1_Choose()
    mclsFilterCond.refertext1_Choose Me
End Sub

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

Private Sub txtfrom_LostFocus()
    mclsFilterCond.txtfrom_LostFocus Me
End Sub

Private Sub refertext2_Choose()
    mclsFilterCond.refertext2_Choose Me
End Sub

Private Sub dateto_lostfocus()
    mclsFilterCond.dateto_lostfocus Me
End Sub

Private Sub datefrom_lostfocus()
   mclsFilterCond.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)
    mclsFilterCond.TxtTo_KeyDown Me, KeyCode, Shift
End Sub

Private Sub TxtTo_lostfocus()
   mclsFilterCond.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