mdlthis.bas

一个简单的快餐店收银软件

Attribute VB_Name = "mdlThis"
'Public gStock As String '当前仓库

Public Const gStock = "000" '总仓库
Public Const gSupplier = "0000" '初始化供应商
Public gFirstCode As String '原值

Public EditDate As String '全局的修改日期跟时间
Public EditTime As String

Public Function GetCode(sCode As String) As String
If InStr(Trim(sCode), " ") > 0 Then
    GetCode = Mid(Trim(sCode), 1, InStr(Trim(sCode), " ") - 1)
Else
    GetCode = Trim(sCode)
End If
End Function

Public Function GetGoodsPrice(sCode As String, sSupplier As String) As String
    Dim rsTemp As New ADODB.Recordset
    sCode = Trim(sCode)
    sSQL = "select * from TotalPrice"
    sSQL = sSQL & " where TotalPrice.gSupplierCode='" & sSupplier & "'"
    sSQL = sSQL & " and TotalPrice.gCode='" & Trim(sCode) & "'"
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Conn.Execute(sSQL)
    If Not rsTemp.EOF Then
        GetGoodsPrice = rsTemp.Fields("gCurrentPrice") & ""
    Else
        GetGoodsPrice = "0.0000"
    End If
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Nothing
End Function

Public Function GetGoodsPriceMin(sCode As String) As String
    Dim rsTemp As New ADODB.Recordset
    sCode = Trim(sCode)
    sSQL = "select Min(TotalPrice.gCurrentPrice) AS gCurrentPrice from TotalPrice"
    sSQL = sSQL & " where TotalPrice.gCode='" & Trim(sCode) & "' and TotalPrice.gCurrentPrice<>'0.0000'"
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Conn.Execute(sSQL)
    If Not rsTemp.EOF Then
        GetGoodsPriceMin = rsTemp.Fields("gCurrentPrice") & ""
    Else
        GetGoodsPriceMin = "0.0000"
    End If
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Nothing
End Function

Public Function GetUserDeptCode(sUser As String) As String
    Dim rsTemp As New ADODB.Recordset
    sUser = Trim(sUser)
    sSQL = "select * from UserInfo where uCode='" & Trim(sUser) & "'"
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Conn.Execute(sSQL)
    If Not rsTemp.EOF Then
        GetUserDeptCode = rsTemp.Fields("uDeptCode") & ""
    End If
    If rsTemp.State <> 0 Then rsTemp.Close
    Set rsTemp = Nothing
End Function

Public Function WriteLog(sName As String, sSourceValue As String, sDestinationValue As String, sResult As String)

End Function

Public Function GetBillTotal(mshf As MSHFlexGrid, lbNum As Label, lbMoney As Label)
Dim intCir As Integer
Dim iNum As Integer
Dim iMon As Integer

Dim Totalnum As Variant
Dim Totalqua As Variant
Totalnum = 0
Totalqua = 0
With mshf
     For intCir = 1 To .Cols - 1
        If .TextMatrix(0, intCir) = "数量" Then
            iNum = intCir
        End If
        If .TextMatrix(0, intCir) = "金额" Then
            iMon = intCir
        End If

     Next intCir
     '********************************
     '汇总数量金额
     '********************************
     For intCir = 1 To .Rows - 1
         Totalnum = Totalnum + Val(.TextMatrix(intCir, iNum))
         Totalqua = Totalqua + Val(.TextMatrix(intCir, iMon))
     Next
     If Totalnum > 0 Then
       lbNum = Totalnum
     Else
       lbNum = "0"
     End If
      If Totalqua > 0 Then
       lbMoney = Format(Round(Totalqua, 4), "0.00")
     Else
       lbMoney = "0.00"
     End If
     
End With

End Function

Public Function GotTimeTotal(sStartDate As String, sEndDate As String)
Dim sWeeks As String
Dim sTime As String
Dim sTimeZone As String
Dim iNum As Integer
sSQL = "SELECT Bill.bDate, Bill.bTime, BillSub.bGoodsCode, BillSub.bGoodsNumber"
sSQL = sSQL & " FROM Bill INNER JOIN BillSub ON Bill.bBillNo = BillSub.bBillNo"
sSQL = sSQL & " WHERE (((Bill.bState)='已结帐')"
sSQL = sSQL & " AND ((Bill.bDate)>='" & Format(sStartDate, "yyyy-MM-dd") & "')"
sSQL = sSQL & " AND ((Bill.bDate)<='" & Format(sEndDate, "yyyy-MM-dd") & "'))"
If Rs.State <> 0 Then Rs.Close
Rs.CursorLocation = adUseClient
Set Rs = Conn.Execute(sSQL)
sSQL = "UPDATE QueryTimeMoney SET QueryTimeMoney.星期日 = '0', QueryTimeMoney.星期一 = '0', QueryTimeMoney.星期二 = '0', QueryTimeMoney.星期三 = '0', QueryTimeMoney.星期四 = '0', QueryTimeMoney.星期五 = '0', QueryTimeMoney.星期六 = '0'"
Conn.Execute sSQL
Do While Not Rs.EOF
    '转换成星期
    sWeeks = WeekdayName(Weekday(Rs.Fields("bDate")))
    'sTime = Format(TimeValue(Rs.Fields("bTime")), "hh:mm")
    sTime = Rs.Fields("bTime")

    If sTime >= "6:00" And sTime < "7:00" Then
        sTimeZone = "6:00"
    End If
    If sTime >= "7:00" And sTime < "8:00" Then
        sTimeZone = "7:00"
    End If
    If sTime >= "8:00" And sTime < "9:00" Then
        sTimeZone = "8:00"
    End If
    If sTime >= "9:00" And sTime < "10:00" Then
        sTimeZone = "9:00"
    End If
    If sTime >= "10:00" And sTime < "11:00" Then
        sTimeZone = "10:00"
    End If
    If sTime >= "11:00" And sTime < "12:00" Then
        sTimeZone = "11:00"
    End If
    If sTime >= "12:00" And sTime < "13:00" Then
        sTimeZone = "12:00"
    End If
    If sTime >= "13:00" And sTime < "14:00" Then
        sTimeZone = "13:00"
    End If
    If sTime >= "14:00" And sTime < "15:00" Then
        sTimeZone = "14:00"
    End If
    If sTime >= "15:00" And sTime < "16:00" Then
        sTimeZone = "15:00"
    End If
    If sTime >= "16:00" And sTime < "17:00" Then
        sTimeZone = "16:00"
    End If
    If sTime >= "17:00" And sTime < "18:00" Then
        sTimeZone = "17:00"
    End If
    If sTime >= "18:00" And sTime < "19:00" Then
        sTimeZone = "18:00"
    End If
    If sTime >= "19:00" And sTime < "20:00" Then
        sTimeZone = "19:00"
    End If
    If sTime >= "20:00" And sTime < "21:00" Then
        sTimeZone = "20:00"
    End If
    If sTime >= "21:00" And sTime < "22:00" Then
        sTimeZone = "21:00"
    End If
    If sTime >= "22:00" And sTime < "23:00" Then
        sTimeZone = "22:00"
    End If
    If sTime >= "23:00" And sTime < "00:00" Then
        sTimeZone = "23:00"
    End If
    If sTime >= "00:00" And sTime < "01:00" Then
        sTimeZone = "00:00"
    End If
    sSQL = "SELECT * "
    sSQL = sSQL & " FROM QueryTimeMoney"
    sSQL = sSQL & " where TimeZone='" & sTimeZone & "'"
    If Rss.State <> 0 Then Rss.Close
    Rss.CursorLocation = adUseClient
    Set Rss = Conn.Execute(sSQL)
    iNum = Val(Rss.Fields(sWeeks)) + Val(Rs.Fields("bGoodsNumber"))
    sSQL = "UPDATE QueryTimeMoney SET "
    sSQL = sSQL & sWeeks & "='" & Trim(Str(iNum)) & "'"
    sSQL = sSQL & " where TimeZone='" & sTimeZone & "'"
    Conn.Execute sSQL
    Rs.MoveNext
Loop
End Function