frmmain.frm

使用vb编写的人员基本系信息管理

     If rs.RecordCount = 0 Then
       clsall
       txtindex = "0/0"
       cmdback.Enabled = False
       cmdend.Enabled = False
       cmdnext.Enabled = False
       cmdfir.Enabled = False
       cmdedit.Enabled = False
       cmddel.Enabled = False
       cmdsearch.Enabled = False
       MsgBox "目前没有任何记录！", vbOKOnly + vbExclamation, "提示"
     End If
   End If
   If rs.RecordCount = 1 And rs.AbsolutePosition = 1 Then
       fill
       cmdback.Enabled = False
       cmdend.Enabled = False
       cmdnext.Enabled = False
       cmdfir.Enabled = False
   End If
End If
aa.SetFocus
End Sub

Private Sub cmdedit_Click()
txtname.SetFocus
If cmdedit.Caption = "编辑" Then
  cmdedit.Caption = "保存"
  lockf
  cmdback.Enabled = False
  cmdend.Enabled = False
  cmdnext.Enabled = False
  cmdfir.Enabled = False
  cmdout.Enabled = False
  cmdadd.Enabled = False
  cmdunlogin.Enabled = False
  cmdsearch.Enabled = False
  cmddel.Enabled = False
Else
  If MsgBox("确定修改该记录？", vbOKCancel + vbDefaultButton2 + vbQuestion, "修改记录") = vbOK Then
    change
    rs.Update
  End If
  rs.CancelUpdate
  fill
  cmdedit.Caption = "编辑"
  If rs.AbsolutePosition = 1 And rs.RecordCount > 1 Then
    cmdend.Enabled = True
    cmdnext.Enabled = True
  End If
  If rs.AbsolutePosition > 1 And rs.RecordCount <> rs.AbsolutePosition Then
    cmdend.Enabled = True
    cmdnext.Enabled = True
    cmdback.Enabled = True
    cmdfir.Enabled = True
  End If
  If rs.AbsolutePosition = rs.RecordCount And rs.RecordCount <> 1 Then
    cmdback.Enabled = True
    cmdfir.Enabled = True
  End If
  cmdout.Enabled = True
  cmdunlogin.Enabled = True
  cmdadd.Enabled = True
  cmdsearch.Enabled = True
  cmddel.Enabled = True
  lockt
End If
End Sub

Private Sub cmdend_Click()
rs.MoveLast
fill
txtindex.Text = rs.AbsolutePosition & "/" & rs.RecordCount
cmdback.Enabled = True
cmdend.Enabled = False
cmdnext.Enabled = False
cmdfir.Enabled = True
aa.SetFocus
End Sub

Private Sub cmdfir_Click()
rs.MoveFirst
fill
txtindex.Text = rs.AbsolutePosition & "/" & rs.RecordCount
cmdback.Enabled = False
cmdend.Enabled = True
cmdnext.Enabled = True
cmdfir.Enabled = False
aa.SetFocus
End Sub


Private Sub cmdlist_Click()
aa.SetFocus
If cmdlist.Caption = 3 Then
  Me.Width = 6510
  Me.Move (Screen.Width - Me.Width) / 2
  cmdlist.Caption = 4
  cmdlist.Left = 408
  cmdlist.ToolTipText = "列表浏览"
  Label18.Left = Label18.Left - 70
  Label20.Left = Label20.Left - 70
  Label19.Left = Label19.Left - 70
Else
  Me.Width = 8610
  Me.Move (Screen.Width - Me.Width) / 2
  cmdlist.Caption = 3
  cmdlist.Left = 548
  cmdlist.ToolTipText = "逐条浏览"
  Label18.Left = Label18.Left + 70
  Label20.Left = Label20.Left + 70
  Label19.Left = Label19.Left + 70
  txtlist.Text = ""
  If rs.EOF And rs.BOF Then
    Exit Sub
  End If
  bmk = rs.AbsolutePosition
  rs.MoveFirst
  For i = rs.AbsolutePosition To rs.RecordCount
    If i < 10 Then
      st = "0" & i
    Else
      st = CStr(i)
    End If
    list
    rs.MoveNext
  Next i
  rs.MoveFirst
  rs.Move bmk - 1
End If
End Sub

Private Sub cmdnext_Click()
If rs.AbsolutePosition <> rs.RecordCount - 1 Then
  rs.MoveNext
  fill
  cmdback.Enabled = True
  cmdend.Enabled = True
  cmdnext.Enabled = True
  cmdfir.Enabled = True
Else
  rs.MoveNext
  fill
  cmdback.Enabled = True
  cmdend.Enabled = False
  cmdnext.Enabled = False
  cmdfir.Enabled = True
End If
txtindex.Text = rs.AbsolutePosition & "/" & rs.RecordCount
aa.SetFocus
End Sub

Private Sub cmdout_Click()
End
End Sub

Private Sub cmdsearch_Click()
aa.SetFocus
mybln = True
frmsearch.Show
End Sub



Private Sub cmdgo_Click()
aa.SetFocus
If txtgo = "" Then
  MsgBox "请填写要查看的纪录数！", vbOKOnly + vbExclamation, "提示"
  Exit Sub
End If
If txtgo > rs.RecordCount Then
  MsgBox "您填写的数字过大！", vbOKOnly + vbExclamation, "提示"
  txtgo = ""
  Exit Sub
End If
rs.MoveFirst
rs.Move txtgo - 1
fill
txtlist = ""
If rs.AbsolutePosition < 10 Then
  st = "0" & rs.AbsolutePosition
Else
  st = CStr(rs.AbsolutePosition)
End If
list
txtindex.Text = rs.AbsolutePosition & "/" & rs.RecordCount
cmdback.Enabled = True
cmdend.Enabled = True
cmdnext.Enabled = True
cmdfir.Enabled = True
If rs.AbsolutePosition = 1 Then
  cmdback.Enabled = False
  cmdfir.Enabled = False
End If
If rs.AbsolutePosition = rs.RecordCount Then
  cmdend.Enabled = False
  cmdnext.Enabled = False
End If
txtgo = ""
End Sub

Private Sub cmdunlogin_Click()
aa.SetFocus
struser = ""
mybln = True
Me.Hide
frmlogin.Show
End Sub

Private Sub Form_Activate()
If mybln Then
  Form_Load
  mybln = False
End If
End Sub

Private Sub Form_Load()
lockt
clsall
cnstr = "provider=microsoft.jet.oledb.4.0;" _
        & "data source=" & App.Path & "\data\data.mdb"
Set mycn = New ADODB.Connection
mycn.Open cnstr
Set rs = New ADODB.Recordset
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.CursorLocation = adUseClient
rs.Open "select * from firend where owner='" & struser & "'", mycn, , , adCmdText
If Not rs.BOF And Not rs.EOF Then
  rs.MoveFirst
  fill
  txtindex.Text = rs.AbsolutePosition & "/" & rs.RecordCount
  cmdfir.Enabled = False
  cmdback.Enabled = False
  If rs.RecordCount = 1 Then
    cmdend.Enabled = False
    cmdnext.Enabled = False
  Else
    cmdend.Enabled = True
    cmdnext.Enabled = True
  End If
Else
  txtindex.Text = "0/0"
  cmdback.Enabled = False
  cmdend.Enabled = False
  cmdnext.Enabled = False
  cmdfir.Enabled = False
  cmdedit.Enabled = False
  cmddel.Enabled = False
  cmdsearch.Enabled = False
End If
End Sub



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label20.ForeColor = &HFFFFFF
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
mycn.Close
rs.Close
Set mycn = Nothing
Set rs = Nothing
End Sub

Private Sub Label18_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label20.ForeColor = &HFFFFFF
End Sub



Private Sub Label20_Click()
myweb.Navigate "http://yunshui.onchina.net", 1
End Sub
Private Sub fill()
txtname = Trim(rs!vname)
txtsex = Trim(rs!sex)
txtbir = Trim(rs!bir)
txtjg = Trim(rs!jg)
txtjob = Trim(rs!job)
txtwhere = Trim(rs!Where)
txtadd = Trim(rs!Add)
txtphone = Trim(rs!phone)
txtmphone = Trim(rs!mphone)
txtbp = Trim(rs!bp)
txtid = Trim(rs!Id)
txtem = Trim(rs!email)
txtqq = Trim(rs!qq)
txtmsn = Trim(rs!msn)
txtweb = Trim(rs!web)
txtmemo = Trim(rs!Memo)
End Sub


Private Sub Label20_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label20.ForeColor = &HFF
End Sub

Private Sub txtindex_GotFocus()
aa.SetFocus
End Sub
Private Sub change()
rs!vname = txtname.Text
rs!sex = txtsex.Text
rs!bir = txtbir.Text
rs!jg = txtjg.Text
rs!job = txtjob.Text
rs!Where = txtwhere.Text
rs!Add = txtadd.Text
rs!phone = txtphone.Text
rs!mphone = txtmphone.Text
rs!bp = txtbp.Text
rs!Id = txtid.Text
rs!email = txtem.Text
rs!qq = txtqq.Text
rs!msn = txtmsn.Text
rs!web = txtweb.Text
rs!Memo = txtmemo.Text
rs!Owner = struser
End Sub
Private Sub lockt()
txtname.Locked = True
txtsex.Locked = True
txtbir.Locked = True
txtjg.Locked = True
txtjob.Locked = True
txtwhere.Locked = True
txtadd.Locked = True
txtphone.Locked = True
txtmphone.Locked = True
txtbp.Locked = True
txtid.Locked = True
txtem.Locked = True
txtqq.Locked = True
txtmsn.Locked = True
txtweb.Locked = True
txtmemo.Locked = True
End Sub
Private Sub lockf()
txtname.Locked = False
txtsex.Locked = False
txtbir.Locked = False
txtjg.Locked = False
txtjob.Locked = False
txtwhere.Locked = False
txtadd.Locked = False
txtphone.Locked = False
txtmphone.Locked = False
txtbp.Locked = False
txtid.Locked = False
txtem.Locked = False
txtqq.Locked = False
txtmsn.Locked = False
txtweb.Locked = False
txtmemo.Locked = False
End Sub
Private Sub clsall()
txtname = ""
txtsex = ""
txtbir = " "
txtjg = " "
txtjob = " "
txtwhere = " "
txtadd = " "
txtphone = " "
txtmphone = " "
txtbp = " "
txtid = " "
txtem = " "
txtqq = " "
txtmsn = " "
txtweb = " "
txtmemo = " "
End Sub
Private Sub list()
txtlist.Text = txtlist.Text & "********" & st & "********" & vbCrLf _
              & "姓    名：" & Trim(rs!vname) & vbCrLf & "性    别：" & Trim(rs!sex) & vbCrLf _
              & "生    日：" & Trim(rs!bir) & vbCrLf & "籍    贯：" & Trim(rs!jg) & vbCrLf _
              & "工    作：" & Trim(rs!job) & vbCrLf & "工作地点：" & Trim(rs!Where) & vbCrLf _
              & "联系地址：" & Trim(rs!Add) & vbCrLf & "联系电话：" & Trim(rs!phone) & vbCrLf _
              & "手机号码：" & Trim(rs!mphone) & vbCrLf & "传呼号码：" & Trim(rs!bp) & vbCrLf _
              & "网    名：" & Trim(rs!Id) & vbCrLf & "E - MAIL：" & Trim(rs!email) & vbCrLf _
              & "OICQ号码：" & Trim(rs!qq) & vbCrLf & "MSN  I D：" & Trim(rs!msn) & vbCrLf _
              & "主    页：" & Trim(rs!web) & vbCrLf & "备    注：" & Trim(rs!Memo) & vbCrLf _
              & "*******Over*******" & vbCrLf
End Sub