frmdataadd.frm

此为水费收费管理系统

      Caption         =   "账号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Index           =   3
      Left            =   450
      TabIndex        =   12
      Top             =   1545
      Width           =   630
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "号数："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Index           =   0
      Left            =   450
      TabIndex        =   11
      Top             =   285
      Width           =   630
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Index           =   1
      Left            =   450
      TabIndex        =   10
      Top             =   1110
      Width           =   630
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "业户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Index           =   7
      Left            =   240
      TabIndex        =   9
      Top             =   690
      Width           =   840
   End
End
Attribute VB_Name = "FrmDataAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim i As Integer

Dim Rec As New ADODB.Recordset
Dim Sql As String

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    Me.KeyPreview = True
    MdlMain.ReturnSql = ""
    For i = 0 To 5
        Text1(i).Text = ""
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If Rec.State = 1 Then Rec.Close: Set Rec = Nothing
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    If Index = 0 Then
        Text1(Index).SelStart = Len(Text1(Index).Text)
        Exit Sub
    End If
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyUp
            Select Case Index
                Case 0
                    Text1(5).SetFocus
                Case Else
                    Text1(Index - 1).SetFocus
            End Select
        Case vbKeyDown
            Select Case Index
                Case 5
                    Text1(0).SetFocus
                Case Else
                    Text1(Index + 1).SetFocus
            End Select
    End Select
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 39 Then KeyAscii = 0: Exit Sub
    Select Case Index
        Case 0, 5
            If KeyAscii <= vbKey9 And KeyAscii >= 46 Or KeyAscii = vbKeyBack Then Exit Sub
            KeyAscii = 0
    End Select
End Sub

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0              '退出
            Unload Me
        Case 1              '新增加
            If Len(Trim(Text1(0).Text)) = 0 Then
                MsgBox "《号数》不能为空...", vbOKOnly + vbExclamation, "号数出错"
                Text1(0).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(2).Text)) = 0 Then
                MsgBox "《户名》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(2).SetFocus
                Exit Sub
            End If
            
            Rec.CursorLocation = adUseClient
            Rec.Open "select * from lqryk where hsh=" & Val(Text1(0).Text), Cn_Rsh, _
                adOpenDynamic, adLockOptimistic
            On Error GoTo Er1
            If Not Rec.EOF And Not Rec.BOF Then
                If MsgBox("号数重复，是否继续进行添加操作？", vbOKCancel + vbExclamation, "号数重复") = vbOK Then
                    Cn_Rsh.Execute "update lqryk set hsh=hsh+1 where hsh>=" & Val(Text1(0).Text)
                    GoTo AddNewHsh
                Else
                    Text1(0).SetFocus
                    Rec.Close
                    Set Rec = Nothing
                End If
            Else
AddNewHsh:
                MdlMain.ReturnSql = "已增加"
                Cn_Rsh.BeginTrans
                    With Rec
                        .AddNew
                        .Fields("hsh").Value = Val(Text1(0).Text)
                        .Fields("yname").Value = IIf(Trim(Text1(1).Text) = "", " ", Trim(Text1(1).Text))
                        .Fields("name").Value = Trim(Text1(2).Text)
                        .Fields("pid").Value = IIf(Trim(Text1(3).Text) = "", " ", Trim(Text1(3).Text))
                        .Fields("phone").Value = IIf(Trim(Text1(4).Text) = "", " ", Trim(Text1(4).Text))
                        .Fields("length").Value = Val(Text1(5).Text)
                        
                        .Fields("water").Value = " "
                        .Fields("sanitation").Value = " "
                        .Update
                    End With
                Cn_Rsh.CommitTrans
                Rec.Close
                Set Rec = Nothing
                For i = 0 To 5
                    Text1(i).Text = ""
                Next i
                Text1(0).SetFocus
            End If
            Exit Sub
Er1:
            MsgBox "错误号：" & Err.Number & vbCrLf & vbCrLf & "错误描述：" & Err.Description, _
                vbOKOnly + vbCritical, "保存出错"
            On Error Resume Next
            Cn_Rsh.RollbackTrans
        Case 2      '修改
            If Len(Trim(Text1(2).Text)) = 0 Then
                MsgBox "《户名》不能为空...", vbOKOnly + vbExclamation, "不能为空"
                Text1(2).SetFocus
                Exit Sub
            End If
            If Len(Trim(Text1(0).Text)) = 0 Then
                MsgBox "《号数》不能为空...", vbOKOnly + vbExclamation, "号数出错"
                Text1(0).SetFocus
                Exit Sub
            End If
            
            If MdlMain.ReturnSql <> Trim(Text1(0).Text) Then
                Set Rec = Cn_Rsh.Execute("select * from lqryk where hsh=" & Val(Text1(0).Text))
                If Not Rec.EOF And Not Rec.BOF Then
                    MsgBox "号数重复，请重新输入号数...", vbOKOnly + vbExclamation, "号数重复"
                    Text1(0).SetFocus
                    Rec.Close
                    Set Rec = Nothing
                    Exit Sub
                End If
                Set Rec = Nothing
            End If
            MdlMain.ReturnSql = "已保存"
            On Error GoTo ER2
            Cn_Rsh.BeginTrans
                With FrmMain.Rec
                    .Fields("hsh").Value = Val(Text1(0).Text)
                    .Fields("yname").Value = IIf(Trim(Text1(1).Text) = "", " ", Trim(Text1(1).Text))
                    .Fields("name").Value = Trim(Text1(2).Text)
                    .Fields("pid").Value = IIf(Trim(Text1(3).Text) = "", " ", Trim(Text1(3).Text))
                    .Fields("phone").Value = IIf(Trim(Text1(4).Text) = "", " ", Trim(Text1(4).Text))
                    .Fields("length").Value = Val(Text1(5).Text)
                    
                    .Fields("water").Value = " "
                    .Fields("sanitation").Value = " "
                    .Update
                End With
            Cn_Rsh.CommitTrans
            Unload Me
            Exit Sub
ER2:
            MsgBox "错误号：" & Err.Number & vbCrLf & vbCrLf & "错误描述：" & Err.Description, _
                vbOKOnly + vbCritical, "修改出错"
            On Error Resume Next
            Cn_Rsh.RollbackTrans
    End Select
End Sub