form1.ebf

来自「Windows CE 应用程序设计随书源码」· EBF 代码 · 共 1,107 行 · 第 1/3 页

FrameDataFind.Visible = False

TextName.Enabled = True
TextTel.Enabled = True
TextAddress.Enabled = True
AddDataOK.Visible = True
AddDataCancle.Visible = True
ComDataDel.Enabled = False
FlagAddOrEdit = True

HScroll1.Visible = False

TextName.Text = ""
TextTel.Text = ""
TextAddress.Text = ""
TextName.SetFocus

ConditionShow.Text = "增加记录！"


End Sub


'删除数据按钮
Private Sub ComDataDel_Click()

FrameDataShow.Visible = True
FrameDataFind.Visible = False

If MsgBox("删除此记录？", vbOKCancel) = vbOK Then
    If connOpen = True Then
        Dim rs As ADOCE.Recordset
        'Dim i As Integer
        Set rs = CreateObject("ADOCE.Recordset.3.0")
        On Error Resume Next
        rs.Open "select * from FriendTable", conn, adOpenKeyset, adLockOptimistic
        rs.Move DBpoint - 1, adBookmarkFirst
        rs.delete
        rs.movefirst
        rs.update
        rs.Close
        connClose
        ComDataShow_Click
    End If
        

End If


End Sub


'修改数据按钮
Private Sub ComDataEdit_Click()

FrameDataShow.Visible = True
FrameDataFind.Visible = False

TextName.Enabled = True
TextTel.Enabled = True
TextAddress.Enabled = True
AddDataCancle.Visible = True
AddDataOK.Visible = True
HScroll1.Visible = False
FlagAddOrEdit = False
ComDataDel.Enabled = False

ConditionShow.Text = "修改记录！"
TextName.SetFocus
End Sub


'显示数据按钮
Private Sub ComDataShow_Click()

FrameDataShow.Visible = True
FrameDataFind.Visible = False


TextName.Enabled = False
TextTel.Enabled = False
TextAddress.Enabled = False
AddDataOK.Visible = False
AddDataCancle.Visible = False
HScroll1.Visible = True
ComDataDel.Enabled = True

DisplayData
End Sub


'查找记录按钮
Private Sub ComDataFind_Click()

FrameDataShow.Visible = False
FrameDataFind.Visible = True
ComDataDel.Enabled = False
FindResult.Text = ""


End Sub


'查找按钮
Private Sub FindDataCom_Click()

Dim rs As ADOCE.Recordset
Dim str As String
Dim result As String
Dim result_n As Integer
Dim length As Integer
Dim compstr As String
Dim i As Long
Dim myselect As Integer

If StrComp(Trim(FindContents.Text), "") <> 0 And FindWhat.ListIndex > -1 Then
    If connOpen = True Then
        Set rs = CreateObject("ADOCE.Recordset.3.0")
        On Error Resume Next
        rs.Open "select * from FriendTable", conn, adLockReadOnly
    
        str = Trim(FindContents.Text)
        result = ""
        myselect = FindWhat.ListIndex
        length = Len(str)
        result_n = 0
                
        Do While Not rs.EOF
                    
            For i = 1 To Len(Trim(rs(myselect).Value)) - length
                compstr = Mid(rs(myselect).Value, i, length)
                If StrComp(str, compstr) = 0 Then
                    result = result & rs(0).Value & "; " & rs(1).Value & "; " & rs(2).Value
                    result = result + vbCrLf
                    result_n = result_n + 1
                    Exit For
                End If
            Next i
            If Len(Trim(rs(myselect).Value)) - length = 0 Then
                If StrComp(str, rs(myselect).Value) = 0 Then
                    result = result & rs(0).Value & "; " & rs(1).Value & "; " & rs(2).Value
                    result = result + vbCrLf
                    result_n = result_n + 1
                End If
            End If
            rs.movenext
        Loop
                
    End If
End If

ConditionShow.Text = "找到 " & result_n & "个！"
If result = "" Then
    FindResult.Text = "没有找到！"
Else
    FindResult.Text = result
End If
End Sub



Private Sub Form_OKClick()
    App.End
End Sub


Private Sub SQLCommand(strSQLCommand As String)
  
  If DBExists(DBFilename) = True Then
  
    connOpen
    On Error Resume Next
    conn.Execute (strSQLCommand)
    On Error GoTo 0
    connClose
  End If

End Sub

Private Function DBExists(strFileName As String) As Boolean
  
  If FileSystem.Dir(strFileName) <> "" Then
    DBExists = True
  Else
    DBExists = False
  End If

End Function

Function connOpen() As Boolean
  
  On Error Resume Next
  
  connOpen = True
  
  If conn Is Nothing Then
    Set conn = CreateObject("ADOCE.Connection.3.0")
    conn.Open DBFilename
    If conn.Errors.Count > 0 Then
      MsgBox "errors in connOpen", vbOKOnly
      DispErrors
      connOpen = False
    End If
  End If
  On Error GoTo 0
    
End Function


Private Sub DisplayData()

Dim rs As ADOCE.Recordset
Dim intCounter As Integer

If connOpen = True Then
    Set rs = CreateObject("ADOCE.Recordset.3.0")
    On Error Resume Next
    rs.Open "select * from FriendTable", conn, adLockReadOnly
    intCounter = rs.recordcount
    rs.Move DBpoint - 1, adBookmarkFirst
    TextName = rs(0).Value
    TextTel = rs(1).Value
    TextAddress = rs(2).Value
   
  
    If intCounter = 0 Then
        HScroll1.Max = 0
        HScroll1.Min = 0
    Else
        If intCounter > 0 Then
            HScroll1.Max = intCounter
            HScroll1.Min = 1
            DBpoint = 1
        End If
    End If
    rs.Close
    Set rs = Nothing
    ConditionShow.Text = "在数据库中共有 " & intCounter & " 笔数据"
    On Error GoTo 0
  End If
  connClose

End Sub

Sub connClose()
  
  On Error Resume Next
  conn.Close
  Set conn = Nothing
  On Error GoTo 0

End Sub

Private Sub AddData(strName As String, strTel As String, strAdd As String)

Dim rs As ADOCE.Recordset
Dim arb1 As Integer

  If connOpen = True Then

    Set rs = CreateObject("ADOCE.Recordset.3.0")
    On Error Resume Next
    rs.Open "FriendTable", conn, adOpenKeyset, adLockPessimistic
    rs.AddNew
    rs.Fields("FriendName") = strName
    rs.Fields("FriendTel") = strTel
    rs.Fields("FriendAdd") = strAdd
    rs.update
      
    If conn.Errors.Count = 0 Then
      ConditionShow.Text = "加入数据成功"
    Else
      ConditionShow.Text = "加入数据失败"
    End If
    
    On Error GoTo 0
    rs.Close
    connClose
  
  End If

End Sub


Private Sub HScroll1_Change()
Dim rs As ADOCE.Recordset
'Dim i As Integer
If DBpoint = 0 Then
    endSub
End If
If connOpen = True Then
    Set rs = CreateObject("ADOCE.Recordset.3.0")
    On Error Resume Next
    rs.Open "select * from FriendTable", conn, adLockReadOnly
    rs.Move DBpoint - 1, adBookmarkFirst
    If HScroll1.Value > DBpoint Then
        rs.movenext
        DBpoint = HScroll1.Value
        TextName = rs(0).Value
        TextTel = rs(1).Value
        TextAddress = rs(2).Value

    End If
    If HScroll1.Value < DBpoint Then
        rs.moveprevious
        DBpoint = HScroll1.Value
        TextName = rs(0).Value
        TextTel = rs(1).Value
        TextAddress = rs(2).Value
    End If
    ConditionShow.Text = "第 " & DBpoint & " 笔" & vbCrLf & "数据库中共有 " & rs.recordcount & " 笔数据"
    rs.Close
    Set rs = Nothing
End If
connClose

End Sub

Function datacheck(strName As String, strTel As String, strAdd As String) As Boolean

'判断数据的完整性
If strName = "" Or strTel = "" Or strAdd = "" Then
    ConditionShow.Text = "数据不完整！"
    datacheck = False
    Exit Function
End If

'判断数据的有效性
Dim i As Integer
Dim ch As Integer
Dim length As Integer
i = 1
length = Len(strTel)
If length < 6 Then
    ConditionShow.Text = "电话号码无效！"
    datacheck = False
    Exit Function
End If
While i <= length
    ch = Mid(strTel, i, 1)
    i = i + 1
    If ch < "0" Or ch > "9" Then
        ConditionShow.Text = "电话号码无效！"
        datacheck = False
        Exit Function
    End If
    
Wend


'判断数据的唯一性
Dim rs As ADOCE.Recordset
If connOpen = True Then
    Set rs = CreateObject("ADOCE.Recordset.3.0")
    On Error Resume Next
    rs.Open "select * from FriendTable", conn, adLockReadOnly
    Do While Not rs.EOF
        If StrComp(strName, rs(0).Value) = 0 And StrComp(strTel, rs(1).Value) = 0 And StrComp(strAdd, rs(2).Value) = 0 Then
            ConditionShow.Text = "数据库中有此数据项！"
            datacheck = False
            Exit Function
        End If
        rs.movenext
    Loop
End If

datacheck = True
End Function