xsda.frm

对学习VB很有帮助 fskdljfl kasdjfkl asdjfk lajsd f

      Index           =   1
      Left            =   840
      TabIndex        =   14
      Top             =   1680
      Width           =   720
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "性别："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   4560
      TabIndex        =   2
      Top             =   1080
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "学号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Index           =   0
      Left            =   840
      TabIndex        =   1
      Top             =   1080
      Width           =   720
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "学生档案登记"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   3120
      TabIndex        =   0
      Top             =   120
      Width           =   2715
   End
End
Attribute VB_Name = "xsda"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset
Dim rc As New ADODB.Recordset
Dim rs As Recordset
Dim bm
 Const xStr As String = "0123456789"
Dim bj
Dim tj As Boolean

Private Sub dispvalue()

Text1(0).Text = rs1.Fields("学号")
Co1.Text = rs1.Fields("性别")
Text1(1).Text = rs1.Fields("姓名")
Text1(2).Text = rs1.Fields("出生年月")
Text1(3).Text = rs1.Fields("入学时间")
Text1(4).Text = rs1.Fields("联系电话")

Cobj.Text = rs1.Fields("班级")
Text1(5).Text = rs1.Fields("专业")
Text1(6).Text = rs1.Fields("家庭住址")
Co2.Text = rs1.Fields("政治面貌")
Text1(7).Text = Trim(rs1.Fields("备注"))
End Sub
Private Sub setvalue()
rs1.Fields("学号") = Text1(0).Text
rs1.Fields("性别") = Co1.Text
rs1.Fields("姓名") = Text1(1).Text
rs1.Fields("出生年月") = Text1(2).Text
 rs1.Fields("入学时间") = Text1(3).Text
rs1.Fields("家庭住址") = Text1(6).Text
rs1.Fields("专业") = Text1(5).Text
 rs1.Fields("班级") = Cobj.Text
rs1.Fields("联系电话") = Text1(4).Text
rs1.Fields("政治面貌") = Co2.Text
rs1.Fields("备注") = Text1(7).Text
End Sub
Private Sub textenable()  '使所有的文本框可用
For i = 0 To 7
Text1(i).Enabled = True
Next
Co1.Enabled = True
Co2.Enabled = True
Cobj.Enabled = True
End Sub
Private Sub textdisable()    '使所有的文本框不可用
For i = 0 To 7
Text1(i).Enabled = False
Next
Co1.Enabled = False
Co2.Enabled = False
Cobj.Enabled = False
End Sub
Private Sub editstatus() '设置在编辑或添加记录时各控件的状态
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = True
Command9.Enabled = True
Call textenable
End Sub
Private Sub emptytext()  '清空文本框
Text1(0).Text = ""
Co1.Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Text1(3).Text = ""
Text1(4).Text = ""
Text1(5).Text = ""
Text1(6).Text = ""
Text1(7).Text = ""
Co2.Text = ""
Cobj.Text = ""
End Sub
Private Sub okstatus()   '设置不在编辑或添加记录时各控件的状态
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = False
Command9.Enabled = False
Call textdisable
End Sub




Private Sub Command1_Click()
Command11.Visible = False
rs1.MoveFirst
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
Call dispvalue
End Sub

Private Sub Command10_Click()
Unload Me
End Sub

Private Sub Command11_Click()
Dim xh As New ADODB.Recordset
xh.Open "select * from 学生档案 where 学号='" & Trim(Text1(0).Text) & "'", conn, 3, 3

If Not xh.EOF Then
    MsgBox "你输入的学号是" + Text1(0).Text + "已存在请重新输入！"
    Command8.Enabled = False
    'Text1(0).Text = ""
    Text1(0).BackColor = &HFF&
ElseIf Text1(0).Text = "" Then
    MsgBox "学号不能为空！"
    Command8.Enabled = False
Else
    MsgBox "你可以输入这个学号" + Text1(0).Text + "欢迎使用！"
    Text1(0).SetFocus
End If

End Sub

Private Sub Command12_Click()

'If KeyAscii = 13 Then
   If conn.State = adStateOpen Then    '如果数据库是打开的,先关闭数据库
  conn.Close
   Set conn = Nothing
   End If
Call opendatabase
Dim strSQL1 As String
Dim xh As String

'Dim k
xh = Trim(Text2.Text)
strSQL1 = "select * from 学生档案 where 学号='" & xh & "'"
    rc.Open strSQL1, conn, 3, 3
    
    If rc.RecordCount = 0 Then
        MsgBox "对不起，没有此人信息", vbDefaultButton1, "查询错误"
    Else
        MsgBox "找到了", vbYesNo, "查找成功"
  'rc.CursorLocation = adUseClient
   
  ' rc.AbsolutePosition = adPosEOF
        'rc.MoveFirst
    End If
    'Call dispvalu
    'Set rc = Nothing
   ' Set conn = Nothing
'Text2.SetFocus
End Sub


Private Sub Command2_Click()
Command11.Visible = False
rs1.MovePrevious
If rs1.BOF Then
    rs1.MoveFirst
    Command1.Enabled = False
    Command2.Enabled = False
End If
Command3.Enabled = True
Command4.Enabled = True
Call dispvalue
End Sub

Private Sub Command3_Click()
Command11.Visible = False

rs1.MoveNext
If rs1.EOF Then
rs1.MoveLast
Command3.Enabled = False
Command4.Enabled = False
End If
Command1.Enabled = True
Command2.Enabled = True
Call dispvalue
End Sub

Private Sub Command4_Click()
Command11.Visible = False
rs1.MoveLast
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = False
Command4.Enabled = False
Call dispvalue

End Sub

Private Sub Command5_Click()
Command11.Visible = False
If (MsgBox("真的要删除记录吗?", vbQuestion + vbYesNo, "删除提示") = vbYes) Then
    rs1.Delete
    rs1.MoveNext
    If rs1.EOF Then
        rs1.MoveLast
    End If
End If
Call dispvalue

End Sub

Private Sub Command6_Click()
Cobj.Clear
Command11.Visible = True
Dim r2 As New ADODB.Recordset
r2.Open "select * from 班级信息", conn, 1, 1
If Not r2.EOF Then
 Do While Not r2.EOF
        Cobj.AddItem (r2.Fields("班级"))
       r2.MoveNext
  Loop
End If
bm = rs1.Bookmark '用书签记录位置
rs1.AddNew        '调用addnew方法增加新记录
Call editstatus  '.设置文本框状态
Call emptytext
tj = True       '是添加新记录
End Sub

Private Sub Command7_Click()
Command12.Visible = False
Text2.Visible = False
Command11.Visible = True
bj = Cobj.Text
Cobj.Clear
Cobj.Text = bj
Dim r2 As New ADODB.Recordset
r2.Open "select * from 班级信息", conn, 1, 1
If Not r2.EOF Then
 Do While Not r2.EOF
        Cobj.AddItem (r2.Fields("班级"))
       r2.MoveNext
  Loop
End If
Call editstatus
tj = False      '是修改记录
End Sub

Private Sub Command8_Click()
Command11.Visible = False
For i = 0 To 6
    If Text1(i).Text = "" Then
        MsgBox Label2(i).Caption & "不能为空，请输入！", vbDefaultButton1
        Text1(i).SetFocus
         Exit Sub
        End If
        
 Next
 If Co1.Text = "" Then
    MsgBox "性别不能为空，请选择！"
    Exit Sub
  End If
If Co2.Text = "" Then
    MsgBox "政治面貌不能为空，请选择！"
    Exit Sub
End If
If Not IsDate(Text1(2)) Then
    MsgBox "请输入正确日期格式yy-mm-nn"
    Text1(2).SetFocus
    Exit Sub
End If
If Not IsDate(Text1(3)) Then
    MsgBox "请输入正确日期格式yy-mm-nn"
    Text1(3).SetFocus
    Exit Sub
End If
If tj = True Then
Dim lr As New ADODB.Recordset
lr.Open "select * from 学生档案 where 学号='" & Trim(Text1(0).Text) & "'", conn, 1, 1
If Not lr.EOF Then
    MsgBox "该学号已存在,请重新输入!"
    Text1(0).SetFocus
    Exit Sub
End If
End If
Call setvalue
rs1.Update
rs1.MoveFirst
Call okstatus
MsgBox ("保存成功")
End Sub

Private Sub Command9_Click()
'Set conn = Nothing
Command11.Visible = False
If (MsgBox("真的要取消修改吗？", vbQuestion + vbYesNo)) = vbYes Then

rs1.CancelUpdate
If tj Then
 rs1.Bookmark = bm
End If
Call dispvalue
Call okstatus
End If
End Sub


Private Sub Form_Load()

main.StatusBar1.Panels(10) = "学生基本信息录入"
'Call menudisable
If md = 1 Then
Command5.Visible = False
Command6.Visible = False
Text2.Visible = False
Command11.Visible = False
Command12.Visible = False
Label4.Enabled = True
xsda.Caption = "学生基本信息修改"
Label1.Caption = "学生基本信息修改"
main.StatusBar1.Panels(10) = "学生基本信息修改"
Else
Command5.Visible = True
Command6.Visible = True
Text2.Visible = False
Command11.Visible = False
Label4.Enabled = False
Command12.Visible = False
xsda.Caption = "学生基本信息录入"
Label1.Caption = "学生基本信息录入"
End If
Call opendatabase
rs1.Open "学生档案", conn, 3, 3
Call dispvalue
Command9.Enabled = False
Command8.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
conn.Close
Set conn = Nothing
'Call menuenable
'Call cz
End Sub

Private Sub Label4_Click()
Text2.Visible = True
Command12.Visible = True
Text2.SetFocus
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    Command8.Enabled = True
    Text1(0).BackColor = &H80000005

'If Index = 1 Then
     'KeyAscii = IIf(InStr(xStr, Chr(KeyAscii)) = 0, KeyAscii, 0)

'End If
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Then
         If KeyAscii = 8 Then
            KeyAscii = 8
        Exit Sub
         End If
        If KeyAscii < 47 Or KeyAscii > 58 Then
            KeyAscii = 0
        End If

'MsgBox "电话号码为数字"
'Text1(4).Text = ""
'Text1(4).SetFocus
'Exit Sub
End If
If Index = 1 Then
    KeyAscii = IIf(InStr(xStr, Chr(KeyAscii)) = 0, KeyAscii, 0)
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
  'Const xStr As String = "0123456789"
If KeyAscii = 8 Then
KeyAscii = 8
Exit Sub
End If

  KeyAscii = IIf(InStr(xStr, Chr(KeyAscii)) = 0, 0, KeyAscii)
 'KeyAscii = IIf(InStr(xStr, Chr(KeyAscii)) = 0, KeyAscii, 0)
  Text2.SetFocus



End Sub