frmadmincontract.frm

本章示例使用的是Windows2000 Professional版的操作系统

Private Sub cmdClose_Click()
   Unload Me
   
End Sub

Private Sub cmdDelay_Click()
   '需要变换按钮的caption属性，达到一按钮多用
   If cmdDelay.Caption = "合同延期" Then
      cmdDelay.Caption = "确    定"
      '合同延期时，只可以改动止租日期
      Text1(4).Enabled = True
      '需要设置除自身和关闭外，其他按钮不可用
      cmdDelay.Enabled = True
      cmdEnd.Enabled = False
      cmdFirst.Enabled = False
      cmdPrev.Enabled = False
      cmdNext.Enabled = False
      cmdLast.Enabled = False
      
   ElseIf cmdDelay.Caption = "确    定" Then
      cmdDelay.Caption = "合同延期"
      '同时还需要自动修改租期和总租金
      '租期等于起租日期和止租日期之差，结尾不足一月，按一月计。
      '使用datediff 函数计算日期之差
      Text1(5).Text = Int(DateDiff("d", DateValue(Text1(3).Text), DateValue(Text1(4).Text)) / 31) + 1
      '总租金等于月租金乘以租期
      Text1(7).Text = Val(Text1(5).Text) * Val(Text1(6).Text)
      '更新止租日期
      rs_con.Fields(4) = DateValue(Text1(4).Text)
      rs_con.Update
      MsgBox "合同延期成功！", vbOKOnly + vbInformation, "注意"
      '打开所有按钮为可用
      cmdDelay.Enabled = True
      cmdEnd.Enabled = True
      cmdFirst.Enabled = True
      cmdPrev.Enabled = True
      cmdNext.Enabled = True
      cmdLast.Enabled = True
   End If
   
End Sub

Private Sub cmdEnd_Click()
   '当单击合同终止时，需要弹出一个提示框，警告用户
   Dim answer As String
   answer = MsgBox("确定要终止该合同吗？", vbYesNo, "")
   '确实删除
   If answer = vbYes Then
      '需要修改止租日期为当前日期，以及修改其他相应数据，并把该记录加入历史合同记录
      Text1(4).Text = Date
      '修改租期
      Text1(5).Text = Int(DateDiff("d", DateValue(Text1(3).Text), DateValue(Text1(4).Text)) / 31) + 1
       '总租金等于月租金乘以租期
      Text1(7).Text = Val(Text1(5).Text) * Val(Text1(6).Text)
      If rs_old.State = adStateOpen Then
         rs_old.Close
      End If
      '加入历史合同表
      sqlold = "select * from OldContract"
      rs_old.Open sqlold, conn, adOpenStatic, adLockOptimistic
      rs_old.AddNew
      For i = 0 To 11
         rs_old.Fields(i) = Text1(i).Text
      Next i
      rs_old.Update
      '还需要修改House表中该房屋的状态为未租
      If rs_house.State = adStateOpen Then
         rs_house.Close
      End If
      sqlhouse = "select * from House where 房屋编号 = '" & Text1(2).Text & "'"
      rs_house.Open sqlhouse, conn, adOpenStatic, adLockOptimistic
      rs_house(8) = "未租"
      rs_house.Update
      '从租户表中删除该客户
      Dim sqlclient As String
      Dim rs_client As New ADODB.Recordset
      If rs_client.State = adStateOpen Then
         rs_client.Close
      End If
      sqlclient = "select * from Client where 租户姓名= '" & Text1(1).Text & "'"
      rs_client.Open sqlclient, conn, adOpenStatic, adLockOptimistic
      '如果不为空，加入历史客户表，并在客户表中删除
      If Not rs_client.EOF Then
         '把该租户信息加入历史租户表
         Dim sqloldclient As String
         Dim rs_oldclient As New ADODB.Recordset
         If rs_oldclient.State = adStateOpen Then
            rs_oldclient.Close
         End If
         sqloldclient = "select * from OldClient "
         rs_oldclient.Open sqloldclient, conn, adOpenStatic, adLockOptimistic
         rs_oldclient.AddNew
         For i = 0 To 7
            rs_oldclient.Fields(i) = rs_client.Fields(i)
         Next i
         rs_oldclient.Update
         rs_oldclient.Close
         '从客户表中删除该客户资料
         rs_client.Delete
         rs_client.Update
      End If
      rs_client.Close
      
      '删除合同表中当前记录
      rs_con.Delete
      rs_con.Update
      MsgBox "终止合同成功！", vbOKOnly + vbExclamation, ""
   Else
       Exit Sub
   End If
    '删除之后，显示总信息条数需要减 1
   Text2.Text = Val(Text2.Text) - 1
   '删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示最后一条记录
   '先移动rs_con记录到后一条
   rs_con.MoveNext
   If rs_con.EOF Then
      rs_con.MoveLast
      '如果没有到记录首则显示改记录
      If Not rs_con.BOF Then
        For i = 0 To 11
         If IsNull(rs_con.Fields(i)) Then
            Text1(i).Text = ""
         Else
            Text1(i).Text = rs_con.Fields(i)
         End If
        Next i
        '如果到记录首，则表格已经为空，置所有text框显示为空
      ElseIf rs_con.BOF Then
         For i = 0 To 11
            Text1(i).Text = ""
         Next i
      End If
   '如果删除的不是首尾记录，则显示当前记录即可
   Else
      For i = 0 To 11
         If IsNull(rs_con.Fields(i)) Then
            Text1(i).Text = ""
         Else
            Text1(i).Text = rs_con.Fields(i)
         End If
      Next i
   End If
End Sub

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

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

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

Private Sub cmdPrev_Click()
   '先移动rs_con记录到前一条
   rs_con.MovePrevious
   '设置后一条和最后一条按钮可用
   cmdNext.Enabled = True
   cmdLast.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_con.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“前一条”和第一条按钮不可用
      cmdPrev.Enabled = False
      cmdFirst.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到前一条记录，并且显示之
   Else
      For i = 0 To 11
         If IsNull(rs_con.Fields(i)) Then
            Text1(i).Text = ""
         Else
            Text1(i).Text = rs_con.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 11
      Text1(i).Enabled = False
   Next i
   
 '如果不是查询显示,则显示第一条记录
 If querycon = False Then
   '如果rs_count rs_con 当前状态是打开的，则先关闭之
   If rs_count.State = adStateOpen Then
      rs_count.Close
   End If
   If rs_con.State = adStateOpen Then
      rs_con.Close
   End If
   sqlcon = "select * from Contract"
   rs_con.CursorLocation = adUseClient
   rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
   
   If rs_con.EOF Then
      Text2.Text = 0
      '没有记录，则提示用户，退出本过程
      MsgBox "当前表中没有记录！", vbOKOnly + vbInformation, "注意"
      cmdFirst.Enabled = False
      cmdPrev.Enabled = False
      cmdNext.Enabled = False
      cmdLast.Enabled = False
      cmdEnd.Enabled = False
      cmdDelay.Enabled = False
      Exit Sub
   Else
      cmdFirst.Enabled = True
      cmdPrev.Enabled = True
      cmdNext.Enabled = True
      cmdLast.Enabled = True
      cmdEnd.Enabled = True
      cmdDelay.Enabled = True
      '计算总共数据条数
      sqlcount = "select count(*) from Contract"
      rs_count.Open sqlcount, conn, adOpenStatic, adLockOptimistic
      '有记录则，显示第一条，并且显示记录条数
      Text2.Text = rs_count.Fields(0)
      If Not rs_con.EOF And Not rs_con.BOF Then
         For i = 0 To 11
            If IsNull(rs_con.Fields(i)) Then
               Text1(i).Text = ""
            Else
               Text1(i).Text = rs_con.Fields(i)
            End If
         Next i
      End If
   End If
       
 '如果是查询显示则相应sql语句为查询语句
 ElseIf querycon = True Then
   '因为开始显示时必定打开了rs_con,rs_count,所以应该先关闭它们
   If rs_con.State = adStateOpen Then
      rs_con.Close
   End If
   If rs_count.State = adStateOpen Then
      rs_count.Close
   End If
   sqlcon = "select * from Contract " & sqlqcon
   rs_con.CursorLocation = adUseClient
   rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
   
   If rs_con.BOF = True Then
      Text2.Text = 0
      '如果没有找到记录，则提示用户，置空所有text控件，并且退出本子过程
      MsgBox "没有找到符合条件的记录", vbOKOnly + vbInformation, "注意"
      For i = 0 To 11
         Text1(i).Text = ""
      Next i
      cmdFirst.Enabled = False
      cmdPrev.Enabled = False
      cmdNext.Enabled = False
      cmdLast.Enabled = False
      cmdEnd.Enabled = False
      cmdDelay.Enabled = False
      Exit Sub
   Else
      cmdFirst.Enabled = True
      cmdPrev.Enabled = True
      cmdNext.Enabled = True
      cmdLast.Enabled = True
      cmdEnd.Enabled = True
      cmdDelay.Enabled = True
      '计算找到的条数
      sqlcount = "select count(*) from Contract " & sqlqcon
      rs_count.Open sqlcount, conn, adOpenStatic, adLockOptimistic
      Text2.Text = rs_count.Fields(0)
      '找到符合条件的记录，显示之
      For i = 0 To 11
         If IsNull(rs_con.Fields(i)) Then
            Text1(i).Text = ""
         Else
            Text1(i).Text = rs_con.Fields(i)
         End If
      Next i
   End If
         
 End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If rs_con.State = adStateOpen Then
      rs_con.Close
   End If
   If rs_count.State = adStateOpen Then
      rs_count.Close
   End If
   If rs_house.State = adStateOpen Then
      rs_house.Close
   End If
   If rs_old.State = adStateOpen Then
      rs_old.Close
   End If
   
End Sub