📄 frmcheliang.frm

📁 采用VB+SQL编写的房屋销售管理系统,
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
                  MsgBox "购买价格请输入数字", vbOKOnly + vbExclamation, ""
                  Text1(7).SetFocus
                  Exit Sub
               End If
               Text1(6) = Format(Text1(6), "yyyy-mm-dd")     '转化为正确的格式
               rs_dengji.AddNew
               For i = 0 To 8
                   rs_dengji.Fields(i) = Trim(Text1(i).Text)
                   Text1(i).Enabled = False
               Next i
               rs_dengji.Update
          Case 1
               If Trim(Text1(0).Text) = "" Then
                  MsgBox "车辆编号不能为空", vbOKOnly + vbExclamation, ""
                  Text1(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入使用日期", vbOKOnly + vbExclamation, ""
                  Text2(1).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(5).Text) Then
                  MsgBox "请按照hh:mm格式输入起始时间", vbOKOnly + vbExclamation, ""
                  Text2(5).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(6).Text) Then
                  MsgBox "请按照hh:mm格式输入截止时间", vbOKOnly + vbExclamation, ""
                  Text2(6).SetFocus
                  Exit Sub
               End If
               Text2(1) = Format(Text2(1), "yyyy-mm-dd")
               Text2(6) = Format(Text2(6), "hh:mm")
               Text2(5) = Format(Text2(5), "hh:mm")
               rs_shiyong.AddNew
               For i = 0 To 7
                   rs_shiyong.Fields(i) = Trim(Text2(i).Text)
                   Text2(i).Enabled = False
               Next i
               rs_shiyong.Update
          Case 2
               If Trim(Text3(0).Text) = "" Then
                  MsgBox "车辆编号不能为空！", vbOKOnly + vbExclamation, ""
                  Text3(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text3(5).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入事故发生日期", vbOKOnly + vbExclamation, ""
                  Text3(5).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text3(8).Text) Then
                  MsgBox "请输入公司负担金额！", vbOKOnly + vbExclamation, ""
                  Text3(8).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text3(9).Text) Then
                  MsgBox "请输入保险理赔金额！", vbOKOnly + vbExclamation, ""
                  Text3(9).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text3(10).Text) Then
                  MsgBox "请输入对方赔偿金额！", vbOKOnly + vbExclamation, ""
                  Text3(10).SetFocus
                  Exit Sub
               End If
               If Not IsNumeric(Text3(11).Text) Then
                  MsgBox "请输入本人负责金额！", vbOKOnly + vbExclamation, ""
                  Text3(11).SetFocus
                  Exit Sub
               End If
               Text3(5) = Format(Text3(5), "yyyy-mm-dd")
               rs_shigu.AddNew
               For i = 0 To 21
                   rs_shigu.Fields(i) = Trim(Text3(i).Text)
                   Text3(i).Enabled = False
               Next i
               rs_shigu.Update
   End Select
               cmdadd.Caption = "增加记录"                             '按钮名称改为“增加记录”
               cmddel.Enabled = True                                   '删除与修改按钮可用
               cmdmodify.Enabled = True
               cmdcancel.Enabled = False
               MsgBox "增加成功", vbOKOnly + vbExclamation, ""
End If
adderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdcancel_Click()
Select Case SSTab1.Tab
       Case 0
            viewdata_dengji
       Case 1
            viewdata_shiyong
       Case 2
            viewdata_shigu
End Select
If cmdadd.Caption = "确定" Then
   cmdadd.Caption = "增加记录"
   cmddel.Enabled = True
   cmdmodify.Enabled = True
   cmdcancel.Enabled = False
ElseIf cmdmodify.Caption = "确定" Then
   cmdmodify.Caption = "修改记录"
   cmdadd.Enabled = True
   cmddel.Enabled = True
   cmdcancel.Enabled = False
End If
Frame1.Enabled = True
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
   Select Case SSTab1.Tab
          Case 0
               rs_dengji.Delete
               rs_dengji.MoveNext
               If rs_dengji.EOF Then
                  rs_dengji.MoveFirst
               End If
               viewdata_dengji
          Case 1
               rs_shiyong.Delete
               rs_shiyong.MoveNext
               If rs_shiyong.EOF Then
                  rs_shiyong.MoveFirst
               End If
               viewdata_shiyong
          Case 2
               rs_shigu.Delete
               rs_shigu.MoveNext
               If rs_shigu.EOF Then
                  rs_shigu.MoveFirst
               End If
               viewdata_shigu
   End Select
   MsgBox "删除成功！", vbOKOnly + vbExclamation, ""
Else
   Exit Sub
End If
delerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdfirst_Click()
On Error GoTo firsterror
Select Case SSTab1.Tab
       Case 0
            rs_dengji.MoveFirst
            viewdata_dengji
       Case 1
            rs_shiyong.MoveFirst
            viewdata_shiyong
       Case 2
            rs_shigu.MoveFirst
            viewdata_shigu
End Select
firsterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdlast_Click()
On Error GoTo lasterror
Select Case SSTab1.Tab
       Case 0
            rs_dengji.MoveLast
            viewdata_dengji
       Case 1
            rs_shiyong.MoveLast
            viewdata_shiyong
       Case 2
            rs_shigu.MoveLast
            viewdata_shigu
End Select
lasterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdmodify_Click()
Dim i As Integer
On Error GoTo modifyerror
Frame1.Enabled = False
If cmdmodify.Caption = "修改记录" Then                        '当此按钮的状态为为“增加记录”时
   cmdmodify.Caption = "确定"                                 '按钮名称改为“确定”
   cmdadd.Enabled = False                                     '删除与增加按钮不可用
   cmddel.Enabled = False
   cmdcancel.Enabled = True
   Select Case SSTab1.Tab
          Case 0
               For i = 1 To 8                                '编号不可以改变
                   Text1(i).Enabled = True                    '各文本框可用
               Next i
          Case 1
               For i = 1 To 7
                   Text2(i).Enabled = True
               Next i
          Case 2
               For i = 1 To 21
                   Text3(i).Enabled = True
               Next i
   End Select
ElseIf cmdmodify.Caption = "确定" Then                        '当按钮的状态为“确定”时
   Select Case SSTab1.Tab
          Case 0
               If Not IsDate(Text1(6).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入购买日期", vbOKOnly + vbExclamation, ""
                  Text1(6).SetFocus
                  Exit Sub
               End If
               Text1(6) = Format(Text1(6), "yyyy-mm-dd")     '转化为正确的格式
               For i = 1 To 8
                  rs_dengji.Fields(i) = Trim(Text1(i).Text)
                  Text1(i).Enabled = False
               Next i
               rs_dengji.Update
          Case 1
               If Not IsDate(Text2(1).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入使用日期", vbOKOnly + vbExclamation, ""
                  Text2(1).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(5).Text) Then
                  MsgBox "请按照hh:mm格式输入起始时间", vbOKOnly + vbExclamation, ""
                  Text2(5).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text2(6).Text) Then
                  MsgBox "请按照hh:mm格式输入截止时间", vbOKOnly + vbExclamation, ""
                  Text2(6).SetFocus
                  Exit Sub
               End If
               Text2(1) = Format(Text2(1), "yyyy-mm-dd")
               Text2(6) = Format(Text2(6), "hh:mm")
               Text2(5) = Format(Text2(5), "hh:mm")
               For i = 1 To 7
                  rs_shiyong.Fields(i) = Trim(Text2(i).Text)
                  Text2(i).Enabled = False
               Next i
               rs_shiyong.Update
          Case 2
               If Trim(Text3(0).Text) = "" Then
                  MsgBox "车辆编号不能为空！", vbOKOnly + vbExclamation, ""
                  Text3(0).SetFocus
                  Exit Sub
               End If
               If Not IsDate(Text3(5).Text) Then
                  MsgBox "请按照yyyy-mm-dd格式输入事故发生日期", vbOKOnly + vbExclamation, ""
                  Text3(5).SetFocus
                  Exit Sub
               End If
               Text3(5) = Format(Text3(5), "yyyy-mm-dd")
               For i = 1 To 21
                  rs_shigu.Fields(i) = Trim(Text3(i).Text)
                  Text3(i).Enabled = False
               Next i
               rs_shigu.Update
   End Select
   cmdmodify.Caption = "修改记录"                             '按钮名称改为“修改记录”
   cmdadd.Enabled = True                                   '删除与增加按钮可用
   cmddel.Enabled = True
   cmdcancel.Enabled = False
   MsgBox "修改成功", vbOKOnly + vbExclamation, ""
   Frame1.Enabled = True
End If
modifyerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdnext_Click()
On Error GoTo nexterror
Select Case SSTab1.Tab
       Case 0
            rs_dengji.MoveNext
            If rs_dengji.EOF Then
               MsgBox "这已经是最后一条记录！", vbOKOnly + vbExclamation, ""
               rs_dengji.MovePrevious
               Exit Sub
            Else
               viewdata_dengji
            End If
       Case 1
            rs_shiyong.MoveNext
            If rs_shiyong.EOF Then
               MsgBox "这已经是最后一条记录！", vbOKOnly + vbExclamation, ""
               rs_shiyong.MovePrevious
               Exit Sub
            Else
               viewdata_shiyong
            End If
       Case 2
            rs_shigu.MoveNext
            If rs_shigu.EOF Then
               MsgBox "这已经是最后一条记录！", vbOKOnly + vbExclamation, ""
               rs_shigu.MovePrevious
               Exit Sub
            Else
               viewdata_shigu
            End If
End Select
nexterror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub cmdprevious_Click()
On Error GoTo previouserror
Select Case SSTab1.Tab
       Case 0
            rs_dengji.MovePrevious
            If rs_dengji.BOF Then
               MsgBox "这已经是第一条记录！", vbOKOnly + vbExclamation, ""
               rs_dengji.MoveNext
               Exit Sub
            Else
               viewdata_dengji
            End If
       Case 1
            rs_shiyong.MovePrevious
            If rs_shiyong.BOF Then
               MsgBox "这已经是第一条记录！", vbOKOnly + vbExclamation, ""
               rs_shiyong.MoveNext
               Exit Sub
            Else
               viewdata_shiyong
            End If
       Case 2
            rs_shigu.MovePrevious
            If rs_shigu.BOF Then
               MsgBox "这已经是第一条记录！", vbOKOnly + vbExclamation, ""
               rs_shigu.MoveNext
               Exit Sub
            Else
               viewdata_shigu
            End If
End Select
previouserror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
If userpow = "guest" Then
   Frame2.Enabled = False
End If
Select Case select_menu
       Case "dengji"
             SSTab1.Tab = 0
       Case "shiyong"
             SSTab1.Tab = 1
       Case "shigu"
             SSTab1.Tab = 2
End Select
'打开车辆登记数据库
sql = "select * from 车辆登记"
rs_dengji.CursorLocation = adUseClient
rs_dengji.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_dengji.EOF = False Then
   rs_dengji.MoveFirst
   viewdata_dengji
End If
'打开车辆使用数据库
sql = "select * from 车辆使用"
rs_shiyong.CursorLocation = adUseClient
rs_shiyong.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_shiyong.EOF = False Then
   rs_shiyong.MoveFirst
   viewdata_shiyong
End If
'打开车辆事故数据库
sql = "select * from 车辆事故"
rs_shigu.CursorLocation = adUseClient
rs_shigu.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_shigu.EOF = False Then
   rs_shigu.MoveFirst
   viewdata_shigu
End If
cmdcancel.Enabled = False
loaderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub viewdata_dengji()
Dim i As Integer
On Error GoTo view_dengjierror
For i = 0 To 8
       If IsNull(rs_dengji.Fields(i)) Then
          Text1(i).Text = ""
       Else
          Text1(i).Text = rs_dengji.Fields(i)
       End If
          Text1(i).Enabled = False
Next i
view_dengjierror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub viewdata_shiyong()
Dim i As Integer
On Error GoTo view_shiyongerror
For i = 0 To 7
       If IsNull(rs_shiyong.Fields(i)) Then
          Text2(i).Text = ""
       Else
          Text2(i).Text = rs_shiyong.Fields(i)
       End If
          Text2(i).Enabled = False
Next i
view_shiyongerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub viewdata_shigu()
Dim i As Integer
On Error GoTo view_shiguerror
For i = 0 To 21
       If IsNull(rs_shigu.Fields(i)) Then
          Text3(i).Text = ""
       Else
          Text3(i).Text = rs_shigu.Fields(i)
       End If
          Text3(i).Enabled = False
Next i
view_shiguerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
'关闭数据库
rs_dengji.Close
rs_shiyong.Close
rs_shigu.Close
End Sub
上一页 1 23
💿 文件大小 263 K
👤 上传用户 qq448792326
📂 所属分类压缩解压
🏷️ 相关标签

#SQL #VB #编写 #房屋
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -