Showing Leap Year VB6-VBForums
Results 1 to 14 of 14

Thread: Showing Leap Year VB6

  1. #1

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Showing Leap Year VB6

    I need to show the Leap year in visual basic, as well as calculate the Julian Date. I've got stuck on getting the results from the funtion into the label (my output component) I was just wondering if anyone could point me in the right direction

    VB Code:
    1. Option Explicit
    2. Dim dayName(0 To 6), monDays(0 To 11) As String
    3. Private Sub cmdQuit_Click()
    4.     End
    5. End Sub
    6. Private Sub Form_Load()
    7.     dayName(0) = "Sunday"   'init day table
    8.     dayName(1) = "Monday"
    9.     dayName(2) = "Tuesday"
    10.     dayName(3) = "Wednesday"
    11.     dayName(4) = "Thursday"
    12.     dayName(5) = "Friday"
    13.     dayName(6) = "Saturday"
    14.    
    15.     monDays(0) = 31
    16.     monDays(1) = 4
    17.     monDays(2) = 31
    18.     monDays(3) = 30
    19.     monDays(4) = 31
    20.     monDays(5) = 30
    21.     monDays(6) = 31
    22.     monDays(7) = 31
    23.     monDays(8) = 30
    24.     monDays(9) = 31
    25.     monDays(10) = 30
    26.     monDays(11) = 31
    27. End Sub
    28. Function dateName(dd, mm, ByVal yy As Integer)
    29. Dim d, c, m, y As Integer
    30.     m = mm - 2  'oct = 8, Nov = 9 etc
    31.     If m < 1 Then
    32.         m = m + 12
    33.         yy = yy - 1 'of previous year
    34.     End If
    35.     y = yy Mod 100
    36.     c = (yy - y) \ 100 'Get century
    37.     'Now for Zeller's congruence .... 'add 700 in case -ve
    38.     '   cast (convert) single values to integer
    39.     d = (Int(2.6 * m - 0.2) + dd + y + Int(y \ 4) + Int(c \ 4) - (2 * c) + 700) Mod 7
    40.     dateName = dayName(d)
    41. End Function
    42. Function isLeapYear(year As Integer)
    43. Dim year As Boolean
    44.     If (year Mod 4 = 0 And year Mod 100 <> 0) Or year Mod 400 = 0 Then
    45.         Print "yes"
    46.     Else
    47.         Print "no"
    48.     End If
    49. End Function
    50. Function showLeapYear(ByVal year As Integer)
    51.     If isLeapYear = True Then
    52.         lblLeap = "Yes"
    53.     Else
    54.         lblLeap = "No"
    55.     End If
    56. End Function
    57.  
    58. Private Sub txtYear_KeyPress(KeyAscii As Integer)
    59. Dim day, mon, year, leapYearShow As Integer
    60. Dim dayStr As String
    61.     If KeyAscii = 13 Then
    62.         day = Val(cboDay.Text)
    63.         mon = cboMonth.ListIndex + 1
    64.         year = Val(txtYear)
    65.         dayStr = dateName(day, mon, year)
    66.         lblOutput = dayStr
    67.         Call showLeapYear(year)
    68.     End If
    69. End Sub

    February has the Value "4" because I need to get the leap year validation script working before i can work out the number of days in february.

    Thank you.
    x

  2. #2
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: Showing Leap Year VB6

    Vb has these functions built in for Weekdaynames (and numbers)

    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.   MsgBox WeekdayName(Weekday(Now))
    5. End Sub

  3. #3

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Re: Showing Leap Year VB6

    and how would i intergrate that into my code?

    I'm a totally newbie to Visual Basic, i'm trying to piece together how to get the hang of this.

  4. #4
    Giants World Champs!!!! Mark Gambo's Avatar
    Join Date
    Sep 2003
    Location
    Colorado
    Posts
    2,965

    Re: Showing Leap Year VB6

    VB Code:
    1. dayName(0) = "Sunday"   'init day table
    2.     dayName(1) = "Monday"
    3.     dayName(2) = "Tuesday"
    4.     dayName(3) = "Wednesday"
    5.     dayName(4) = "Thursday"
    6.     dayName(5) = "Friday"
    7.     dayName(6) = "Saturday"

    Instead of using an array why not use the WeekDayName Function like this:

    VB Code:
    1. WeekDayName(WeekDay("12/11/2005"), False) = Sunday
    2. WeekDayName(3, False) = Tuesday
    3. WeekDayName(3, True) = Tue

    VB Code:
    1. monDays(0) = 31
    2.     monDays(1) = 4
    3.     monDays(2) = 31
    4.     monDays(3) = 30
    5.     monDays(4) = 31
    6.     monDays(5) = 30
    7.     monDays(6) = 31
    8.     monDays(7) = 31
    9.     monDays(8) = 30
    10.     monDays(9) = 31
    11.     monDays(10) = 30
    12.     monDays(11) = 31

    and instead of creating an array for the number of days in a month you can try this function:

    VB Code:
    1. Function GetMonthDays(MonthToCheck As Date) As Integer
    2.     GetMonthDays = Day((DateAdd("m", 1, Format(MonthToCheck, "mm/yyyy"))) - 1)
    3. End Function

    . . . and you call it like this:

    VB Code:
    1. MsgBox GetMonthDays("02/23/2004")

    Take a look at this post
    Regards,

    Mark

    Please remember to rate posts! Rate any post you find helpful. Use the link to the left - "Rate this Post". Please use [highlight='vb'] your code goes in here [/highlight] tags when posting code. When a question you asked has been resolved, please go to the top of the original post and click "Thread Tools" then select "Mark Thread Resolved."


  5. #5

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Re: Showing Leap Year VB6



    That is what my form looks like.

    Does the days of the month function take leap years into account?

    x

  6. #6
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: Showing Leap Year VB6

    Try this code, it is similar to the last post:

    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.   Dim s As Date, m As Integer, x As Date, mm As String
    5.   s = CDate("2/1/2004")
    6.   mm = Format(s, "MMMM, yyyy")
    7.   s = DateSerial(Year(s), Month(s) + 1, 1)
    8.   x = DateAdd("d", -1, s)
    9.   MsgBox Day(x) & " days in " & mm
    10. End Sub

  7. #7
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: Showing Leap Year VB6

    And, this gets the Julian Date-Time

    VB Code:
    1. Option Explicit
    2.  
    3.  
    4.  
    5. Private Sub Form_Load()
    6.  
    7.     MsgBox CalcJDate(#10/9/1995 12:00:00 PM#)
    8.     'MsgBox CalcJDate(Date)
    9.     Unload Me
    10. End Sub
    11.  
    12.  
    13. Private Function CalcJDate(ByVal nDateTime As Date) As Double
    14.  
    15.     Dim mm As Double
    16.     Dim dd As Double
    17.     Dim yy As Double
    18.     Dim hr As Double
    19.     Dim mn As Double
    20.     Dim gg As Double
    21.     Dim s As Double
    22.     Dim jd As Double
    23.     Dim a As Double
    24.     Dim j1 As Double
    25.         mm = Month(nDateTime)
    26.     dd = Day(nDateTime)
    27.     yy = Year(nDateTime)
    28.    
    29.     hr = Hour(nDateTime)
    30.     mn = Minute(nDateTime)
    31.    
    32.     hr = hr + (mn / 60)
    33.     gg = 1
    34.     If yy < 1585 Then
    35.         gg = 0
    36.     End If
    37.     jd = -1 * ((7 * ((mm + 9) / 12) + yy) / 4)
    38.     s = 1
    39.     If (mm - 9) < 0 Then
    40.         s = -1
    41.     End If
    42.     a = Abs(mm - 9)
    43.     j1 = (yy + s * (a / 7))
    44.     j1 = -1 * (((j1 / 100) + 1) * 3 / 4)
    45.     jd = jd + (275 * mm / 9) + dd + (gg * j1)
    46.     jd = jd + 1721027 + 2 * gg + 367 * yy - 0.5
    47.     jd = jd + (hr / 24)
    48.    
    49.     CalcJDate = jd
    50.    
    51. End Function

    Why not use the Date-Time Picker to let the user select a date?

  8. #8

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Re: Showing Leap Year VB6

    I'm not quite sure I understand these functions! :S

    What I want to do is get the data from this function

    VB Code:
    1. Function isLeapYear(year As Integer)
    2. Dim year As Boolean
    3.     If (year Mod 4 = 0 And year Mod 100 <> 0) Or year Mod 400 = 0 Then
    4.         isLeapYear = True
    5.     Else
    6.         isLeapYear = False
    7.     End If
    8. End Function

    and use its result (that if the year is equally divisable by 4 and not by 100 or 400) to set a label to yes or no, I have this function to try and do this

    VB Code:
    1. Function showLeapYear(ByVal year As Integer)
    2.     If isLeapYear = True Then
    3.         lblLeap = "Yes"
    4.     Else
    5.         lblLeap = "No"
    6.     End If
    7. End Function

    I'm trying to keep to the fairly simple functions of Visual Basic as this is all I know how to use.
    Thanks.
    x

  9. #9

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Re: Showing Leap Year VB6

    Quote Originally Posted by dglienna
    And, this gets the Julian Date-Time

    VB Code:
    1. Option Explicit
    2.  
    3.  
    4.  
    5. Private Sub Form_Load()
    6.  
    7.     MsgBox CalcJDate(#10/9/1995 12:00:00 PM#)
    8.     'MsgBox CalcJDate(Date)
    9.     Unload Me
    10. End Sub
    11.  
    12.  
    13. Private Function CalcJDate(ByVal nDateTime As Date) As Double
    14.  
    15.     Dim mm As Double
    16.     Dim dd As Double
    17.     Dim yy As Double
    18.     Dim hr As Double
    19.     Dim mn As Double
    20.     Dim gg As Double
    21.     Dim s As Double
    22.     Dim jd As Double
    23.     Dim a As Double
    24.     Dim j1 As Double
    25.         mm = Month(nDateTime)
    26.     dd = Day(nDateTime)
    27.     yy = Year(nDateTime)
    28.    
    29.     hr = Hour(nDateTime)
    30.     mn = Minute(nDateTime)
    31.    
    32.     hr = hr + (mn / 60)
    33.     gg = 1
    34.     If yy < 1585 Then
    35.         gg = 0
    36.     End If
    37.     jd = -1 * ((7 * ((mm + 9) / 12) + yy) / 4)
    38.     s = 1
    39.     If (mm - 9) < 0 Then
    40.         s = -1
    41.     End If
    42.     a = Abs(mm - 9)
    43.     j1 = (yy + s * (a / 7))
    44.     j1 = -1 * (((j1 / 100) + 1) * 3 / 4)
    45.     jd = jd + (275 * mm / 9) + dd + (gg * j1)
    46.     jd = jd + 1721027 + 2 * gg + 367 * yy - 0.5
    47.     jd = jd + (hr / 24)
    48.    
    49.     CalcJDate = jd
    50.    
    51. End Function

    Why not use the Date-Time Picker to let the user select a date?
    Thanks that codes great! but I have to output the Julian date in a "wrong" format, i.e

    31/12/2003 to julian is 2003/365

    01/03/1999 to julian is 1992/366

  10. #10
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: Showing Leap Year VB6

    Take this line out, for just the day
    VB Code:
    1. jd = jd + (hr / 24)
    ' adds fraction of day

    I don't see how you are getting the second one, though. 1/3/92 is jd 3

  11. #11

    Thread Starter
    Member
    Join Date
    Dec 2005
    Posts
    33

    Re: Showing Leap Year VB6

    This is what my task specification says

    Give the Julian Date where the day and month are replaced by an integer the value of the number of days into the year....

    examples

    31/12/2003 2003/365
    31/13/1992 1992/366
    01/03/1999 1999/60

  12. #12
    Banned dglienna's Avatar
    Join Date
    Jun 2004
    Location
    Center of it all
    Posts
    17,901

    Re: Showing Leap Year VB6

    This should get the difference between 1/1 and the date

    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.   Dim dt1 As Date, dt2 As Date
    5.   dt1 = CDate("12/31/2003") ' American Date
    6.   dt2 = DateSerial(Year(dt1), 1, 1)
    7.   MsgBox Year(dt1) & "/" & DateDiff("d", dt2, dt1) + 1
    8. End Sub

  13. #13
    Hyperactive Member eranfox's Avatar
    Join Date
    May 2001
    Posts
    492

    Re: Showing Leap Year VB6

    Hello Andy1723,
    How about just using this?
    VB Code:
    1. if Day(DateSerial(someYearHere, 2, 29)) = 29 then
    2. 'this is a leap year
    3. else
    4. 'this is'nt a leap year
    5. end if

    Best Regards,
    ERAN
    Eran Fox
    ASSEMBLER,C,C++,VB6,SQL...

  14. #14
    Super Moderator Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,335

    Re: Showing Leap Year VB6

    VB Code:
    1. 'To Convert A Date To A Julian Date
    2. Private Sub ConvertDateToJulian(MyDate As String)
    3. Dim JYear As Integer
    4. Dim JDate As String
    5. JYear = Right(MyDate, 1)
    6. JDate = Right(MyDate, 1) + Format(DateDiff("y", "01-Jan-" & JYear, MyDate) + 1, "0##")
    7. MsgBox JDate
    8. End Sub
    9.  
    10. Private Sub Command1_Click()
    11. ConvertDateToJulian Text1.Text
    12. End Sub
    VB Code:
    1. Private Function IsThisALeapYear(ByVal ThisYear As Integer) As Boolean
    2. 'this little one liner determines if the current year is a leap year
    3.      IsThisALeapYear = (29 = Day(DateSerial(ThisYear, 2, 29)))
    4. End Function
    5.  
    6. 'to use this, use the following code
    7.  
    8. Private Sub Command1_Click()
    9. Dim MyYear As Variant
    10. Dim x As Integer
    11.  
    12. MyYear = Year(Now)
    13.  
    14. x = IsThisALeapYear(MyYear)
    15. If x = True Then
    16.    MsgBox "This is a leap year"
    17. Else
    18.    MsgBox "This is not a leap year"
    19. End If
    20.  
    21. End Sub
    Please use [Code]your code goes in here[/Code] tags when posting code.
    When you have received an answer to your question, please mark it as resolved using the Thread Tools menu.
    Before posting your question, did you look here?
    Got a question on Linux? Visit our Linux sister site.
    I dont answer coding questions via PM or EMail. Please post a thread in the appropriate forum section.

    Creating A Wizard In VB.NET
    Paging A Recordset
    What is wrong with using On Error Resume Next
    Good Article: Language Enhancements In Visual Basic 2010
    Upgrading VB6 Code To VB.NET
    Microsoft MVP 2005/2006/2007/2008/2009/2010/2011/2012/Defrocked

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.