module1.bas

windows mobile 应用程序开发实践一书的源代码

Attribute VB_Name = "Module1"
Option Explicit

Public EditCode_Value As Integer ' 当前选中的编辑框代码
Public Connection As ADOCE.Connection
Public table, indextable As ADOCE.Recordset
Set Connection = CreateObject("ADOCE.Connection.3.1")
Set table = CreateObject("ADOCE.Recordset.3.1")
DBConnect
Public Sub DBConnect()
  
    Connection.Open "" & App.Path & "\books.cdb"
     If Err Then
        unexpectedError = True
        MsgBox "打开数据库失败，请检查", vbCritical
        Err.Clear
        App.End
    End If
      
End Sub

Public Sub indexbytablename(ByVal tbname As String, ByVal xx As Object)

 ' Dim tablename As String
 Dim i As Integer
If Not table.State = adStateClosed Then
    table.Close
End If
 table.Open tbname, Connection
 If table.BOF And table.EOF Then
MsgBox tbname & "中 没有任何记录", vbOKOnly, "注意"
Exit Sub
End If

Dim s As Integer
s = xx.datagrid.Rows
 For i = 1 To s
xx.datagrid.RemoveItem 0
Next

Dim title, m As String
Dim data As String
m = table.RecordCount
xx.datagrid.Cols = table.fields.Count
Dim xxx As Integer
xxx = xx.datagrid.Cols - 1
For i = 0 To xxx
  If i = xxx Then
  title = title & table.fields(i).Name

  Else
  title = title & table.fields(i).Name & vbTab

  End If
Next
xx.datagrid.AddItem title

table.MoveFirst

Dim j As Integer
 For i = 1 To table.RecordCount
    For j = 0 To xxx
       If j = xxx Then
           data = data & ridflux(table.fields(j).Value)
           xx.datagrid.ColWidth(j) = Len(table.fields(j).Name) + 1400
         Else
           data = data & ridflux(table.fields(j)) & vbTab
           xx.datagrid.ColWidth(j) = Len(table.fields(j).Name) + 1400
        End If
        
    Next
   xx.datagrid.AddItem data
     '  File1.LinePrint data
   data = ""
 table.MoveNext
 Next
 'File1.Close
 
 xx.datagrid.Redraw = True

End Sub
Public Function ridflux(ByVal dt As String) As String
  
  Dim pos As Integer
  pos = InStr(dt, ".")
  If pos > 0 Then
  ridflux = Mid(Trim(dt), 1, pos + 3)
  Else
  ridflux = dt
  End If
  

End Function