frmpaydingjin.frm

本课题为实践课题

            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "预定单编号"
            Height          =   255
            Index           =   1
            Left            =   240
            TabIndex        =   19
            Top             =   1080
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "预定客户"
            Height          =   255
            Index           =   2
            Left            =   2880
            TabIndex        =   18
            Top             =   1080
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "预定房屋编号"
            Height          =   255
            Index           =   3
            Left            =   5520
            TabIndex        =   17
            Top             =   1080
            Width           =   1095
         End
         Begin VB.Label Label1 
            Caption         =   "定金金额"
            Height          =   255
            Index           =   4
            Left            =   2880
            TabIndex        =   16
            Top             =   480
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "收费日期"
            Height          =   255
            Index           =   5
            Left            =   5760
            TabIndex        =   15
            Top             =   480
            Width           =   855
         End
         Begin VB.Label Label2 
            Caption         =   "元"
            Height          =   255
            Index           =   0
            Left            =   5160
            TabIndex        =   14
            Top             =   480
            Width           =   255
         End
         Begin VB.Label Label1 
            Caption         =   " 备  注"
            Height          =   255
            Index           =   6
            Left            =   360
            TabIndex        =   13
            Top             =   1920
            Width           =   855
         End
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "功能键"
      Height          =   975
      Left            =   1200
      TabIndex        =   0
      Top             =   120
      Width           =   6135
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭"
         Height          =   495
         Left            =   4440
         TabIndex        =   10
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton cmdReset 
         Caption         =   "清空重填"
         Height          =   495
         Left            =   2520
         TabIndex        =   9
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "收取定金"
         Height          =   495
         Left            =   600
         TabIndex        =   8
         Top             =   240
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmPayDingJin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sqlpay As String
Dim sqlyd As String
Dim sqlch As String
Dim rs_pay As New ADODB.Recordset
Dim rs_yd 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 DingJin 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
   '还需要检测预定单编号是否存在、并且自动写入预定客户和预定房屋编号
   sqlyd = "select * from YuDing where 预定单编号 = '" & Text1(3).Text & "'"
   rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
   If rs_yd.EOF = True Then
      MsgBox "该预定单编号不存在！", vbOKOnly + vbInformation, "注意"
      rs_yd.Close
      Text1(3).SetFocus
      Exit Sub
   Else
      Text1(1).Text = rs_yd.Fields(3)
      Text1(4).Text = rs_yd.Fields(1)
      Text1(5).Text = rs_yd.Fields(2)
   End If
   rs_yd.Close
   
   '加入定金收费表
   sqlpay = "select * from DingJin "
   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 15
      Text1(i).Enabled = False
   Next i
   '判断是从frmYuDing调用的还是菜单直接调用的本窗体
   If fromYuding = 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 15
             Text1(i).Text = ""
         Next i
         cmdAdd.Enabled = False
         cmdReset.Enabled = False
      End If
   ElseIf fromYuding = True Then
   '从frmYuDing窗体调用的
      If SSTab1.Tab = 0 Then
         Text1(1).Text = frmYuDing.Text1(3).Text
         Text1(2).Text = Date
         Text1(3).Text = frmYuDing.Text1(0).Text
         Text1(4).Text = frmYuDing.Text1(1).Text
         Text1(5).Text = frmYuDing.Text1(2).Text
      ElseIf SSTab1.Tab = 1 Then
         For i = 0 To 8
            Text1(i + 7).Text = frmYuDing.Text1(i).Text
         Next i
         cmdAdd.Enabled = False
         cmdReset.Enabled = False
      End If
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   '设置fromYuding=false
   fromYuding = 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 15
            Text1(i).Text = ""
         Next i
      '如果定金收取选项卡中预定单编号不为空，则打开相应记录
      Else
         sqlyd = "select * from YuDing where 预定单编号 = '" & Text1(3).Text & "'"
         rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
         If rs_yd.EOF = True Then
            MsgBox "相应预定单编号的记录不存在！", vbOKOnly + vbInformation, "注意"
            rs_yd.Close
            For i = 7 To 15
               Text1(i).Text = ""
            Next i
            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 If
         
End Sub