⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 databas.bas

📁 本系统是一个报表分析查询系统
💻 BAS
字号:
Attribute VB_Name = "DataBas"
Option Explicit

Private Type ColDsec
 Type As Long
 Name As String
 Digit As Integer
End Type

Private Type CellText
 tCol As Long
 tRow As Long
 tText As String
 tType As Long
 tDigit As Integer
End Type

Private Type CellDesc
 MaxCol As Integer
 MaxRow As Integer
 CurCol As Long
 CurRow As Long
 ColData() As ColDsec
 Text() As CellText
End Type

Private Type CmdShow
 Save_Cmd As Boolean
 Prnt_Cmd As Boolean
 Find_Cmd As Boolean
End Type

Public meObj As New EditTable.EditTableCls
Public meCell As CellDesc
Public CmdState As CmdShow
Public selTableName As String

Public Sub InitRith()
 Dim MsgInfo As String
 With CmdState
  '//保存权限 权限ID:16
  .Save_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 21, MsgInfo)
  '//打印权限
  .Prnt_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 19, MsgInfo)
  '//搜索权限
  .Find_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 20, MsgInfo)
 End With
End Sub

'//计算表格的宽度行列
Public Function getCellData(ByVal tName As String, ByRef MsgInfo As String) As Boolean
 On Error GoTo ErrHandle
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim Sql As String
 Dim iLoop As Integer
 Dim jLoop As Integer
 Dim iCount As Integer
 Sql = "select count(*) as tCount from " & tName
 DaCn.ConnectionString = meObj.BaseInfo.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("tCount")) Then
  meCell.MaxRow = DaRs("tCount") + 1 + 1 '//系统+标题+表体
 End If
 DaRs.Close
 '//
 Sql = "select * from " & tName
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 meCell.MaxCol = DaRs.Fields.Count + 1
 jLoop = 0
 For iLoop = 0 To DaRs.Fields.Count - 1
  jLoop = jLoop + 1
  ReDim Preserve meCell.ColData(1 To jLoop)
  meCell.ColData(jLoop).Name = DaRs.Fields(iLoop).Name
  meCell.ColData(jLoop).Type = DaRs.Fields(iLoop).Type
  meCell.ColData(jLoop).Digit = DaRs.Fields(iLoop).NumericScale
 Next
 iCount = 0
 jLoop = 1
 '//
 If Not DaRs.EOF Then
  While Not DaRs.EOF
   jLoop = jLoop + 1
   For iLoop = 0 To DaRs.Fields.Count - 1
    iCount = iCount + 1
    ReDim Preserve meCell.Text(1 To iCount)
    With meCell.Text(iCount)
     .tCol = iLoop + 1
     .tRow = jLoop
     If Not IsNull(DaRs(iLoop)) Then
      .tText = DaRs(iLoop)
      .tType = DaRs(iLoop).Type
      .tDigit = DaRs(iLoop).NumericScale
     Else
      .tType = meCell.ColData(iLoop).Type
      Select Case .tType
       Case 3, 4, 5, 6, 11, 17, 20, 128, 131, 204 '//数值
        .tText = "0"
       Case 129, 135, 200, 201, 202, 203 '//字符
        .tText = ""
      End Select
     End If
    End With
   Next
   DaRs.MoveNext
  Wend
 End If
 '//
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 MsgInfo = "数据初始化完成"
 getCellData = True
 Exit Function
ErrHandle:
 MsgInfo = "错误:" & Err.Description
 getCellData = False
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -