frmpayyajin.frm

本课题为实践课题

            Height          =   975
            Index           =   6
            Left            =   1320
            MultiLine       =   -1  'True
            TabIndex        =   12
            Top             =   1560
            Width           =   6495
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   5
            Left            =   6720
            TabIndex        =   11
            Top             =   960
            Width           =   1095
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   4
            Left            =   3960
            TabIndex        =   10
            Top             =   960
            Width           =   1095
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   3
            Left            =   1320
            TabIndex        =   9
            Top             =   960
            Width           =   1095
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   2
            Left            =   6720
            TabIndex        =   8
            Top             =   360
            Width           =   1095
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   1
            Left            =   3960
            TabIndex        =   7
            Top             =   360
            Width           =   1095
         End
         Begin VB.TextBox Text1 
            Height          =   375
            Index           =   0
            Left            =   1320
            TabIndex        =   6
            Top             =   360
            Width           =   1095
         End
         Begin VB.Label Label1 
            Caption         =   " 备  注"
            Height          =   255
            Index           =   6
            Left            =   360
            TabIndex        =   20
            Top             =   1920
            Width           =   855
         End
         Begin VB.Label Label2 
            Caption         =   "元"
            Height          =   255
            Index           =   0
            Left            =   5160
            TabIndex        =   19
            Top             =   480
            Width           =   255
         End
         Begin VB.Label Label1 
            Caption         =   "收费日期"
            Height          =   255
            Index           =   5
            Left            =   5760
            TabIndex        =   18
            Top             =   480
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "押金金额"
            Height          =   255
            Index           =   4
            Left            =   2880
            TabIndex        =   17
            Top             =   480
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "房屋编号"
            Height          =   255
            Index           =   3
            Left            =   5760
            TabIndex        =   16
            Top             =   1080
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "客户姓名"
            Height          =   255
            Index           =   2
            Left            =   2880
            TabIndex        =   15
            Top             =   1080
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "合同编号"
            Height          =   255
            Index           =   1
            Left            =   360
            TabIndex        =   14
            Top             =   1080
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   " 收费编号"
            Height          =   255
            Index           =   0
            Left            =   240
            TabIndex        =   13
            Top             =   480
            Width           =   855
         End
      End
   End
End
Attribute VB_Name = "frmPayYaJin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sqlpay As String
Dim sqlcon As String
Dim sqlch As String
Dim rs_pay As New ADODB.Recordset
Dim rs_con As New ADODB.Recordset
Dim rs_ch As New ADODB.Recordset

Private Sub cmdAdd_Click()
   '先检测数据完整性
   If Text1(0).Text = "" Then
      MsgBox "收费编号不可为空！", vbOKOnly + vbInformation, "注意"
      Text1(0).SetFocus
      Exit Sub
   End If
   If Text1(2).Text = "" Or IsDate(Text1(2).Text) = False Then
      MsgBox "收费日期应为这样的日期格式：2003-8-3！", vbOKOnly + vbInformation, "注意"
      Text1(2).SetFocus
      Exit Sub
   End If
   If Text1(3).Text = "" Then
      MsgBox "合同编号不可为空！", vbOKOnly + vbInformation, "注意"
      Text1(3).SetFocus
      Exit Sub
   End If
   
   '检测该收费编号是否已存在
   sqlch = "select * from YaJIn where 收费编号 = '" & Text1(0).Text & "'"
   rs_ch.Open sqlch, conn, adOpenStatic, adLockOptimistic
   If rs_ch.EOF = False Then
      MsgBox "该收费编号已经存在，请重新输入一个！", vbOKOnly + vbInformation, "注意"
      Text1(0).SetFocus
      rs_ch.Close
      Exit Sub
      
   End If
   rs_ch.Close
   '还需要检测合同编号是否存在、并且自动写入客户姓名和房屋编号以及押金
   sqlcon = "select * from Contract where 合同编号 = '" & Text1(3).Text & "'"
   rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
   If rs_con.EOF = True Then
      MsgBox "该合同编号不存在！", vbOKOnly + vbInformation, "注意"
      rs_con.Close
      Text1(3).SetFocus
      Exit Sub
   Else
      Text1(1).Text = rs_con.Fields(8)
      Text1(4).Text = rs_con.Fields(1)
      Text1(5).Text = rs_con.Fields(2)
   End If
   rs_con.Close
   
   '加入押金收费表
   sqlpay = "select * from YaJIn "
   rs_pay.Open sqlpay, conn, adOpenStatic, adLockOptimistic
   rs_pay.AddNew
   For i = 0 To 6
      rs_pay.Fields(i) = Text1(i)
   Next i
   rs_pay.Update
   rs_pay.Close
   MsgBox "收取押金成功！", vbOKOnly + vbInformation, "注意"
   
   '添加完后，需要设置收取押金按钮不可用
   cmdAdd.Enabled = False
   
End Sub

Private Sub cmdClose_Click()
   Unload Me
End Sub

Private Sub cmdReset_Click()
   '清空所有text
   For i = 0 To 6
      Text1(i).Text = ""
   Next i
   '设定收费日期为当前日期
   Text1(2).Text = Date
   '设置收取押金按钮为可用
   cmdAdd.Enabled = True
   
End Sub

Private Sub Form_Load()
   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
   '押金金额、客户姓名和房屋编号应根据合同编号自动填入，因此需要设定它们不可写
   Text1(1).Enabled = False
   Text1(4).Enabled = False
   Text1(5).Enabled = False
   
   '设置所有合同资料选项卡的text为不可写
   For i = 7 To 18
      Text1(i).Enabled = False
   Next i
   '判断是从frmSignContract调用的还是菜单直接调用的本窗体
   If fromContract = False Then
   '菜单直接调用的
      '如果要显示的是押金收取选项卡
      If SSTab1.Tab = 0 Then
         '清空所有text
         For i = 0 To 6
            Text1(i).Text = ""
         Next i
         '设定收费日期为当前日期
         Text1(2).Text = Date
      '如果要显示的是合同资料选项卡
      ElseIf SSTab1.Tab = 1 Then
         '开始时，由于押金收取信息没有显示，因此相应的合同资料也都显示为空
         For i = 7 To 18
             Text1(i).Text = ""
         Next i
         cmdAdd.Enabled = False
         cmdReset.Enabled = False
      End If
   ElseIf fromContract = True Then
   '从frmSignContract窗体调用的
      If SSTab1.Tab = 0 Then
         Text1(1).Text = frmSignContract.Text1(8).Text
         Text1(2).Text = Date
         Text1(3).Text = frmSignContract.Text1(0).Text
         Text1(4).Text = frmSignContract.Text1(1).Text
         Text1(5).Text = frmSignContract.Text1(2).Text
      ElseIf SSTab1.Tab = 1 Then
         For i = 0 To 11
            Text1(i + 7).Text = frmSignContract.Text1(i).Text
         Next i
         cmdAdd.Enabled = False
         cmdReset.Enabled = False
      End If
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   '设置fromContract=false
   fromContract = False
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
   
   If SSTab1.Tab = 0 Then
      '不需要改变数据，只需要相应修改按钮是否可用
      cmdReset.Enabled = True
      cmdAdd.Enabled = True
      '设定收费日期为当前日期
      Text1(2).Text = Date
   '合同选项卡
   Else
      cmdReset.Enabled = False
      cmdAdd.Enabled = False
      
      '如果押金收取选项卡中合同编号为空
      If Text1(3).Text = "" Then
         For i = 7 To 18
            Text1(i).Text = ""
         Next i
      '如果押金收取选项卡中合同编号不为空，则打开相应记录
      Else
         sqlcon = "select * from Contract where 合同编号 = '" & Text1(3).Text & "'"
         rs_con.Open sqlcon, conn, adOpenStatic, adLockOptimistic
         If rs_con.EOF = True Then
            MsgBox "相应合同编号的记录不存在！", vbOKOnly + vbInformation, "注意"
            rs_con.Close
            For i = 7 To 18
               Text1(i).Text = ""
            Next i
            Exit Sub
         Else
            For i = 7 To 18
               Text1(i).Text = rs_con.Fields(i - 7)
            Next i
            rs_con.Close
         End If
      End If
   End If
         
End Sub