frmclean.frm

星级酒店管理系统（附带系统自写控件源码）

         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "L"
         BeginProperty Font 
            Name            =   "Wingdings"
            Size            =   10.5
            Charset         =   2
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000C000&
         Height          =   225
         Index           =   1
         Left            =   690
         TabIndex        =   26
         Top             =   3330
         Width           =   180
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "L"
         BeginProperty Font 
            Name            =   "Wingdings"
            Size            =   10.5
            Charset         =   2
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000C000&
         Height          =   225
         Index           =   0
         Left            =   690
         TabIndex        =   25
         Top             =   3075
         Width           =   180
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "?日期前打勾,那么仅清除所选日期的消费详细信息。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   195
         Left            =   2280
         TabIndex        =   24
         Top             =   1680
         Width           =   4500
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "请首先备份数据库,然后重建。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   1
         Left            =   915
         TabIndex        =   23
         Top             =   3345
         Width           =   2640
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "唐老鸭提醒 "
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   195
         Left            =   915
         TabIndex        =   22
         Top             =   2745
         Width           =   1080
      End
      Begin VB.Line Line1 
         BorderColor     =   &H00C0C0C0&
         X1              =   660
         X2              =   6780
         Y1              =   3015
         Y2              =   3015
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "在需要清除的项目上单击打勾,数据清除后将不能恢复。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   0
         Left            =   915
         TabIndex        =   21
         Top             =   3075
         Width           =   4785
      End
      Begin VB.Image Image1 
         Height          =   480
         Left            =   285
         Picture         =   "frmClean.frx":0E42
         Top             =   2415
         Width           =   480
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00808080&
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   1050
         Left            =   435
         Shape           =   4  'Rounded Rectangle
         Top             =   2640
         Width           =   6570
      End
      Begin VB.Shape Shape2 
         BorderColor     =   &H00FFFFFF&
         FillColor       =   &H00FFFFC0&
         FillStyle       =   0  'Solid
         Height          =   330
         Left            =   2100
         Shape           =   4  'Rounded Rectangle
         Top             =   1620
         Width           =   4830
      End
   End
End
Attribute VB_Name = "frmClean"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub chkCustomer_Click()

 If chkCustomer.Value = vbChecked Then
    chkCustomer.Enabled = False
    chkMember.Value = vbChecked
 End If
 
End Sub

Private Sub chkMember_Click()

 If chkMember.Value = vbChecked Then
     chkCustomer.Value = vbChecked
     chkCustomer.Enabled = False
   Else
     chkCustomer.Value = vbUnchecked
     chkCustomer.Enabled = True
 End If
 
End Sub

Private Sub chkStore_Click()

End Sub

Private Sub chkDate_Click()

  If chkDate.Value = vbChecked Then
     chkCust.Value = vbChecked
  End If
  
End Sub

Private Sub chkMenuType_Click()

   If chkMenuType.Value = vbChecked Then
      chkEatList.Value = vbChecked
      chkEatList.Enabled = False
    Else
      chkEatList.Enabled = True
   End If
   
End Sub

Private Sub chktbdMember_Click()

   If chktbdMember.Value = vbChecked Then
      chktbdBook.Value = vbChecked
      chktbdBook.Enabled = False
      chktbdCash.Value = vbChecked
      chktbdCash.Enabled = False
      chktbdSheel.Value = vbChecked
      chktbdSheel.Enabled = False
      chktbdArrearage.Value = vbChecked
      chktbdArrearage.Enabled = False
      chktbdMemberDetail.Value = vbChecked
      chktbdMemberDetail.Enabled = False
    Else
      chktbdMemberDetail.Enabled = True
      chktbdArrearage.Enabled = True
      chktbdSheel.Enabled = True
      chktbdCash.Enabled = True
      chktbdBook.Enabled = True
   End If
   
End Sub

Private Sub cmdClean_Click()
   
   If MsgBox("选定项目的所有数据都将消失，是否继续（Y/N）？   ", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
      Exit Sub
    Else
      CleanSystem
   End If
  
End Sub

Private Sub cmdClose_Click()

  Unload Me
  
End Sub

Private Sub CleanSystem()

   On Error GoTo ClearErr
   
   Dim DB As Connection, sTMp As String
   Set DB = CreateObject("ADODB.Connection")
       DB.Open Constr
       DB.BeginTrans
  '所有临时表
   If chkTmp.Value = vbChecked Then
      sTMp = "delete  from tmpCust"
      DB.Execute sTMp
      sTMp = "delete  from tmpCust1"
      DB.Execute sTMp
      sTMp = "delete  from tmpSite"
      DB.Execute sTMp
      sTMp = "delete  from tmpSite1"
      DB.Execute sTMp
      sTMp = "delete  from ptCust"
      DB.Execute sTMp
      sTMp = "delete  from tmpBox"
      DB.Execute sTMp
   End If
  '卡对帐单
   If chktbdMemberDetail.Value = vbChecked Then
      sTMp = "delete From tbdmemberDetail"
      DB.Execute sTMp
   End If
  '座位
      If chkSiteType.Value = vbChecked Then
         sTMp = "Delete  From SiteType"
      DB.Execute sTMp
      End If
 ' 付款
      If chkPayType.Value = vbChecked Then
         sTMp = "Delete  From PayType"
      DB.Execute sTMp
      End If
 '单位
      If chkUnitType.Value = vbChecked Then
         sTMp = "Delete  From UnitType"
      DB.Execute sTMp
      End If
      
 ' 消费总表
  If chkCust.Value = vbChecked Then
     If chkDate.Value = vbUnchecked Then
       '删除所有的消费总表
        sTMp = "Delete  From Site"
        DB.Execute sTMp
        sTMp = "Delete  From Cust"
        DB.Execute sTMp
       Else
          '给出ID，然后删除
           Dim OFRec As Recordset
           Dim nID As Long
           Set OFRec = CreateObject("ADODB.Recordset")
               If IsSqlDat = True Then
                  OFRec.Open "Select ID From Site Where Date>='" & dtpDate.Value & "' And Date<='" & dtpEnd.Value & "'", DB, adOpenStatic, adLockOptimistic, adCmdText
                 Else
                  OFRec.Open "Select ID From Site Where Date>=#" & dtpDate.Value & "# And Date<=#" & dtpEnd.Value & "#", DB, adOpenStatic, adLockOptimistic, adCmdText
               End If
            If Not (OFRec.EOF And OFRec.BOF) Then
               '给出今天所有ID
                Do While Not OFRec.EOF
                    nID = OFRec.Fields(0)
                    sTMp = "Delete * From Cust Where SheelID=" & nID
                    DB.Execute sTMp
                    OFRec.MoveNext
                Loop
            End If
            OFRec.Close
            If IsSqlDat = True Then
               sTMp = "Delete From Site Where Date>='" & dtpDate.Value & "' and Date<='" & dtpEnd.Value & "'"
              Else
               sTMp = "Delete From Site Where Date>=#" & dtpDate.Value & "#  and Date<=#" & dtpEnd.Value & "#"
            End If
            DB.Execute sTMp
      End If
  End If
  
 '菜单明细
   If chkEatList.Value = vbChecked Then
         sTMp = "Delete  From eatList"
         DB.Execute sTMp
   End If
      
 ' 菜单类型
   If chkMenuType.Value = vbChecked Then
      sTMp = "Delete  From Menutype"
      DB.Execute sTMp
   End If
 
 ' 酒席
   If chkMenucat.Value = vbChecked Then
       sTMp = "Delete  From tbdMenuCat"
       DB.Execute sTMp
       sTMp = "Delete  From tbdMenuCatDetail"
       DB.Execute sTMp
  End If
  
' 流水帐
  If chktbdWasteBook.Value = vbChecked Then
     sTMp = "Delete  From tbdWasteBook"
     DB.Execute sTMp
  End If
  
' 会员
  If chktbdMember.Value = vbChecked Then
     sTMp = "Delete From tbdMember"
     DB.Execute sTMp
  End If

'员工
  If chktbdGuest.Value = vbChecked Then
     sTMp = "Delete From tbdGuest"
     DB.Execute sTMp
  End If

' 单据列表
  If chktbdSheel.Value = vbChecked Then
     sTMp = "Delete From tbdSheel"
     DB.Execute sTMp
     sTMp = "Update tbdFileSheel Set SheelID=0"
     DB.Execute sTMp
  End If

 '现金总表
  If chktbdCash.Value = vbChecked Then
     sTMp = "Delete From tbdCash"
     DB.Execute sTMp
  End If
 
 '预订
  If chktbdBook.Value = vbChecked Then
     sTMp = "Delete From tbdBook"
     DB.Execute sTMp
  End If
 
 '挂帐
  If chktbdArrearage.Value = vbChecked Then
     sTMp = "Delete From tbdArrearage"
     DB.Execute sTMp
  End If
   
   DB.CommitTrans
   DB.Close
      
   MsgBox "清除工作已经完成,按【确定】按钮退出。   ", vbInformation
   Unload Me
   
   Exit Sub
ClearErr:
   MsgBox "清除错误：" & Err.Description, vbCritical
   Exit Sub
   
End Sub

Private Sub dtpDate_Change()

  On Error Resume Next
  If dtpEnd.Value < dtpDate.Value Then
     dtpEnd.Value = dtpDate.Value
  End If
  
End Sub

Private Sub dtpEnd_Change()

  On Error Resume Next
  If dtpEnd.Value < dtpDate.Value Then
     dtpDate.Value = dtpEnd.Value
  End If
  
End Sub

Private Sub Form_Load()

   On Error Resume Next
   
   GetFormSet Me, Screen
   dtpDate.Value = Date - 30
   dtpEnd.Value = Date
   
End Sub

Private Sub Form_Unload(Cancel As Integer)

   SaveFormSet Me
   
End Sub