none
Rouding Time vb6 to vb.net RRS feed

  • Question

  • I found this function to round time on Microsoft.com

    ? dhRoundTime(#12:32:15#, 5)
    returns 12:30:00 PM

    ? dhRoundTime(#12:32:35#, 5)
    returns 12:35:00 PM

    could you please help me to convert it to a vb.net?

    Function dhRoundTime(dtmTime As Date, intInterval As Integer) As Date
            ' Round the time value in varTime to the nearest minute
            ' interval in intInterval
            Dim intTime As Integer
            Dim sglTime As Single
            Dim intHour As Integer
            Dim intMinute As Integer
            Dim lngdate As Long
            ' Get the date portion of the date/time value
            lngdate = DateValue(dtmTime)
            ' Get the time portion as a number like 11.5 for 11:30.
            sglTime = TimeValue(dtmTime) * 24
            ' Get the hour and store it away. Int truncates,
            ' CInt rounds, so use Int.
            intHour = Int(sglTime)
            ' Get the number of minutes, and then round to the nearest
            ' occurrence of the interval specified.
            intMinute = CInt((sglTime - intHour) * 60)
            intMinute = CInt(intMinute / intInterval) * intInterval
            ' Build back up the original date/time value,
            ' rounded to the nearest interval.
            dhRoundTime = CDate(lngdate + ((intHour + intMinute / 60) / 24))
        End Function

    thank you all,

    John

    Tuesday, July 4, 2017 7:36 PM

Answers

  • Here's my take; quickly done so YMMV.

    Public Class Form1
        Public Function RoundMinute(dtValue As DateTime, intMinute As Integer) As DateTime
            Dim intSeconds As Integer = dtValue.Minute * 60 + dtValue.Second
            Dim intDivider As Integer = intMinute * 60
            Dim intResultMinutes As Integer = (intSeconds + (intDivider / 2)) - ((intSeconds + (intDivider / 2)) Mod intDivider)
    
            Return New DateTime(dtValue.Year, dtValue.Month, dtValue.Day, dtValue.Hour, intResultMinutes / 60, 0)
        End Function
    
        Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
            MsgBox(RoundMinute(CDate("06/19/2017 12:32:15 PM"), 5))
            MsgBox(RoundMinute(CDate("06/19/2017 12:32:35 PM"), 5))
        End Sub
    End Class



    • Edited by B.Kennedy Tuesday, July 4, 2017 10:04 PM Add code block
    • Marked as answer by Bre-x Thursday, July 6, 2017 12:40 AM
    Tuesday, July 4, 2017 10:01 PM

All replies

  • John,

    This needs to be refactored (and I've not fully tested it) but for a starting point, try this and let me know please?

    Option Strict On
    Option Explicit On
    Option Infer Off
    
    
    
    Public Class Form1
        Private Sub Form1_Load(sender As System.Object, _
                               e As System.EventArgs) _
                               Handles MyBase.Load
    
            Dim test As Date = GetRoundedDateTime(Now, 5)
    
            Stop
    
        End Sub
    
    
    
        Private Function _
            GetRoundedDateTime(ByVal basisDT As DateTime, _
                               ByVal minutesToRoundTo As Integer) As DateTime
    
            If minutesToRoundTo > 0 AndAlso minutesToRoundTo < 60 Then
                Dim minutesList As New List(Of Integer)
    
                For i As Integer = 0 To 60 Step minutesToRoundTo
                    minutesList.Add(i)
                Next
    
                Dim mList As New List(Of Minutes)
    
                For Each i As Integer In minutesList
                    mList.Add(New Minutes _
                              With {.Value = i, _
                                    .Diff = Math.Abs(i - basisDT.Minute)})
                Next
    
                Dim closestMinute As Integer = _
                    ((From m As Minutes In mList _
                      Order By m.Diff).First).Value
    
                Return New DateTime(basisDT.Year, basisDT.Month, _
                                    basisDT.Day, basisDT.Hour, _
                                    closestMinute, 0)
    
            End If
    
        End Function
    
    
    
        Private Class Minutes
            Public Property Value As Integer
            Public Property Diff As Integer
        End Class
    End Class


    "A problem well stated is a problem half solved.” - Charles F. Kettering

    Tuesday, July 4, 2017 9:17 PM
  • Hi Charles,

    Thank you for answering my post.

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:35 PM"), 5)

    It  returns 06/19/2017 12:30:00 PM

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:15 PM"), 5)

    It returns again 06/19/2017 12:30:00 PM

    I think is not taking in consideration the seconds

    John

    Tuesday, July 4, 2017 9:34 PM
  • Hi Charles,

    Thank you for answering my post.

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:35 PM"), 5)

    It  returns 06/19/2017 12:30:00 PM

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:15 PM"), 5)

    It returns again 06/19/2017 12:30:00 PM

    I think is not taking in consideration the seconds

    John

    I'm Frank. ;-)

    *****

    I told it not to. Do you want it to or do you maybe want it to be an option?

    The way that I see it, if you want the DateTime rounded then the seconds should be zero, but it's entirely up to you.


    "A problem well stated is a problem half solved.” - Charles F. Kettering

    Tuesday, July 4, 2017 9:37 PM
  • Hi Charles,

    Thank you for answering my post.

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:35 PM"), 5)

    It  returns 06/19/2017 12:30:00 PM

    if I enter Dim test As Date = GetRoundedDateTime(CDate("06/19/2017 12:32:15 PM"), 5)

    It returns again 06/19/2017 12:30:00 PM

    I think is not taking in consideration the seconds

    John

    Modified:

    Option Strict On
    Option Explicit On
    Option Infer Off
    
    
    
    Public Class Form1
        Private Sub Form1_Load(sender As System.Object, _
                               e As System.EventArgs) _
                               Handles MyBase.Load
    
            Dim test As Date = GetRoundedDateTime(Now, 5)
    
            Stop
    
        End Sub
    
    
    
        Private Function _
            GetRoundedDateTime(ByVal basisDT As DateTime, _
                               ByVal minutesToRoundTo As Integer, _
                               Optional ByVal useZeroSeconds As Boolean = False) As DateTime
    
            If minutesToRoundTo > 0 AndAlso minutesToRoundTo < 60 Then
                Dim minutesList As New List(Of Integer)
    
                For i As Integer = 0 To 60 Step minutesToRoundTo
                    minutesList.Add(i)
                Next
    
                Dim mList As New List(Of Minutes)
    
                For Each i As Integer In minutesList
                    mList.Add(New Minutes _
                              With {.Value = i, _
                                    .Diff = Math.Abs(i - basisDT.Minute)})
                Next
    
                Dim closestMinute As Integer = _
                    ((From m As Minutes In mList _
                      Order By m.Diff).First).Value
    
                If useZeroSeconds Then
                    Return New  _
                        DateTime(basisDT.Year, basisDT.Month, _
                                 basisDT.Day, basisDT.Hour, _
                                 closestMinute, 0)
                Else
                    Return New  _
                        DateTime(basisDT.Year, basisDT.Month, _
                                 basisDT.Day, basisDT.Hour, _
                                 closestMinute, basisDT.Second)
                End If
            End If
    
        End Function
    
    
    
        Private Class Minutes
            Public Property Value As Integer
            Public Property Diff As Integer
        End Class
    End Class


    "A problem well stated is a problem half solved.” - Charles F. Kettering

    Tuesday, July 4, 2017 9:39 PM
  • Hi

    Here is my take on it. A Function that might do what you want - maybe not.

    Option Strict On
    Option Explicit On
    Public Class Form1

        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            Dim testtime1 As DateTime = CDate(Now.Date & " 12:32:15")
            Dim testtime2 As DateTime = CDate(Now.Date & " 12:32:35")

            ' round down testtime1 - returns with time of 12:30:00
            Dim result1 As DateTime = RoundTime(testtime1, 5)

            ' round up testtime2 - return with time of 12:35:00
            Dim result2 As DateTime = RoundTime(testtime2, 5)
        End Sub

        Function RoundTime(t As DateTime, mins As Integer) As DateTime
            Dim s As Integer = t.Minute * 60 + t.Second
            Dim s2 As Integer = s Mod mins * 60
            Select Case s2
                Case <= mins * 60 \ 2
                    Return t.AddSeconds(-s2)
                Case Else
                    Return t.AddSeconds(mins * 60 - s2)
            End Select
        End Function
    End Class


    Regards Les, Livingston, Scotland


    • Edited by leshay Thursday, July 6, 2017 1:37 AM Added compiler Options
    Tuesday, July 4, 2017 9:44 PM
  • Here's my take; quickly done so YMMV.

    Public Class Form1
        Public Function RoundMinute(dtValue As DateTime, intMinute As Integer) As DateTime
            Dim intSeconds As Integer = dtValue.Minute * 60 + dtValue.Second
            Dim intDivider As Integer = intMinute * 60
            Dim intResultMinutes As Integer = (intSeconds + (intDivider / 2)) - ((intSeconds + (intDivider / 2)) Mod intDivider)
    
            Return New DateTime(dtValue.Year, dtValue.Month, dtValue.Day, dtValue.Hour, intResultMinutes / 60, 0)
        End Function
    
        Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
            MsgBox(RoundMinute(CDate("06/19/2017 12:32:15 PM"), 5))
            MsgBox(RoundMinute(CDate("06/19/2017 12:32:35 PM"), 5))
        End Sub
    End Class



    • Edited by B.Kennedy Tuesday, July 4, 2017 10:04 PM Add code block
    • Marked as answer by Bre-x Thursday, July 6, 2017 12:40 AM
    Tuesday, July 4, 2017 10:01 PM
  • Found and corrected an error that happens at the top of the hour.

    Replace the function with the following please:

        Private Function _
            GetRoundedDateTime(ByVal basisDT As DateTime, _
                               ByVal minutesToRoundTo As Integer, _
                               Optional ByVal useZeroSeconds As Boolean = False) As DateTime

            If minutesToRoundTo > 0 AndAlso minutesToRoundTo < 60 Then
                Dim minutesList As New List(Of Integer)

                For i As Integer = 0 To 60 Step minutesToRoundTo
                    minutesList.Add(i)
                Next

                Dim mList As New List(Of Minutes)

                For Each i As Integer In minutesList
                    mList.Add(New Minutes _
                              With {.Value = i, _
                                    .Diff = Math.Abs(i - basisDT.Minute)})
                Next

                Dim closestMinute As Integer = _
                    ((From m As Minutes In mList _
                      Order By m.Diff).First).Value

                If closestMinute = 60 Then
                    If useZeroSeconds Then
                        Return New DateTime(basisDT.Year, basisDT.Month, _
                                           basisDT.Day, basisDT.Hour + 1, _
                                           0, 0)
                    Else
                        Return New DateTime(basisDT.Year, basisDT.Month, _
                                            basisDT.Day, basisDT.Hour + 1, _
                                            0, basisDT.Second)
                    End If
                Else
                    If useZeroSeconds Then
                        Return New  _
                            DateTime(basisDT.Year, basisDT.Month, _
                                     basisDT.Day, basisDT.Hour, _
                                     closestMinute, 0)
                    Else
                        Return New  _
                            DateTime(basisDT.Year, basisDT.Month, _
                                     basisDT.Day, basisDT.Hour, _
                                     closestMinute, basisDT.Second)
                    End If
                End If
            End If

        End Function


    "A problem well stated is a problem half solved.” - Charles F. Kettering


    • Edited by Frank L. Smith Tuesday, July 4, 2017 10:20 PM ...oversight in the code
    Tuesday, July 4, 2017 10:02 PM
  • Try this function too:

    Function dhRoundTime(dtmTime As DateTime, intInterval As Integer) As DateTime
       Dim minutes As Integer = CInt(dtmTime.TimeOfDay.TotalMinutes / intInterval) * intInterval
       Return dtmTime.Date + TimeSpan.FromMinutes(minutes)
    End Function


    • Edited by Viorel_MVP Wednesday, July 5, 2017 5:19 AM
    Wednesday, July 5, 2017 5:18 AM
  • Thank you all for answering my post.

    All entries were very helpful and I learned a few things here :)

    A co-worker created this function, works great!!!

        Public Function tc_round_time(dtValue As DateTime, intMinute As Integer) As String
            Dim intSeconds As Integer = dtValue.Minute * 60 + dtValue.Second
            Dim intDivider As Integer = intMinute * 60
            Dim intResultMinutes As Integer = (intSeconds + (intDivider / 2)) - ((intSeconds + (intDivider / 2)) Mod intDivider)

            'Return my_time
            Return New DateTime(dtValue.Year, dtValue.Month, dtValue.Day, dtValue.Hour, intResultMinutes / 60, 0)
        End Function

    John



    • Edited by Bre-x Thursday, July 6, 2017 12:43 AM
    Thursday, July 6, 2017 12:37 AM
  • Thank you all for answering my post.

    All entries were very helpful and I learned a few things here :)

    A co-worker created this function, works great!!!

        Public Function tc_round_time(dtValue As DateTime, intMinute As Integer) As String
            Dim intSeconds As Integer = dtValue.Minute * 60 + dtValue.Second
            Dim intDivider As Integer = intMinute * 60
            Dim intResultMinutes As Integer = (intSeconds + (intDivider / 2)) - ((intSeconds + (intDivider / 2)) Mod intDivider)

            'Return my_time
            Return New DateTime(dtValue.Year, dtValue.Month, dtValue.Day, dtValue.Hour, intResultMinutes / 60, 0)
        End Function

    John



    Does it work great in this case: ‘Dim result = tc_round_time(#06/19/2017 12:58:00 PM#, 5)’?

    Thursday, July 6, 2017 4:20 AM
  • Thank you all for answering my post.

    All entries were very helpful and I learned a few things here :)

    A co-worker created this function, works great!!!

        Public Function tc_round_time(dtValue As DateTime, intMinute As Integer) As String
            Dim intSeconds As Integer = dtValue.Minute * 60 + dtValue.Second
            Dim intDivider As Integer = intMinute * 60
            Dim intResultMinutes As Integer = (intSeconds + (intDivider / 2)) - ((intSeconds + (intDivider / 2)) Mod intDivider)

            'Return my_time
            Return New DateTime(dtValue.Year, dtValue.Month, dtValue.Day, dtValue.Hour, intResultMinutes / 60, 0)
        End Function

    John



    Does it work great in this case: ‘Dim result = tc_round_time(#06/19/2017 12:58:00 PM#, 5)’?

          No it does not, thank you for noticing/testing.

         john


    • Edited by Bre-x Friday, July 7, 2017 12:30 AM
    Friday, July 7, 2017 12:29 AM