mdbb.frm

小型VB报表系统

  lst = lst + "┤"
Else
  lst = lst + "┼"
End If
Next g
midln = lst

'确定最后行
If Check3.Value = 1 Then
  t = List3.ListCount
Else
  t = List3.ListCount - 1
End If
lst = "└"
For g = 1 To Combo7.ListIndex + 1
For i = -1 To t
  For J = 1 To mn(i) \ 2
    lst = lst + "─"
  Next J
  If i <> t Then lst = lst + "┴"
Next i
If g = Combo7.ListIndex + 1 Then
  lst = lst + "┘"
Else
  lst = lst + "┴"
End If
Next g
lstln = lst

'开始输出数据
Me.Refresh
List1.Clear
List1.AddItem LTrim(RTrim(Text2.Text))
List1.AddItem ""
List1.AddItem ""

'输出头
If Check3.Value = 1 Then
  t = List3.ListCount
Else
  t = List3.ListCount - 1
End If
lst = "┌"
For g = 1 To Combo7.ListIndex + 1
For i = -1 To t
  For J = 1 To mn(i) \ 2
    lst = lst + "─"
  Next J
  If i <> t Then lst = lst + "┬"
Next i
If g = Combo7.ListIndex + 1 Then
  lst = lst + "┐"
Else
 lst = lst + "┬"
End If
Next g
List1.AddItem lst
  
'输出项目名称
If Check3.Value = 1 Then
  t = List3.ListCount
Else
  t = List3.ListCount - 1
End If
lst = ""
For g = 1 To Combo7.ListIndex + 1
For i = -1 To t
  lst = lst + "│"
  lst = lst + Space((mn(i) - strlens(rs(-1, i))) \ 2) + rs(-1, i) + Space((mn(i) - strlens(rs(-1, i))) \ 2)
  If strlens(lst) / 2 <> strlens(lst) \ 2 Then lst = lst + " "
Next i
Next g
lst = lst + "│"
List1.AddItem lst
   
'输出表头中间行
List1.AddItem midln

If Check2.Value = 1 Then
  t1 = List4.ListCount
Else
  t1 = List4.ListCount - 1
End If

If Check3.Value = 1 Then
  t2 = List3.ListCount
Else
  t2 = List3.ListCount - 1
End If

'每个记录
g = 0
lst = ""
m = List4.ListCount Mod (Combo7.ListIndex + 1)
For n = 0 To t1
  For i = -1 To t2
     '每个项目
     lst = lst + "│"
     If Check1.Value = 0 Then '自动选择
       If i > -1 Then
         If Val(rs(n, i)) = 0 Then rs(n, i) = " "  '清0
         lst = lst + Space(mn(i) - strlens(rs(n, i))) + rs(n, i)
       Else
         lst = lst + rs(n, i) + Space(mn(i) - strlens(rs(n, i)))
       End If
     Else '数据居中
       sp = mn(i) - strlens(rs(n, i))
       lst = lst + Space(sp \ 2 + (sp Mod 2)) + rs(n, i) + Space(sp \ 2)
     End If
  Next i
  g = g + 1
  If g = Combo7.ListIndex + 1 Then
    List1.AddItem lst + "│"
    If n < t1 Then List1.AddItem midln
    g = 0
    lst = ""
  Else
    '输出中间行或表尾
    If n = t1 Then
      '输出尾
      If m = 0 Then
        List1.AddItem lstln
      Else
        For g = 1 To Combo7.ListIndex + 1 - m
          For i = -1 To t2
            lst = lst + "│" + Space(mn(i))
          Next i
        Next g
        lst = lst + "│"
        List1.AddItem lst
        List1.AddItem lstln
      End If
    End If
  End If
  ms.Label1.Caption = "正在生成报表，完成:" + CStr(Int(100 * n / t1)) + "%"
  ms.Label1.Refresh
Next n
If Combo7.ListIndex = 0 Or m = 0 Then
   List1.AddItem lstln
End If
  
List1.ListIndex = 3
mw = strlens(List1.Text)
X = SendMessage(List1.hwnd, &H194, (mw + 1) * 8, ByVal 0&)
Label2.Caption = "共 " + CStr((List1.ListCount - 5) \ 2) + " 条记录"
Unload ms
Frame1.Visible = True
List1.Visible = True

Me.BackColor = QBColor(7)
Frame1.BackColor = Me.BackColor
Frame2.BackColor = Me.BackColor
Frame3.BackColor = Me.BackColor
Frame4.BackColor = Me.BackColor
Check1.BackColor = Me.BackColor
Check2.BackColor = Me.BackColor
Check3.BackColor = Me.BackColor
Me.Refresh

End Sub
Sub msftolistmx()
'┌──────┬───┐
'│　　　　　　│　　　│
'├──────┼───┤
'│　　　　　　│　　　│
'└──────┴───┘

'条件明细表
Dim mn() As Integer
Dim lst As String
Dim midln As String
Dim lstln As String
Dim X As Long
Dim mw As Integer
Dim sp As Integer
Dim isdigi As Boolean


If List3.ListCount = 0 Then
  MsgBox Chr(13) + "请选择报表项目！   ", vbCritical
  Exit Sub
End If

If LTrim(RTrim(Text2.Text)) = "" Then
  MsgBox Chr(13) + "请设置报表名称！   ", vbCritical
  Text2.SetFocus
  Exit Sub
End If


On Error Resume Next
Frame3.Visible = False
Me.Refresh
ms.Label1.Caption = "准备生成【条件明细表】"
ms.Visible = True
ms.Refresh
Sleep (500)

X = SendMessage(List1.hwnd, &H194, 0, ByVal 0&)
Label2.Caption = ""

'排序
GridSort msf, Combo2.ListIndex - 1, 1

'检测是否选用数值型
isdigi = False
If Check2.Value = 1 Or Check3.Value = 1 Then
  For i = 0 To List3.ListCount - 1
    '找项目
    List3.ListIndex = i
    For k = 0 To msf.Cols - 1
      If msf.TextArray(k) = List3.Text And msf.ColAlignment(k) = 7 Then
        isdigi = True
        GoTo jdg
      End If
    Next k
  Next i
End If
jdg:
If isdigi = False Then
  Check2.Value = 0
  Check3.Value = 0
End If

'数值型项目纵向求和
If Check2.Value = 1 Then
  '求和
  msf.Rows = msf.Rows + 1
  For i = 1 To msf.Cols - 1
    If msf.ColAlignment(i) = 7 Then
      t = 0
      For k = 1 To msf.Rows - 2
        If Trim(msf.TextMatrix(k, i)) <> "" Then
          t = t + Val(msf.TextMatrix(k, i))
        End If
      Next k
      msf.TextMatrix(msf.Rows - 1, i) = t
    End If
  Next i
  '"合计"
  List3.ListIndex = 0
  For i = 0 To msf.Cols - 1
    If msf.ColAlignment(i) <> 7 Then
      For k = 0 To List3.ListCount - 1
        List3.ListIndex = k
        If msf.TextArray(i) = List3.Text Then
          msf.TextMatrix(msf.Rows - 1, i) = "合计"
          GoTo dodec
        End If
      Next k
    End If
  Next i
End If
dodec:
  
'横行求和
If Check3.Value = 1 Then
   msf.Cols = Data1.Recordset.Fields.Count + 1
   msf.TextArray(msf.Cols - 1) = "合计"
  '每个记录
  For m = 1 To msf.Rows - 1
    t = 0
    '每个项目
    For i = 0 To List3.ListCount - 1
      '找项目
      List3.ListIndex = i
      For k = 0 To msf.Cols - 2
        If msf.TextArray(k) = List3.Text Then Exit For
      Next k
      If msf.ColAlignment(k) = 7 Then
        t = t + Val(msf.TextMatrix(m, k))
      End If
    Next i
    msf.TextMatrix(m, msf.Cols - 1) = CStr(t)
  Next m
  List3.AddItem "合计"
End If
  
'数字型项目保留2位小数
If Combo5.ListIndex > 0 Then
  For i = 1 To msf.Rows - 1
    For k = 1 To msf.Cols - 1
     If msf.ColAlignment(k) = 7 Then
       msf.TextMatrix(i, k) = chgdec(Val(msf.TextMatrix(i, k)), Combo5.ListIndex)
     End If
    Next k
  Next i
  If msf.TextArray(msf.Cols - 1) = "合计" Then
    For i = 1 To msf.Rows - 1
      msf.TextMatrix(i, msf.Cols - 1) = chgdec(Val(msf.TextMatrix(i, msf.Cols - 1)), Combo5.ListIndex)
    Next i
  End If
End If

'计算每个项目的最大长度
ReDim mn(0 To msf.Cols - 1)
For i = 0 To msf.Rows - 1
  For k = 0 To msf.Cols - 1
    If strlens(msf.TextMatrix(i, k)) > mn(k) Then
       mn(k) = strlens(msf.TextMatrix(i, k))
       If mn(k) / 2 <> mn(k) \ 2 Then mn(k) = mn(k) + 1
    End If
  Next k
Next i
    
'确定中间行
lst = "├"
For g = 1 To Combo7.ListIndex + 1
For i = 0 To List3.ListCount - 1
  List3.ListIndex = i
  For k = 0 To msf.Cols - 1
    If msf.TextArray(k) = List3.Text Then
      Exit For
    End If
  Next k
  For J = 1 To mn(k) \ 2
    lst = lst + "─"
  Next J
  If i <> List3.ListCount - 1 Then lst = lst + "┼"
Next i
If g = Combo7.ListIndex + 1 Then
  lst = lst + "┤"
Else
  lst = lst + "┼"
End If
Next g
midln = lst

'确定最后行
lst = "└"
For g = 1 To Combo7.ListIndex + 1
For i = 0 To List3.ListCount - 1
  List3.ListIndex = i
  For k = 0 To msf.Cols - 1
    If msf.TextArray(k) = List3.Text Then
      Exit For
    End If
  Next k
  For J = 1 To mn(k) \ 2
    lst = lst + "─"
  Next J
  If i <> List3.ListCount - 1 Then lst = lst + "┴"
Next i
If g = Combo7.ListIndex + 1 Then
  lst = lst + "┘"
Else
  lst = lst + "┴"
End If
Next g
lstln = lst

'开始输出数据
List1.Clear
List1.AddItem LTrim(RTrim(Text2.Text))
List1.AddItem ""
List1.AddItem ""

'输出头
lst = "┌"
For g = 1 To Combo7.ListIndex + 1
For i = 0 To List3.ListCount - 1
  List3.ListIndex = i
  For k = 0 To msf.Cols - 1
    If msf.TextArray(k) = List3.Text Then
      Exit For
    End If
  Next k
  For J = 1 To mn(k) \ 2
    lst = lst + "─"
  Next J
  If i <> List3.ListCount - 1 Then lst = lst + "┬"
Next i
If g = Combo7.ListIndex + 1 Then
  lst = lst + "┐"
Else
 lst = lst + "┬"
End If
Next g
List1.AddItem lst
  
'输出项目名称
lst = ""
For g = 1 To Combo7.ListIndex + 1
For i = 0 To List3.ListCount - 1
  List3.ListIndex = i
  lst = lst + "│"
  For k = 0 To msf.Cols - 1
    If msf.TextArray(k) = List3.Text Then
      Exit For
    End If
  Next k
  lst = lst + Space((mn(k) - strlens(List3.Text)) \ 2) + List3.Text + Space((mn(k) - strlens(List3.Text)) \ 2)
  If strlens(lst) / 2 <> strlens(lst) \ 2 Then lst = lst + " "
Next i
Next g
lst = lst + "│"
List1.AddItem lst
   
'输出表头中间行
List1.AddItem midln
'每个记录
g = 0
lst = ""
m = (msf.Rows - 1) Mod (Combo7.ListIndex + 1)
For n = 1 To msf.Rows - 1
  For i = 0 To List3.ListCount - 1
     List3.ListIndex = i
     '检测每个项目
     For k = 0 To msf.Cols - 1
       If msf.TextArray(k) = List3.Text Then
         Exit For
       End If
     Next k
     lst = lst + "│"
     If Check1.Value = 0 Then '自动选择
       If msf.ColAlignment(k) = 7 Or msf.TextArray(k) = "合计" Then
         '清0
         If Val(msf.TextMatrix(n, k)) = 0 Then msf.TextMatrix(n, k) = ""
         lst = lst + Space(mn(k) - strlens(msf.TextMatrix(n, k))) + msf.TextMatrix(n, k)
       Else
         lst = lst + msf.TextMatrix(n, k) + Space(mn(k) - strlens(msf.TextMatrix(n, k)))
       End If
     Else '数据居中
       sp = mn(k) - strlens(msf.TextMatrix(n, k))
       lst = lst + Space(sp \ 2 + (sp Mod 2)) + msf.TextMatrix(n, k) + Space(sp \ 2)
     End If
  Next i
  g = g + 1
  If g = Combo7.ListIndex + 1 Then
    List1.AddItem lst + "│"
    If n < msf.Rows - 1 Then List1.AddItem midln
    g = 0
    lst = ""
  Else
    '输出中间行或表尾
    If n = msf.Rows - 1 Then
      '输出尾
      If m = 0 Then
        List1.AddItem lstln
      Else
        For g = 1 To Combo7.ListIndex + 1 - m
          For i = 0 To List3.ListCount - 1
            List3.ListIndex = i
            '检测每个项目
            For k = 0 To msf.Cols - 1
              If msf.TextArray(k) = List3.Text Then
                Exit For
              End If
            Next k
            lst = lst + "│" + Space(mn(k))
          Next i
        Next g
        lst = lst + "│"
        List1.AddItem lst
        List1.AddItem lstln
      End If
    End If
  End If
  ms.Label1.Caption = "正在生成报表，完成:" + CStr(Int(100 * n / (msf.Rows - 1))) + "%"
  ms.Label1.Refresh
Next n
If Combo7.ListIndex = 0 Or m = 0 Then
   List1.AddItem lstln
End If
  
List1.ListIndex = 3
mw = strlens(List1.Text)
X = SendMessage(List1.hwnd, &H194, (mw + 1) * 8, ByVal 0&)
Label2.Caption = "共 " + CStr((List1.ListCount - 5) \ 2) + " 条记录"
Unload ms
Frame1.Visible = True
List1.Visible = True

Me.BackColor = QBColor(7)