Showing Leap Year VB6

[Andy1723]

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

Option Explicit
Dim dayName(0 To 6), monDays(0 To 11) As String
Private Sub cmdQuit_Click()
    End
End Sub
Private Sub Form_Load()
    dayName(0) = "Sunday"   'init day table
    dayName(1) = "Monday"
    dayName(2) = "Tuesday"
    dayName(3) = "Wednesday"
    dayName(4) = "Thursday"
    dayName(5) = "Friday"
    dayName(6) = "Saturday"
    
    monDays(0) = 31
    monDays(1) = 4
    monDays(2) = 31
    monDays(3) = 30
    monDays(4) = 31
    monDays(5) = 30
    monDays(6) = 31
    monDays(7) = 31
    monDays(8) = 30
    monDays(9) = 31
    monDays(10) = 30
    monDays(11) = 31
End Sub
Function dateName(dd, mm, ByVal yy As Integer)
Dim d, c, m, y As Integer
    m = mm - 2  'oct = 8, Nov = 9 etc
    If m < 1 Then
        m = m + 12
        yy = yy - 1 'of previous year
    End If
    y = yy Mod 100
    c = (yy - y) \ 100 'Get century
    'Now for Zeller's congruence .... 'add 700 in case -ve
    '   cast (convert) single values to integer
    d = (Int(2.6 * m - 0.2) + dd + y + Int(y \ 4) + Int(c \ 4) - (2 * c) + 700) Mod 7
    dateName = dayName(d)
End Function
Function isLeapYear(year As Integer)
Dim year As Boolean
    If (year Mod 4 = 0 And year Mod 100 <> 0) Or year Mod 400 = 0 Then
        Print "yes"
    Else
        Print "no"
    End If
End Function
Function showLeapYear(ByVal year As Integer)
    If isLeapYear = True Then
        lblLeap = "Yes"
    Else
        lblLeap = "No"
    End If
End Function
 
Private Sub txtYear_KeyPress(KeyAscii As Integer)
Dim day, mon, year, leapYearShow As Integer
Dim dayStr As String
    If KeyAscii = 13 Then
        day = Val(cboDay.Text)
        mon = cboMonth.ListIndex + 1
        year = Val(txtYear)
        dayStr = dateName(day, mon, year)
        lblOutput = dayStr
        Call showLeapYear(year)
    End If
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

[dglienna]

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

Option Explicit
 
Private Sub Form_Load()
  MsgBox WeekdayName(Weekday(Now))
End Sub

[Andy1723]

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.

[Mark Gambo]

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

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

WeekDayName(WeekDay("12/11/2005"), False) = Sunday
WeekDayName(3, False) = Tuesday
WeekDayName(3, True) = Tue

monDays(0) = 31
    monDays(1) = 4
    monDays(2) = 31
    monDays(3) = 30
    monDays(4) = 31
    monDays(5) = 30
    monDays(6) = 31
    monDays(7) = 31
    monDays(8) = 30
    monDays(9) = 31
    monDays(10) = 30
    monDays(11) = 31

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

Function GetMonthDays(MonthToCheck As Date) As Integer
    GetMonthDays = Day((DateAdd("m", 1, Format(MonthToCheck, "mm/yyyy"))) - 1)
End Function

. . . and you call it like this:

MsgBox GetMonthDays("02/23/2004")

Take a look at this post

[Andy1723]

That is what my form looks like.

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

x

[dglienna]

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

Option Explicit
 
Private Sub Form_Load()
  Dim s As Date, m As Integer, x As Date, mm As String
  s = CDate("2/1/2004")
  mm = Format(s, "MMMM, yyyy")
  s = DateSerial(Year(s), Month(s) + 1, 1)
  x = DateAdd("d", -1, s)
  MsgBox Day(x) & " days in " & mm
End Sub

[dglienna]

And, this gets the Julian Date-Time

Option Explicit
 
 
 
Private Sub Form_Load()
 
    MsgBox CalcJDate(#10/9/1995 12:00:00 PM#)
    'MsgBox CalcJDate(Date)
    Unload Me
End Sub
 
 
Private Function CalcJDate(ByVal nDateTime As Date) As Double
 
    Dim mm As Double
    Dim dd As Double
    Dim yy As Double
    Dim hr As Double
    Dim mn As Double
    Dim gg As Double
    Dim s As Double
    Dim jd As Double
    Dim a As Double
    Dim j1 As Double
        mm = Month(nDateTime)
    dd = Day(nDateTime)
    yy = Year(nDateTime)
    
    hr = Hour(nDateTime)
    mn = Minute(nDateTime)
    
    hr = hr + (mn / 60)
    gg = 1
    If yy < 1585 Then
        gg = 0
    End If
    jd = -1 * ((7 * ((mm + 9) / 12) + yy) / 4)
    s = 1
    If (mm - 9) < 0 Then
        s = -1
    End If
    a = Abs(mm - 9)
    j1 = (yy + s * (a / 7))
    j1 = -1 * (((j1 / 100) + 1) * 3 / 4)
    jd = jd + (275 * mm / 9) + dd + (gg * j1)
    jd = jd + 1721027 + 2 * gg + 367 * yy - 0.5
    jd = jd + (hr / 24)
    
    CalcJDate = jd
    
End Function

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

[Andy1723]

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

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

Function isLeapYear(year As Integer)
Dim year As Boolean
    If (year Mod 4 = 0 And year Mod 100 <> 0) Or year Mod 400 = 0 Then
        isLeapYear = True
    Else
        isLeapYear = False
    End If
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

Function showLeapYear(ByVal year As Integer)
    If isLeapYear = True Then
        lblLeap = "Yes"
    Else
        lblLeap = "No"
    End If
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

[Andy1723]

And, this gets the Julian Date-Time

Option Explicit
 
 
 
Private Sub Form_Load()
 
    MsgBox CalcJDate(#10/9/1995 12:00:00 PM#)
    'MsgBox CalcJDate(Date)
    Unload Me
End Sub
 
 
Private Function CalcJDate(ByVal nDateTime As Date) As Double
 
    Dim mm As Double
    Dim dd As Double
    Dim yy As Double
    Dim hr As Double
    Dim mn As Double
    Dim gg As Double
    Dim s As Double
    Dim jd As Double
    Dim a As Double
    Dim j1 As Double
        mm = Month(nDateTime)
    dd = Day(nDateTime)
    yy = Year(nDateTime)
    
    hr = Hour(nDateTime)
    mn = Minute(nDateTime)
    
    hr = hr + (mn / 60)
    gg = 1
    If yy < 1585 Then
        gg = 0
    End If
    jd = -1 * ((7 * ((mm + 9) / 12) + yy) / 4)
    s = 1
    If (mm - 9) < 0 Then
        s = -1
    End If
    a = Abs(mm - 9)
    j1 = (yy + s * (a / 7))
    j1 = -1 * (((j1 / 100) + 1) * 3 / 4)
    jd = jd + (275 * mm / 9) + dd + (gg * j1)
    jd = jd + 1721027 + 2 * gg + 367 * yy - 0.5
    jd = jd + (hr / 24)
    
    CalcJDate = jd
    
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

[dglienna]

Take this line out, for just the day

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

[Andy1723]

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

[dglienna]

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

Option Explicit
 
Private Sub Form_Load()
  Dim dt1 As Date, dt2 As Date
  dt1 = CDate("12/31/2003") ' American Date
  dt2 = DateSerial(Year(dt1), 1, 1)
  MsgBox Year(dt1) & "/" & DateDiff("d", dt2, dt1) + 1
End Sub

[eranfox]

Hello Andy1723,
How about just using this?

if Day(DateSerial(someYearHere, 2, 29)) = 29 then
'this is a leap year
else
'this is'nt a leap year
end if

Best Regards,
ERAN

[Hack]

'To Convert A Date To A Julian Date
Private Sub ConvertDateToJulian(MyDate As String)
Dim JYear As Integer
Dim JDate As String
JYear = Right(MyDate, 1)
JDate = Right(MyDate, 1) + Format(DateDiff("y", "01-Jan-" & JYear, MyDate) + 1, "0##")
MsgBox JDate
End Sub
 
Private Sub Command1_Click()
ConvertDateToJulian Text1.Text
End Sub

Private Function IsThisALeapYear(ByVal ThisYear As Integer) As Boolean
'this little one liner determines if the current year is a leap year
     IsThisALeapYear = (29 = Day(DateSerial(ThisYear, 2, 29)))
End Function
 
'to use this, use the following code
 
Private Sub Command1_Click()
Dim MyYear As Variant
Dim x As Integer
 
MyYear = Year(Now)
 
x = IsThisALeapYear(MyYear)
If x = True Then
   MsgBox "This is a leap year"
Else
   MsgBox "This is not a leap year"
End If
 
End Sub