我一直在尝试找到一种正确执行此操作的方法，但是也许有人可以引导我朝正确的方向前进，因为我花了很多时间尝试执行此操作而未成功。
我正尝试在我的游戏中心应用程序中开发一项功能，该功能允许用户根据输入/输出设置不同的报价，这是我要实现的示例：
当前我有两个报价（以美元货币为例）：
第一个报价范围：
Offer_Start_Time Offer_End_Time ------------------------------------------------
10:00:00 AM 05:00:00 PM
第二个报价范围：
超出第一个优惠的范围（例如 05:05:00 PM to 09:59:59 AM）
假设我的俱乐部中有一个Table Tennis，并且具有以下设置：
1st Offer Pricing is 5 USD
2nd Offer Pricing is 10 USD
因此，如果客户在IN到11 AM，在OUT到1:15 PM，则应用程序将向他收取5 USD
如果客户在IN到达4:40 PM，在OUT进入09:00 PM，则应用程序应将成本分为以下两个范围：
4:40 PM to 05:00 PM will cost him 5 USD
5:00 PM to 09:00 PM will cost him 10 USD
IN到11:40 PM并在OUT到02:00 AM (which is the next day)，则同样应该到目前为止，我所做的只有在1天以内范围内才能正常工作：
I first fetch the saved Offer_Start_Time and Offer_End_Time from the database then do this
If New TimeSpan(TimeOfDay.Hour, TimeOfDay.Minute, TimeOfDay.Second) >= New TimeSpan(24, 0, 0) And New TimeSpan(TimeOfDay.Hour, TimeOfDay.Minute, TimeOfDay.Second) < New TimeSpan( Offer_End_Time.Hour, Offer_End_Time.Minute, Offer_End_Time.Second) Then
Offer_Start_Time= Date.Today.AddDays(-1)
Offer_End_Time = Date.Today.AddDays(-1)
Offer_Start_Time_NextDay = Date.Today
Else
Offer_Start_Time= Date.Today
Offer_End_Time = Date.Today
Offer_Start_Time_NextDay = Date.Today.AddDays(1)
End If
Then I use below code to get the range and pricing etc..
If (INTIME >= Offer_Start_Time And OUTTIME <= Offer_End_Time And OUTTIME < Offer_Start_Time_NextDay) Then
' MsgBox("offer 1")
xTotal_1 = CalculatePrice_Time(Table_Number, INTIME, OUTTIME, PerHour_Price1,PriceType, "Price1")
ElseIf (INTIME >= Offer_Start_Time And INTIME <= Offer_End_Time And OUTTIME > Offer_End_Time And OUTTIME < Offer_Start_Time_NextDay) Then
'MsgBox("offer 1+2")
xTotal_1 = CalculatePrice_Time(Table_Number, INTIME, Offer_End_Time, PerHour_Price1,PriceType, "Price1")
'+'
xTotal_2 = CalculatePrice_Time(Table_Number, Offer_End_Time, OUTTIME, PerHour_Price2,PriceType, "Price2")
ElseIf (INTIME >= Offer_Start_Time And INTIME > Offer_End_Time And OUTTIME > Offer_End_Time And OUTTIME < Offer_Start_Time_NextDay) Then
' MsgBox("Offer 2")
xTotal_2 = CalculatePrice_Time(Table_Number, INTIME, OUTTIME, PerHour_Price2,PriceType, "Price2")
ElseIf (INTIME >= Offer_Start_Time And OUTTIME > Offer_End_Time And OUTTIME >= Offer_Start_Time_NextDay) Then
'MsgBox("Offer 2+3") '3 is the 2nd offer range which is outside 1st offer range
xTotal_1 = CalculatePrice_Time(Table_Number, INTIME, Offer_Start_Time_NextDay, PerHour_Price1,PriceType, "Price1")
'+'
xTotal_2 = CalculatePrice_Time(Table_Number, Offer_Start_Time_NextDay, OUTTIME, PerHour_Price2,PriceType, "Price2")
End If
PerHour_Price1 and PerHour_Price2 values will be fetched from the database where it has the map of Table Number and its Price1 column and Price2
PriceType variable holds "C" or "N" where C is the Custom pricing forumla using blocks 0-5,5-10...55-60, and the "N" is the Normal formula where it will multiply total used minutes with the (PerHour_Price1 or PerHour_Price2)/60
I need help with below :
- I get wrong duration and pricing when assuming customer comes
IN at 10:00 PM 20/09/2018 and goes OUT at 01:00 PM 21/09/2018 keeping in mind that I only have Time value in the Offer_Start_Time and Offer_End_Time range variable
- I want to have the flexibility of adding multiple offers on the same day instead of only two as the current setup.
for example :
Offer 1 Range 10:00 AM to 01:00 PM
Offer 2 Range 01:00 PM to 06:00 PM
Offer 3 Range 06:00 PM to 09:59 AM
I hope my issue is explained clearly
I would be thankful if anyone can help me with this or share the best way to do this as I believe my code is cumbersome and wont work for certain scenarios
EDIT (added codes):
Public Function CalculatePrice_Time(ByVal Table_Number As String, ByVal xDateTime_IN As DateTime, ByVal xDateTime_OUT As DateTime _
, ByVal Price As Double, ByVal PriceType As String, ByVal Price_DBColumn As String) As Double
Dim Result As Double = 0.0
Dim Hours_Used As Double = 0
Dim Minutes_Used As Double = 0
Dim HourToPrice As Double = 0
Dim MinutesToPrice As Double = 0
Dim Usage_Duration As TimeSpan = Calculate_Usage_Time(xDateTime_IN, xDateTime_OUT, True) 'True means return result without rounding to nearest 5 minutes
Dim Usage_Duration_Rounded As TimeSpan = Calculate_Usage_Time(xDateTime_IN, xDateTime_OUT)
Hours_Used = Usage_Duration.Hours
Minutes_Used = Usage_Duration.Minutes
If PriceType = "C" Then 'Custom pricing in blocks 0-5, 5-10 ... 55-60
MinutesToPrice = GetCustomPrice(Table_Number, "C", Minutes_Used, Price_DBColumn) '<-- this is where I fetch the pricing from database, Price_DBColumn = "Price1" will point to the database column for pricing of Offer 1, and Price2 means Offer 2
End If
HourToPrice = Hours_Used * Price
If PriceType = "C" Then
Result = HourToPrice + MinutesToPrice
ElseIf PriceType = "N" Then
Result = (Price / 60) * Usage_Duration_Rounded.TotalMinutes
End If
Return Result
End Function
GetCustomPrice() function will search the database which contains data as the example below :
Table_Number Minutes_Start Minutes_End Price1 Price2
1 0 5 0.050 0.100
1 5 10 0.100 0.150
1 10 15 0.400 0.500
. .. .. ..... .....
1 55 60 5.000 10.00
EDIT : (showing what I have done with David's sample code)
-Output Test for CalculateOverlapPrice and CalculateOverlapMinutes functions
for the Range (IN : 23/09/2018 12:00:00 AM , OUT : 23/09/2018 01:00:00 AM)
[custArrival] : 23/09/2018 12:00:00 AM
[custExit] : 23/09/2018 01:00:00 AM
[currentDateOfferStart] : 23/09/2018 10:00:00 AM
[currentDateOfferEnd] : 23/09/2018 01:00:00 PM
[offer] : 5 Timing : 10:00 AM - 01:00 PM
Used Minutes : 0
Block Price : 0
-------------------
[custArrival] : 23/09/2018 12:00:00 AM
[custExit] : 23/09/2018 01:00:00 AM
[currentDateOfferStart] : 23/09/2018 01:00:00 PM
[currentDateOfferEnd] : 23/09/2018 06:00:00 PM
[offer] : 10 Timing : 01:00 PM - 06:00 PM
Used Minutes : 0
Block Price : 0
-------------------
[custArrival] : 23/09/2018 12:00:00 AM
[custExit] : 23/09/2018 01:00:00 AM
[currentDateOfferStart] : 23/09/2018 06:00:00 PM
[currentDateOfferEnd] : 24/09/2018 10:00:00 AM
[offer] : 5 Timing : 06:00 PM - 10:00 AM
Used Minutes : 0
Block Price : 0
-------------------
Total : 0
-------------------
-Fetching Offer from database and adding them to the list :
Dim Offer_Start As Date = CDate(dRow("TablePrice_StartPeriod"))
Dim Offer_End As Date = CDate(dRow("TablePrice_EndPeriod"))
Dim Price As Double = CDbl(dRow("TablePrice_HourlyRate"))
Offer_Start = New Date(1, 1, 1, Offer_Start.Hour, Offer_Start.Minute, 0)
If Offer_Start.Hour > Offer_End.Hour Or (Offer_Start.Hour = Offer_End.Hour And Offer_Start.Minute = Offer_End.Minute) Then ' it means offer end next day
Offer_End = New Date(1, 1, 2, Offer_End.Hour, Offer_End.Minute, 0)
Else
Offer_End = New Date(1, 1, 1, Offer_End.Hour, Offer_End.Minute, 0)
End If
Dim T_Offer As New Offer(Offer_Start, Offer_End, Price)
CurrentOffers.Add(T_Offer)
New
I have updated my code to fetch offers from database to be compatible with the new split changes David provided and also tweaked it to have them sorted otherwise CurrentOffers(0).StartTime will return the wrong timing which I didn't figure out until I used the sample provided for testing.
Dim DB_Offer_Start As Date = CDate(dRow("TablePrice_StartPeriod"))
Dim DB_Offer_End As Date = CDate(dRow("TablePrice_EndPeriod"))
Dim Price As Double = CDbl(dRow("TablePrice_HourlyRate"))
Dim New_Offer_Start As Date = Nothing
Dim New_Offer_End As Date = Nothing
If DB_Offer_Start.Hour > DB_Offer_End.Hour Or (DB_Offer_Start.Hour = DB_Offer_End.Hour And DB_Offer_Start.Minute = DB_Offer_End.Minute) Then ' it means offer end next day
'================ Split offer into two ranges [Before Midnight to midnight PM to AM]
New_Offer_Start = New Date(1, 1, 1, DB_Offer_Start.Hour, DB_Offer_Start.Minute, 0)
New_Offer_End = New Date(1, 1, 2, 0, 0, 0)
CurrentOffers.Add(New Offer(New_Offer_Start, New_Offer_End, Price))
'======================================
'================ Split offer into two ranges [After Midnight to end time AM to AM/PM]
New_Offer_Start = New Date(1, 1, 1, 0, 0, 0)
New_Offer_End = New Date(1, 1, 1, DB_Offer_End.Hour, DB_Offer_End.Minute, 0)
CurrentOffers.Add(New Offer(New_Offer_Start, New_Offer_End, Price))
'======================================
Else
New_Offer_Start = New Date(1, 1, 1, DB_Offer_Start.Hour, DB_Offer_Start.Minute, 0)
New_Offer_End = New Date(1, 1, 1, DB_Offer_End.Hour, DB_Offer_End.Minute, 0)
CurrentOffers.Add(New Offer(New_Offer_Start, New_Offer_End, Price))
End If
Next
If CurrentOffers.Count > 0 Then 'Sort to had 0 or 12 AM as first
CurrentOffers.Sort(Function(x, y) x.StartTime.CompareTo(y.StartTime))
End If
Added: Test results
Offer_Start_Time and Offer_End_Time答案 0 :(得分：0)
在评论中我们进行了交流之后，我认为最好是为您提供正确计算重叠的功能-尽管我怀疑您的计算可能会对数据库中的信息进行一些调整。
下面的子内容基于与以下类定义类似的Date对象中存储的每个报价的数据
Private Class Offer
Public ReadOnly StartTime As Date
Public ReadOnly EndTime As Date
Public ReadOnly Price As Decimal
Public Sub New(tmpStartTime As Date, tmpEndTime As Date, tmpPrice As Decimal)
StartTime = tmpStartTime
EndTime = tmpEndTime
Price = tmpPrice
End Sub
End Class
如果您想使用它，当然应该使它适应您的需求。
然后我创建了一个List( Of Offer)并将其填充到我的测试代码中
Dim CurrentOffers As New List(Of Offer)
已更新 报价看起来应该类似于以下内容，但是您将午夜时分的报价分为两个报价范围，例如第二天的1800至10am，实际上应该是凌晨12点至10am，并且在这些天结束时，您应该运行报价从下午6点到第二天凌晨12点
Private Sub TestPopulateCurrentOffers()
'the dates are 1/1/1 because the date object wont allow a date of 0,0,0
Dim start1 As Date = New Date(1, 1, 1, 0, 0, 0)
Dim end1 As Date = New Date(1, 1, 1, 10, 0, 0)
Dim start2 As Date = New Date(1, 1, 1, 10, 0, 0)
Dim end2 As Date = New Date(1, 1, 1, 13, 0, 0)
Dim start3 As Date = New Date(1, 1, 1, 13, 0, 0)
Dim end3 As Date = New Date(1, 1, 1, 18, 0, 0)
Dim start4 As Date = New Date(1, 1, 1, 18, 0, 0)
Dim end4 As Date = New Date(1, 1, 2, 0, 0, 0)
CurrentOffers.Add(New Offer(start1, end1, 5))
CurrentOffers.Add(New Offer(start2, end2, 10))
CurrentOffers.Add(New Offer(start3, end3, 5))
CurrentOffers.Add(New Offer(start4, end4, 5))
End Sub
以下Sub计算客户与要约重叠的分钟数。如果到达时间在之前，而出发时间在之后，那么显然重叠当然就是该报价中的总分钟数。
重要 我假设您数据库中关于要约时间的信息以日期格式存储，而年/月/日均为1。除了要在午夜结束的要约，应该是1/1/2，因为午夜是第二天的开始。如果没有，那么您应该确保在将数据读入程序时，就像我上面所做的那样。
Private Function CalculateOverlapMinutes(daytoCheck As Date, currentoffer As Offer, custArrival As Date, custExit As Date) As Integer
Dim OverlapMinutes As Integer
Dim currentDateOfferStart As Date = currentoffer.Start.AddYears(daytoCheck.Year - 1).AddMonths(daytoCheck.Month - 1).AddDays(daytoCheck.Day - 1)
Dim currentDateOfferEnd As Date = currentoffer.End.AddYears(daytoCheck.Year - 1).AddMonths(daytoCheck.Month - 1).AddDays(daytoCheck.Day - 1)
If custArrival <= currentDateOfferEnd And custExit >= currentDateOfferStart Then 'calculate which time to use
'If customer arrival Is before the offer start time then use the offer start time,
'because the overlap of the particular offer starts at the offer start time. Otherwise
'use the customer arrival time because it is after the offer start time
'
'if the customer exits after the offer end time, then use the offer end time etc
Dim overlapStart As Date = If(custArrival < currentDateOfferStart, currentDateOfferStart, custArrival)
Dim overlapEnd As Date = If(custExit > currentDateOfferEnd, currentDateOfferEnd, custExit)
'calculate number of minutes of overlap for the offer being checked
OverlapMinutes = CInt(overlapEnd.Subtract(overlapStart).TotalMinutes)
Else
OverlapMinutes = 0
End If
Return OverlapMinutes
End Function
最后，这部分测试代码简单地遍历每个报价，比较重叠量并将每个结果加到价格上。这是一个简单的版本，您当然需要适应您的定价模型，但是您明白了。
已更新
Private Function CalculateOverlapPrice(custArrival As Date, custExit As Date) As Decimal
Dim price As Decimal
Dim Days As New List(Of Date)
Dim tmpDate As Date = custArrival.Date
Do
Days.Add(tmpDate)
tmpDate = tmpDate.AddDays(1)
Loop Until tmpDate > custExit.Date
For Each checkDay As Date In Days
For Each [offer] As Offer In CurrentOffers
price += (CalculateOverlapMinutes(checkDay, [offer], custArrival, custExit) * [offer].Price) / 60
Next
Next
Return price
End Function
希望这对您有帮助