frmshigu.frm

事务管理

         AutoSize        =   -1  'True
         Caption         =   "事故发生地点"
         Height          =   195
         Left            =   6720
         TabIndex        =   8
         Top             =   360
         Width           =   1080
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "事故发生时间"
         Height          =   195
         Left            =   3960
         TabIndex        =   7
         Top             =   360
         Width           =   1080
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "事故发生日期"
         Height          =   195
         Left            =   720
         TabIndex        =   6
         Top             =   360
         Width           =   1080
      End
   End
End
Attribute VB_Name = "frmshigu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_shigu As New ADODB.Recordset
Dim tian_bm

Private Sub cmdnext_Click()
On Error GoTo nexterror
rs_shigu.MoveNext
If rs_shigu.EOF Then
   MsgBox "这已经是最后一条记录！", vbOKOnly + vbExclamation, ""
   rs_shigu.MovePrevious
   Exit Sub
Else
   viewdata
End If
nexterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdcancel_Click()
Dim i As Integer
'rs_shigu.Bookmark = tian_bm
viewdata
If cmdadd.Caption = "确定" Then
   cmdadd.Caption = "增加记录"
   cmdmodify.Enabled = True
   cmddel.Enabled = True
   cmdcancel.Enabled = False
ElseIf cmdmodify.Caption = "确定" Then
   cmdmodify.Caption = "修改记录"
   cmdadd.Enabled = True
   cmddel.Enabled = True
   cmdcancel.Enabled = False
End If
Combo1.Enabled = False
Frame2.Enabled = True
End Sub

Private Sub cmdprevious_Click()
On Error GoTo previouserror
rs_shigu.MovePrevious
If rs_shigu.BOF Then
   MsgBox "这已经是第一条记录！", vbOKOnly + vbExclamation, ""
   rs_shigu.MoveNext
   Exit Sub
Else
   viewdata
End If
previouserror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdfirst_Click()
On Error GoTo firsterror
rs_shigu.MoveFirst
If rs_shigu.EOF Then
   Exit Sub
Else
   viewdata
End If
firsterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdlast_Click()
On Error GoTo firsterror
rs_shigu.MoveLast
If rs_shigu.EOF Then
   Exit Sub
Else
   viewdata
End If
firsterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdadd_Click()
Dim i As Integer
Dim rs_add As New ADODB.Recordset
Dim sql As String
On Error GoTo adderror
Frame2.Enabled = False
If cmdadd.Caption = "增加记录" Then                        '当此按钮的状态为为“增加记录”时
   cmdadd.Caption = "确定"                                 '按钮名称改为“确定”
   cmdmodify.Enabled = False                                  '删除与修改按钮不可用
   cmddel.Enabled = False
   cmdcancel.Enabled = True
   Combo1.Enabled = True
   For i = 0 To 13
       Text1(i).Enabled = True                               '各文本框可用
       Text1(i).Text = ""                                    '文本框内容设为空
   Next i
Else                                                         '当按钮的状态为“确定”时
   If Trim(Text1(3).Text) = "" Then
      MsgBox "伤者姓名不能为空", vbOKOnly + vbExclamation, ""
      Text1(3).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(0).Text) Then
      MsgBox "请按照yyyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
      Text1(5).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(1).Text) Then
      MsgBox "请按照hh:mm格式输入时间", vbOKOnly + vbExclamation, ""
      Text1(1).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(8).Text) Then
      MsgBox "请按照yyyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
      Text1(8).SetFocus
      Exit Sub
   End If
   If Not IsNumeric(Text1(11).Text) Then
      MsgBox "医疗费请输入数字！", vbOKOnly + vbExclamation, ""
      Text1(11).SetFocus
      Exit Sub
   End If
      Text1(0) = Format(Text1(0), "yyyy-mm-dd")                 '转化为正确的格式
      Text1(1) = Format(Text1(1), "hh-mm-ss")
      Text1(8) = Format(Text1(8), "yyyy-mm-dd")
     ' Text1(11) = Format(Text1(11), "￥.")
      cmdadd.Caption = "增加记录"                             '按钮名称改为“增加记录”
      cmdmodify.Enabled = True                                   '删除与修改按钮可用
      cmddel.Enabled = True
      cmdcancel.Enabled = False
      rs_shigu.AddNew
      For i = 0 To 13
          rs_shigu.Fields(i) = Trim(Text1(i).Text)
      Next i
          rs_shigu.Fields(4) = Trim(Combo1.Text)               '将性别加入数据库
      rs_shigu.Update
      MsgBox "增加成功", vbOKOnly + vbExclamation, ""
      For i = 0 To 13
       Text1(i).Enabled = False
      Next i
       Combo1.Enabled = False
      Frame2.Enabled = True
End If
adderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdmodify_Click()
Dim sql As String
Dim rs_modify As New ADODB.Recordset
Dim i As Integer
On Error GoTo modifyerror
'tian_bm = rs_shigu.Bookmark
Frame2.Enabled = False
If cmdmodify.Caption = "修改记录" Then                        '当此按钮的状态为为“增加记录”时
   cmdmodify.Caption = "确定"                                 '按钮名称改为“确定”
   cmdadd.Enabled = False                                  '删除与修改按钮不可用
   cmddel.Enabled = False
   cmdcancel.Enabled = True
   For i = 0 To 13                                           '编号不可以改变
       Text1(i).Enabled = True                               '各文本框可用
   Next i
       Combo1.Enabled = True
ElseIf cmdmodify.Caption = "确定" Then                        '当按钮的状态为“确定”时
   If Trim(Text1(3).Text) = "" Then
      MsgBox "伤者姓名不能为空", vbOKOnly + vbExclamation, ""
      Text1(3).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(0).Text) Then
      MsgBox "请按照yyyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
      Text1(0).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(8).Text) Then
      MsgBox "请按照yyyy-mm-dd格式输入日期", vbOKOnly + vbExclamation, ""
      Text1(8).SetFocus
      Exit Sub
   End If
   If Not IsDate(Text1(1).Text) Then
      MsgBox "请按照hh-mm的格式输入时间", vbOKOnly + vbExclamation, ""
      Text1(1).SetFocus
      Exit Sub
   End If
   If Not IsNumeric(Text1(11).Text) Then
      MsgBox "医疗费请输入数字！", vbOKOnly + vbExclamation, ""
      Text1(11).SetFocus
      Exit Sub
   End If
   Text1(0) = Format(Text1(0), "yyyy-mm-dd")                 '转化为正确的格式
   Text1(8) = Format(Text1(8), "yyyy-mm-dd")
   cmdmodify.Caption = "修改记录"                             '按钮名称改为“修改记录”
   cmdadd.Enabled = True                                   '删除与增加按钮可用
   cmddel.Enabled = True
   cmdcancel.Enabled = False
   For i = 0 To 10
       rs_shigu.Fields(i) = Trim(Text1(i).Text)
   Next i
       rs_shigu.Fields(4) = Trim(Combo1.Text)
   rs_shigu.Update
   MsgBox "修改成功", vbOKOnly + vbExclamation, ""
   Frame2.Enabled = True
   Combo1.Enabled = False
End If
modifyerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmddel_Click()
Dim i As Integer
Dim answer As String
On Error GoTo delerror
answer = MsgBox("确定要删除吗？", vbYesNo, "")
If answer = vbYes Then
   rs_shigu.Delete
   rs_shigu.MoveNext
   If rs_shigu.EOF Then
      rs_shigu.MoveFirst
   End If
      viewdata
Else
   viewdata
End If
delerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 事故管理"
rs_shigu.CursorLocation = adUseClient
rs_shigu.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
If userpow = "guest" Then
   Frame3.Enabled = False
End If
If rs_shigu.EOF = False Then
   rs_shigu.MoveFirst
   viewdata
Else
   MsgBox "没有记录！", vbOKOnly + vbExclamation, ""
End If
 Combo1.AddItem "男"
   Combo1.AddItem "女"
   Combo1.Enabled = False
cmdcancel.Enabled = False
loaderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
rs_shigu.Close
End Sub

Public Sub viewdata()
Dim i As Integer
On Error GoTo viewerror
For i = 0 To 13
       If IsNull(rs_shigu.Fields(i)) Then
          Text1(i).Text = ""
       Else
          Text1(i).Text = rs_shigu.Fields(i)
       End If
          Text1(i).Enabled = False
Next i
Combo1.Text = rs_shigu.Fields(4)
viewerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub