?? modfocus.bas
字號:
Attribute VB_Name = "modFocus"
'******SQL服務器變量
Public IsSqlDat As Boolean '是否為SQL
Public SQLServer As String
Public SQLUser As String
Public SQLPWD As String
'********************************窗體變量**********************
Public SitesFocus As Boolean '位置
Public NewBookFocus As Boolean '預訂
Public BrowserBookFocus As Boolean '查詢
Public MemberFocus As Boolean '會員管理
Public BaseFocus As Boolean '基本配置
Public IntegrationFocus As Boolean '酒席配置
Public SystemConfigFile As String '配置文件路徑
Public MenuFocus As Boolean '菜單管理
Public CustFocus As Boolean '上臺
Public OtherFocus As Boolean '其它配置時
Public TodayCashFocus As Boolean '今日消費
Public ArrearageFocus As Boolean '掛帳管理
Public WasteBookFocus As Boolean '流水帳
Public HZSiteFocus As Boolean '按座位匯總
Public HZNameFocus As Boolean '按名稱匯總
Public EmployFocus As Boolean '員工管理
Public OperatorFocus As Boolean '操作員管理
Public IsShare As Boolean '是否為共享版
'************************************ ****************
Public XLeft As Long '打印左邊距
Public XTop As Long '打印右邊距
Public xSmallLeft As Long 'POS打印左與頂
Public xSmallTop As Long
Public sCompanyTel As String '公司電話
Public sCompanyAdd As String '公司地址
Public nPrintLine As Integer '打印的行數
'************************************ ****************
Public AccessFile As String '數據庫變量
Public Constr As String '連接字符串
Public sFindString As String '共公搜索串
Public sGuestID As String '公共會員ID
Public sGuestName As String '公共會員名稱
Public cGuestRemain As Currency '公共會員金額
Public sGuestTel As String '公共會員聯系電話
Public MakeFind As Boolean '是否查詢
'*********************************** 菜單變量 *****************
Public sPubSite As String '共享餐位
Public sMenuName As String '菜單名稱
Public sMenuID As String '菜單編號
Public sPubType As String '共享的菜單類型
Public cRate As Currency '會員打折率
Public sInfoSite As String '座位編號
Public IsAutorun As Integer '自動運行
Public sInfo As String '顯示消息
Public IsChangeIT As Boolean '已經改變時
Public strSearch As String
Public Logined As Boolean '是否登錄成功
Public StrPathId As String
Public StrProId As String
Public strType As String
Public strRecName As String
Public strValue As String
Public AllowDZ As Boolean '允許打折
Public DeletePre As Boolean '刪除預訂內容,在落單后
Public sTmpWaiter As String '服務員全局變量
'掛帳結帳時的付款方法
Public sArrearagePaymethod As String
Public sContact As String '聯系人
Public sWeb As String '網址
'時間段變量---------------------------------------------------
Public Lunch1 As Integer '中午
Public Lunch2 As Integer '中午
Public Supper1 As Integer '中午
Public Supper2 As Integer '中午
Public Night1 As Integer '中午
Public NIght2 As Integer '中午
'自動刪除過期預訂內容=========================================CheckRun函數使用
Public AtCheckRun As Boolean '正在進行Check
Public curDatePart As Integer '已經檢查的時間段
'給出數據庫路徑
Public Sub GetAccessFile(sAF As String)
On Error GoTo GetERR
Dim sFTmp As String
sFTmp = App.Path
If Right(sFTmp, 1) <> "\" Then
sFTmp = sFTmp & "\"
End If
'首次運行沒有指定時,給出缺省路徑
If Trim(sAF) = "" Then
AccessFile = sFTmp & "systemdata.mdb"
Exit Sub
End If
'給出缺省路徑
If Dir(sAF, vbArchive) = "" Then
AccessFile = sFTmp & "systemdata.mdb"
MsgBox "系統的Systemdata.mdb數據庫配置不正確,請在基本配置中修改。 " _
& vbCrLf & "然后重新啟動餐飲收銀管理系統。 " _
& vbCrLf & "系統目前使用本地安裝缺省數據庫。 ", vbExclamation
End If
Exit Sub
GetERR:
MsgBox "對不起,不能給出Systemdata.mdb數據庫文件。 " _
& vbCrLf & "重新啟動餐飲收銀管理系統。 ", vbCritical
End Sub
'設置記帳狀態
Public Function SetCashOut(stmpSite As String, iStatus As Integer) As Boolean
On Error GoTo SetErr
Dim sDB As Connection
Dim sTMp As String
Set sDB = CreateObject("ADODB.Connection")
sDB.Open Constr
sTMp = "Update SiteType Set SiteStatus=" & iStatus & " Where Class='" & stmpSite & "'"
sDB.Execute sTMp
sDB.Close
Set sDB = Nothing
SetCashOut = True
Exit Function
SetErr:
MsgBox "不能設置當前座位狀態為 3 :" & Err.Description, vbInformation
SetCashOut = False
End Function
'更新單據號碼
Public Function UpdateNo(sType As String)
On Error GoTo UpdateNOErr
Dim DBF As Connection
Dim EFF As Recordset
Set DBF = CreateObject("ADODB.Connection")
DBF.Open Constr
Set EFF = CreateObject("ADODB.Recordset")
If IsSqlDat = True Then
EFF.Open "Select * from tbdSheel Where SheelDate='" & Date & "' and SheelType='" & sType & "'", DBF, adOpenStatic, adLockOptimistic, adCmdText
Else
EFF.Open "Select * from tbdSheel Where SheelDate=#" & Date & "# and SheelType='" & sType & "'", DBF, adOpenStatic, adLockOptimistic, adCmdText
End If
If Not (EFF.EOF And EFF.BOF) Then
EFF.Fields("SheelNO") = EFF.Fields("SheelNO") + 1
EFF.Update
Else
EFF.AddNew
EFF.Fields("SheelDate") = Date
EFF.Fields("SheelType") = sType
EFF.Fields("SheelNO") = 1
EFF.Update
End If
EFF.Close
Set EFF = Nothing
DBF.Close
Set DBF = Nothing
Exit Function
UpdateNOErr:
MsgBox " 更新單號錯誤:" & Err.Description, vbCritical
Exit Function
End Function
'給出目前單號
Public Function GetNo(sType As String)
On Error GoTo UpdateNOErr:
Dim DFF As Connection
Dim EFF As Recordset
Dim nNO As Long
Dim sYear As String, sMonth As String, sDate As String, sNO As String
Set DFF = CreateObject("ADODB.Connection")
DFF.Open Constr
Set EFF = CreateObject("ADODB.Recordset")
If IsSqlDat = True Then
EFF.Open "Select * from tbdSheel Where SheelDate='" & Date & "' and SheelType='" & sType & "'", DFF, adOpenStatic, adLockReadOnly, adCmdText
Else
EFF.Open "Select * from tbdSheel Where SheelDate=#" & Date & "# and SheelType='" & sType & "'", DFF, adOpenStatic, adLockReadOnly, adCmdText
End If
If Not (EFF.EOF And EFF.BOF) Then
nNO = EFF.Fields("SheelNO") + 1
Else
nNO = 1
End If
EFF.Close
Set EFF = Nothing
DFF.Close
Set DFF = Nothing
'Year,Month,Date
sYear = Year(Date)
sMonth = Month(Date)
sDate = Day(Date)
'一位的月份時
If Len(sMonth) = 1 Then
sMonth = "0" & sMonth
End If
'一位、二位、三位的日時
sDate = "0" & sDate
End If
sNO = Trim(CStr(nNO))
GetNo = sYear + sMonth + sDate + sNO
Exit Function
UpdateNOErr:
MsgBox "給出單號錯誤:" & Err.Description, vbCritical
GetNo = str(Date)
End Function
'給出預訂ID
Public Function GetBookID(sBookString As String)
GetBookID = Mid(sBookString, 2, Len(sBookString) - 1)
End Function
Public Sub ViewBook(sBookID As String)
If sBookID = "" Then
MsgBox "預訂單號為空,不能查看單據。 ", vbInformation
Exit Sub
End If
frmviewBook.tmpID = sBookID
frmviewBook.Show 1
End Sub
'取消預訂
Public Function CancelBook(sBookID As String) As Boolean
On Error GoTo CancelERR
If MsgBox("真的取消該預訂內容嗎? " & vbCrLf _
& "取消后將不能恢復,是否同意。 ", vbInformation + vbYesNo) = vbNo Then
CancelBook = False
Exit Function
End If
Dim CDB As Connection
Dim sDel As String
Set CDB = CreateObject("ADODB.Connection")
CDB.Open Constr
CDB.BeginTrans
sDel = "Delete from tbdBook Where ID='" & sBookID & "'"
CDB.Execute sDel
Dim tmplHour, tmpDatePart As Integer
tmplHour = Hour(Time)
If tmplHour >= Lunch1 And tmplHour < Lunch2 Then '中午
tmpDatePart = 1
ElseIf tmplHour >= Supper1 And tmplHour < Supper2 Then '下午
tmpDatePart = 2
ElseIf tmplHour >= Night1 And tmplHour < NIght2 Then '晚上
tmpDatePart = 3
Else
tmpDatePart = 1
End If
'1、清除所有預訂臺狀態
sDel = "Update SiteType Set SiteStatus=0 Where SiteStatus=1"
CDB.Execute sDel
If IsSqlDat = True Then
sDel = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate='" & Date & "' And DatePart=" & tmpDatePart & ") And SiteStatus<2"
Else
sDel = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate=#" & Date & "# And DatePart=" & tmpDatePart & ") And SiteStatus<2"
End If
'2、設置當前時間段的預訂
CDB.Execute sDel
CDB.CommitTrans
CDB.Close
Set CDB = Nothing
CancelBook = True
Exit Function
CancelERR:
CancelBook = False
MsgBox "對不起,取消預訂錯誤? ", vbCritical
End Function
'通過座位給出預訂的編號
Public Function GetID(tmpS As String) As String
On Error GoTo CancelERR
Dim CDB As Connection
Dim CRs As Recordset
Dim sDel As String
Set CDB = CreateObject("ADODB.Connection")
Set CRs = CreateObject("ADODB.Recordset")
CDB.Open Constr
Dim tmplHour, tmpDatePart As Integer
tmplHour = Hour(Time)
If tmplHour >= Lunch1 And tmplHour < Lunch2 Then '中午
tmpDatePart = 1
ElseIf tmplHour >= Supper1 And tmplHour < Supper2 Then '下午
tmpDatePart = 2
ElseIf tmplHour >= Night1 And tmplHour < NIght2 Then '晚上
tmpDatePart = 3
Else
tmpDatePart = 1
End If
If IsSqlDat = True Then
sDel = "Select * from tbdBook Where Class='" & tmpS & "' And ExpireDate='" & Date & "' And DatePart=" & tmpDatePart
Else
sDel = "Select * from tbdBook Where Class='" & tmpS & "' And ExpireDate=#" & Date & "# And DatePart=" & tmpDatePart
End If
CRs.Open sDel, CDB, adOpenStatic, adLockReadOnly, adCmdText
If Not (CRs.EOF And CRs.BOF) Then
GetID = CRs("ID")
Else
GetID = ""
End If
CDB.Close
Set CDB = Nothing
Exit Function
CancelERR:
GetID = ""
MsgBox "對不起,給出預訂ID錯誤? " & Err.Description, vbCritical
End Function
'設置餐桌為維護狀態
Public Function Maintenans(stmpSiteID As String) As Boolean
On Error GoTo CancelERR
If MsgBox("真的設置該座位為維修狀態嗎? " & vbCrLf _
& "維修狀態時不能預訂,也不能上臺。", vbInformation + vbYesNo) = vbNo Then
Maintenans = False
Exit Function
End If
Dim CDB As Connection
Dim sDel As String
Set CDB = CreateObject("ADODB.Connection")
CDB.Open Constr
CDB.BeginTrans
sDel = "Update SiteType Set SiteStatus=4 Where Class='" & stmpSiteID & "'"
CDB.Execute sDel
CDB.CommitTrans
CDB.Close
Set CDB = Nothing
Maintenans = True
Exit Function
CancelERR:
Maintenans = False
MsgBox "設置為維修狀態錯誤?" & Err.Description, vbCritical
End Function
'恢復餐桌狀態
Public Function CancelMaintenans(stmpSiteID As String) As Boolean
On Error GoTo CancelERR
If MsgBox("真的恢復該座位為正常狀態嗎? " & vbCrLf _
& "恢復后,該臺可以預訂、上臺。", vbInformation + vbYesNo) = vbNo Then
CancelMaintenans = False
Exit Function
End If
Dim CDB As Connection
Dim sDel As String
Set CDB = CreateObject("ADODB.Connection")
CDB.Open Constr
CDB.BeginTrans
sDel = "Update SiteType Set SiteStatus=0 Where Class='" & stmpSiteID & "'"
CDB.Execute sDel
'檢索是否有預訂
Dim tmplHour, tmpDatePart As Integer
tmplHour = Hour(Time)
If tmplHour >= Lunch1 And tmplHour < Lunch2 Then '中午
tmpDatePart = 1
ElseIf tmplHour >= Supper1 And tmplHour < Supper2 Then '下午
tmpDatePart = 2
ElseIf tmplHour >= Night1 And tmplHour < NIght2 Then '晚上
tmpDatePart = 3
Else
tmpDatePart = 1
End If
If IsSqlDat = True Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -