全部

VB 数据库问题！特急！巨分！

codecb 2002-06-01 01:28:33

同学记录问题
谁有原代码！
要有登录密码的！
谢！

...全文

50 点赞收藏 3

写回复

3 条回复

切换为时间正序

当前发帖距今超过3年，不再开放新的回复

发表回复

Bblover 2002-06-01

Private Sub cmdDelete_Click()

On Error GoTo ResumeNext

PlaySound App.Path & "\sounds\groupopen.wav"

If txtText1.Text = "" Then 'If the first text box is empty then
MsgBox "You must choose a record to delete.", , "Database Error"

Exit Sub

Else
If rsInfo.EOF = False And _
rsInfo.BOF = False Then
'Check to see if there is data in the database
'and make sure it is open.

On Error Resume Next
'If there is an error, ignore it.

connConnection.begtrans
'Deleting a record is important so the begtrans method
'is used. It makes sure all actions between begtrans
'and committrans are done at the same time.
rsInfo.Delete
'Delete the record.

connConnection.CommitTrans
'The actions have been committed.

rsInfo.MoveNext
If rsInfo.EOF = True Then
rsInfo.MoveLast
'If the user deletes the record in the last position
'go to the new record in the last position.

If rsInfo.BOF = True Then
Call ClearControls
'If the last record is deleted, clear the text
'boxes.

MsgBox "There is no data in the recordset!", , "Database Error!"
'Alert the user that there is no more data in
'the database.
End If
End If
ElseIf rsInfo.EOF = True And rsInfo.BOF = True Then
'Warn the user that he or she is trying to delete data
'from a database with no records.

MsgBox "There is no data in the recordset!", , "Database Error!"
End If

ListView1.ListItems.Clear
While Not rsInfo.EOF()
Set itmx = ListView1.ListItems.Add

itmx.Text = rsInfo("Name")
itmx.SubItems(1) = rsInfo("Address")
itmx.SubItems(2) = rsInfo("Email")
itmx.SubItems(3) = rsInfo("Phone")
itmx.SubItems(4) = rsInfo("Cell")
itmx.SubItems(5) = rsInfo("Beeper")
itmx.SubItems(6) = rsInfo("ICQ Number")
itmx.SubItems(7) = rsInfo("AIM Handle")
itmx.SubItems(8) = rsInfo("IRC Handle")
itmx.SubItems(9) = rsInfo("Gaming Handle")
itmx.SubItems(10) = rsInfo("Homepage URL")
itmx.SubItems(11) = rsInfo("Sex")

rsInfo.MoveNext
Wend

txtText1.SetFocus
ListView1.Refresh

End If

ResumeNext:

End Sub

Private Sub cmdDelete_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

cmdDelete.BackColor = &HFFFF00 'change the color of the background when mouse hovers over
cmdDelete.ForeColor = &H0& 'change the color of the text when mouse hovers over

cmdFirst.BackColor = &H0&
cmdFirst.ForeColor = &HFFFF00

cmdPrevious.BackColor = &H0&
cmdPrevious.ForeColor = &HFFFF00

cmdNext.BackColor = &H0&
cmdNext.ForeColor = &HFFFF00

cmdLast.BackColor = &H0&
cmdLast.ForeColor = &HFFFF00

cmdAdd.BackColor = &H0&
cmdAdd.ForeColor = &HFFFF00

cmdSave.BackColor = &H0&
cmdSave.ForeColor = &HFFFF00

cmdEdit.BackColor = &H0&
cmdEdit.ForeColor = &HFFFF00

cmdActivate.BackColor = &H0&
cmdActivate.ForeColor = &HFFFF00

cmdExtra.BackColor = &H0&
cmdExtra.ForeColor = &HFFFF00

cmdDefault.BackColor = &H0&

回复赞

Bblover 2002-06-01

Private Sub cmdAdd_Click()

On Error GoTo ResumeNext

PlaySound App.Path & "\sounds\groupopen.wav"

cmdEdit.Enabled = False 'disable the user from editing any records until after there is a record entered in the database
cmdSave.Enabled = True 'enable the record to be saved

Call DisableNavigation 'call the diable button feature placed earlier

mblnAddMode = True 'We are now in addmode.

Call ClearControls 'call up to the clear controls sub we created earlier

cmdDelete.Enabled = False 'do not allow the record to be deleted till the user finishes saving

txtText1.Locked = False 'unlock the text boxes so info can be input
txtText2.Locked = False
txtText3.Locked = False
txtText4.Locked = False
txtText5.Locked = False
txtText6.Locked = False
txtText7.Locked = False
txtText8.Locked = False
txtText9.Locked = False
txtText10.Locked = False
txtText11(1).Locked = False
txtText12(0).Locked = False
txtText13.Locked = False

txtText1.SetFocus
ListView1.Refresh

ResumeNext:

End Sub

Private Sub cmdAdd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

cmdAdd.BackColor = &HFFFF00 'change the color of the background when mouse hovers over
cmdAdd.ForeColor = &H0& 'change the color of the text when mouse hovers over

cmdFirst.BackColor = &H0&
cmdFirst.ForeColor = &HFFFF00

cmdPrevious.BackColor = &H0&
cmdPrevious.ForeColor = &HFFFF00

cmdNext.BackColor = &H0&
cmdNext.ForeColor = &HFFFF00

cmdLast.BackColor = &H0&
cmdLast.ForeColor = &HFFFF00

cmdSave.BackColor = &H0&
cmdSave.ForeColor = &HFFFF00

cmdDelete.BackColor = &H0&
cmdDelete.ForeColor = &HFFFF00

cmdEdit.BackColor = &H0&
cmdEdit.ForeColor = &HFFFF00

cmdActivate.BackColor = &H0&
cmdActivate.ForeColor = &HFFFF00

cmdExtra.BackColor = &H0&
cmdExtra.ForeColor = &HFFFF00

cmdDefault.BackColor = &H0&
cmdDefault.ForeColor = &HFFFF00

End Sub

Private Sub cmdDefault_Click()

PlaySound App.Path & "\sounds\groupopen.wav"

fraFrame12.Visible = False
fraFrame11.Visible = True

lblLabel1(0).Caption = "Name:"
lblLabel2.Caption = "Address:"
lblLabel3.Caption = "E-Mail Address:"
lblLabel4.Caption = "Phone Number:"
lblLabel5.Caption = "Cell Number:"
lblLabel6.Caption = "Beeper Number:"

txtText1.Visible = True
txtText2.Visible = True
txtText3.Visible = True
txtText4.Visible = True
txtText5.Visible = True
txtText6.Visible = True
txtText8.Visible = False
txtText9.Visible = False
txtText10.Visible = False
txtText11(1).Visible = False
txtText12(0).Visible = False
txtText13.Visible = False

End Sub

Private Sub cmdDefault_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

cmdDefault.BackColor = &HFFFF00 'change the color of the background when mouse hovers over
cmdDefault.ForeColor = &H0& 'change the color of the text when mouse hovers over

cmdFirst.BackColor = &H0&
cmdFirst.ForeColor = &HFFFF00

cmdPrevious.BackColor = &H0&
cmdPrevious.ForeColor = &HFFFF00

cmdNext.BackColor = &H0&
cmdNext.ForeColor = &HFFFF00

cmdLast.BackColor = &H0&
cmdLast.ForeColor = &HFFFF00

cmdAdd.BackColor = &H0&
cmdAdd.ForeColor = &HFFFF00

cmdSave.BackColor = &H0&
cmdSave.ForeColor = &HFFFF00

cmdDelete.BackColor = &H0&
cmdDelete.ForeColor = &HFFFF00

cmdEdit.BackColor = &H0&
cmdEdit.ForeColor = &HFFFF00

cmdActivate.BackColor = &H0&
cmdActivate.ForeColor = &HFFFF00

cmdExtra.BackColor = &H0&
cmdExtra.ForeColor = &HFFFF00

End Sub

回复赞

Bblover 2002-06-01

ption Explicit
Private WithEvents connConnection As ADODB.Connection
Private WithEvents rsInfo As ADODB.Recordset
Dim mblnAddMode As Boolean
Dim itmx As ListItem

Private Sub cmdActivate_Click()

On Error GoTo ResumeNext

PlaySound App.Path & "\sounds\groupopen.wav"

If txtText1.Text = "" Then 'if the first text field is empty then
MsgBox "You must choose a record from the database before enabling the edit option.", , "Database Error"
Exit Sub

Else

cmdEdit.Enabled = True
cmdAdd.Enabled = False 'make sure the user cannot enter during editing mode

txtText1.SetFocus 'set the focus to the first text field

End If

ResumeNext:

End Sub

Private Sub cmdActivate_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

cmdActivate.BackColor = &HFFFF00 'change the color of the background when mouse hovers over
cmdActivate.ForeColor = &H0& 'change the color of the text when mouse hovers over

cmdFirst.BackColor = &H0&
cmdFirst.ForeColor = &HFFFF00

cmdPrevious.BackColor = &H0&
cmdPrevious.ForeColor = &HFFFF00

cmdNext.BackColor = &H0&
cmdNext.ForeColor = &HFFFF00

cmdLast.BackColor = &H0&
cmdLast.ForeColor = &HFFFF00

cmdAdd.BackColor = &H0&
cmdAdd.ForeColor = &HFFFF00

cmdSave.BackColor = &H0&
cmdSave.ForeColor = &HFFFF00

cmdDelete.BackColor = &H0&
cmdDelete.ForeColor = &HFFFF00

cmdEdit.BackColor = &H0&
cmdEdit.ForeColor = &HFFFF00

cmdExtra.BackColor = &H0&
cmdExtra.ForeColor = &HFFFF00

cmdDefault.BackColor = &H0&
cmdDefault.ForeColor = &HFFFF00

End Sub

回复赞