frmbackdingjin.frm

本课题为实践课题

            Left            =   6720
            TabIndex        =   19
            Top             =   1080
            Width           =   375
         End
         Begin VB.Label Label1 
            Caption         =   "定金有效期"
            Height          =   255
            Index           =   11
            Left            =   3840
            TabIndex        =   18
            Top             =   1080
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "定  金"
            Height          =   255
            Index           =   12
            Left            =   360
            TabIndex        =   17
            Top             =   1080
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "预定房屋编号"
            Height          =   255
            Index           =   13
            Left            =   5520
            TabIndex        =   16
            Top             =   480
            Width           =   1215
         End
         Begin VB.Label Label1 
            Caption         =   "预定客户"
            Height          =   255
            Index           =   14
            Left            =   3000
            TabIndex        =   15
            Top             =   480
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "预定单编号"
            Height          =   255
            Index           =   15
            Left            =   360
            TabIndex        =   14
            Top             =   480
            Width           =   975
         End
      End
   End
End
Attribute VB_Name = "frmBackDingJin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义几个共用变量
Dim rs_dj As New ADODB.Recordset
Dim rs_yd As New ADODB.Recordset
Dim rs_count As New ADODB.Recordset
Dim sqlcount As String
Dim sqldj As String
Dim sqlyd As String


Private Sub cmdClose_Click()
   Unload Me
End Sub

Private Sub cmdend_Click()
   '当单击定金退还按钮时，需要弹出一个提示框，警告用户
   Dim answer As String
   answer = MsgBox("确定要退还定金吗？", vbYesNo, "")
   '确实退还，则需要从定金表中删除该记录
   If answer = vbYes Then
      rs_dj.Delete  '删除当前记录
      rs_dj.Update  '更新删除
      MsgBox "定金退还成功！", vbOKOnly + vbExclamation, ""
   Else
       Exit Sub
   End If
   '删除之后，显示总信息条数需要减 1
   Text2.Text = Val(Text2.Text) - 1
   '删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
   '先移动rs_dj记录到后一条
   rs_dj.MoveNext
   If rs_dj.EOF Then
      rs_dj.MovePrevious
      '如果没有到记录首则显示该记录
      If Not rs_dj.BOF Then
         For i = 0 To 6
            Text1(i).Text = rs_dj.Fields(i)
         Next i
      '如果到记录首，则表格已经为空，置所有text框显示为空
      ElseIf rs_dj.BOF Then
         For i = 0 To 6
            Text1(i).Text = ""
         Next i
         cmdFirst.Enabled = False
         cmdPrev.Enabled = False
         cmdNext.Enabled = False
         cmdLast.Enabled = False
         cmdEnd.Enabled = False
      End If
   '如果删除的不是首尾记录，则显示当前记录即可
   Else
      For i = 0 To 6
           If IsNull(rs_dj.Fields(i)) Then
              Text1(i).Text = ""
           Else
              Text1(i).Text = rs_dj.Fields(i)
           End If
       Next i
   End If
End Sub


Private Sub cmdFirst_Click()
   '先移动rs_dj记录到第一条
   rs_dj.MoveFirst
   '同时需要设置相应按钮为不可用和不可用
   cmdPrev.Enabled = False
   cmdFirst.Enabled = False
   cmdNext.Enabled = True
   cmdLast.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_dj.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   '如果不是，则个数据表的记录位置移到第一条记录，并且显示之
   Else
      For i = 0 To 6
           If IsNull(rs_dj.Fields(i)) Then
              Text1(i).Text = ""
           Else
              Text1(i).Text = rs_dj.Fields(i)
           End If
       Next i
   End If
End Sub

Private Sub cmdLast_Click()
   '移动rs_dj记录到最后一条
   rs_dj.MoveLast
   cmdFirst.Enabled = True
   cmdPrev.Enabled = True
   cmdNext.Enabled = False
   cmdLast.Enabled = False
    '如果已经是最后一条记录，则提示用户
   If rs_dj.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   '如果不是最后一条，则数据表的记录位置移到后一条记录，并且显示之
   Else
       For i = 0 To 6
           If IsNull(rs_dj.Fields(i)) Then
              Text1(i).Text = ""
           Else
              Text1(i).Text = rs_dj.Fields(i)
           End If
       Next i
   End If
End Sub

Private Sub cmdNext_Click()
   '先移动rs_dj记录到后一条
   rs_dj.MoveNext
   '设置前一条和第一条按钮可用
   cmdPrev.Enabled = True
   cmdFirst.Enabled = True
   '如果已经是最后一条记录，则提示用户
   If rs_dj.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“后一条”和最后一条按钮不可用
      cmdNext.Enabled = False
      cmdLast.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到后一条记录，并且显示之
   Else
      For i = 0 To 6
           If IsNull(rs_dj.Fields(i)) Then
              Text1(i).Text = ""
           Else
              Text1(i).Text = rs_dj.Fields(i)
           End If
       Next i
   End If
End Sub

Private Sub cmdPrev_Click()
   '先移动rs_dj记录到前一条
   rs_dj.MovePrevious
   '设置后一条和最后一条按钮可用
   cmdNext.Enabled = True
   cmdLast.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_dj.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“前一条”和第一条按钮不可用
      cmdPrev.Enabled = False
      cmdFirst.Enabled = False
      Exit Sub
   '如果不是，则数据表的记录位置移到前一条记录，并且显示之
   Else
       For i = 0 To 6
           If IsNull(rs_dj.Fields(i)) Then
              Text1(i).Text = ""
           Else
              Text1(i).Text = rs_dj.Fields(i)
           End If
       Next i
       
   End If
End Sub

Private Sub Form_Activate()
   Dim X0 As Long
   Dim Y0 As Long
   '让窗体居中
   X0 = Screen.Width
   Y0 = Screen.Height
   X0 = (X0 - Me.Width) / 2
   Y0 = (Y0 - Me.Height) / 2
   Me.Move X0, Y0
   '设置所有text不可写
   For i = 0 To 15
      Text1(i).Enabled = False
   Next i
   '分别处理2个选项卡
   Select Case SSTab1.Tab
      '家庭租户选项卡
      Case 0
             '因为开始显示时必定打开了rs_dj,rs_count,所以应该先关闭它们
             
             sqldj = "select * from DingJin " & sqlqdj
             rs_dj.CursorLocation = adUseClient
             rs_dj.Open sqldj, conn, adOpenStatic, adLockOptimistic
             If rs_dj.EOF Then
                Text2.Text = 0
                '如果没有找到记录，则提示用户，置空所有text控件，并且退出本子过程
                MsgBox "没有找到符合条件的记录", vbOKOnly + vbInformation, "注意"
                For i = 0 To 6
                   Text1(i).Text = ""
                Next i
               '如果是0条记录，需要设置前翻后翻的按钮为不可用
                cmdFirst.Enabled = False
                cmdPrev.Enabled = False
                cmdNext.Enabled = False
                cmdLast.Enabled = False
                cmdEnd.Enabled = False
                Exit Sub
             '找到符合条件的记录
             Else
                '如果有记录，需要设置前翻后翻的按钮为可用
                cmdFirst.Enabled = True
                cmdPrev.Enabled = True
                cmdNext.Enabled = True
                cmdLast.Enabled = True
                cmdEnd.Enabled = True
                
                '计算找到的条数
                sqlcount = "select count(*) from DingJin " & sqlqdj
                rs_count.Open sqlcount, conn, adOpenStatic, adLockOptimistic
                Text2.Text = rs_count.Fields(0)
                '找到符合条件的记录，显示之
                 
                For i = 0 To 6
                   If IsNull(rs_dj.Fields(i)) Then
                      Text1(i).Text = ""
                   Else
                      Text1(i).Text = rs_dj.Fields(i)
                   End If
                Next i
             End If
         
      Case 1
             '如果开始时为预定单资料选项卡，则都显示为空
             '设置frame1(1)不可见
             Frame1(1).Visible = False
             cmdFirst.Enabled = False
             cmdPrev.Enabled = False
             cmdNext.Enabled = False
             cmdLast.Enabled = False
             cmdEnd.Enabled = False
             For i = 7 To 15
                Text1(i).Text = ""
             Next i
   End Select
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If rs_dj.State = adStateOpen Then
      rs_dj.Close
   End If
   If rs_yd.State = adStateOpen Then
      rs_yd.Close
   End If
   If rs_count.State = adStateOpen Then
      rs_count.Close
   End If
  
End Sub


Private Sub SSTab1_Click(PreviousTab As Integer)
   Select Case SSTab1.Tab
      '家庭租户选项卡
      Case 0
             '设置frame1(1)不可见
             Frame1(1).Visible = True
             '因为开始显示时必定打开了rs_dj,rs_count,所以应该先关闭它们
             If rs_dj.State = adStateOpen Then
                rs_dj.Close
             End If
             sqldj = "select * from DingJin " & sqlqdj
             rs_dj.CursorLocation = adUseClient
             rs_dj.Open sqldj, conn, adOpenStatic, adLockOptimistic
             If rs_dj.EOF Then
                Text2.Text = 0
                '如果没有找到记录，则提示用户，置空所有text控件，并且退出本子过程
                MsgBox "没有找到符合条件的记录", vbOKOnly + vbInformation, "注意"
                For i = 0 To 6
                   Text1(i).Text = ""
                Next i
               '如果是0条记录，需要设置前翻后翻的按钮为不可用
                cmdFirst.Enabled = False
                cmdPrev.Enabled = False
                cmdNext.Enabled = False
                cmdLast.Enabled = False
                cmdEnd.Enabled = False
                Exit Sub
             '找到符合条件的记录
             Else
                '如果有记录，需要设置前翻后翻的按钮为可用
                cmdFirst.Enabled = True
                cmdPrev.Enabled = True
                cmdNext.Enabled = True
                cmdLast.Enabled = True
                cmdEnd.Enabled = True
                If rs_count.State = adStateOpen Then
                   rs_count.Close
                End If
                
                '计算找到的条数
                sqlcount = "select count(*) from DingJin " & sqlqdj
                rs_count.Open sqlcount, conn, adOpenStatic, adLockOptimistic
                Text2.Text = rs_count.Fields(0)
                '找到符合条件的记录，显示之
                For i = 0 To 6
                   If IsNull(rs_dj.Fields(i)) Then
                      Text1(i).Text = ""
                   Else
                      Text1(i).Text = rs_dj.Fields(i)
                   End If
                Next i
             End If
         
      Case 1
          '设置frame1(1)不可见
          Frame1(1).Visible = False
          cmdFirst.Enabled = False
          cmdPrev.Enabled = False
          cmdNext.Enabled = False
          cmdLast.Enabled = False
          cmdEnd.Enabled = False
          '如果预定单编号为空，则预定单资料选项卡显示为空
          If Text1(3).Text = "" Then
             
             For i = 7 To 15
                Text1(i).Text = ""
             Next i
          Else
             If rs_yd.State = adStateOpen Then
                rs_yd.Close
             End If
             sqlyd = "select * from YuDing where 预定单编号 = '" & Text1(3).Text & "'"
             rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
             If rs_yd.EOF = True Then
                MsgBox "该预定单编号在预定单表中不存在！", vbOKOnly + vbInformation, "注意"
                Exit Sub
             Else
                For i = 7 To 15
                    Text1(i).Text = rs_yd.Fields(i - 7)
                Next i
                rs_yd.Close
             End If
          End If
             
     End Select
End Sub