Home  |  Programs  |  Tips & Tricks  |  Subs & Functions  |  Links  |  Laz's Liberty Basic Site

'laz's calendar for LB3.x
'free use as you wish

dim calDisplay(5,6) ' holds the current display position for each day of the month 'week,day

struct CalInfo, _  'Calendar information
    FullDate$ as ptr, _ 'month/day/year   eg: 01/01/2000  *
    M as long, _ 'user selected month *
    D as long, _ 'user selected day   *
    Y as long, _ 'user selected year  *
    IsLeapYear as long, _ '1 if selected year is a leap year 0 if not *
    DaysInMonth as long, _ 'the number of days in the selected month  *
    DayCode as long, _ 'the day code for selected day '0=Sunday; 6=Saterday *
    Day$ as ptr, _ 'The string of day code  eg: Monday  *
    FirstDayPos as long, _ 'the day code for the first day of the month for the selected year *
    Month$ as ptr, _ 'the string of the month eg: March *
    DayPosX as long, _ 'the x position on calander for the selected day
    DayPosY as long, _ 'the y position on calander for the selected day
    Week as long 'the week that the selected day is on 0-5 *



mydate$ = date$("mm/dd/yyyy")

'fill CalInfo structure
call GetCalInfo mydate$


'display calendar on screen
print
print winstring(CalInfo.Month$.struct);" ";CalInfo.Y.struct
print
print " S  M  T  W  T  F  S"
print "--------------------"

for week = 0 to 5
    for day = 0 to 6
        if calDisplay(week,day) <> 0 then
            if len(str$(calDisplay(week,day))) = 1 then print " ";
            print calDisplay(week,day);" ";
        else
            print "   ";
        end if
    next day
    print ""
next week

Print "Date = ";mydate$
wait

sub GetCalInfo Date$
    CalInfo.FullDate$.struct = Date$
    CalInfo.M.struct = val(left$(Date$,2))   'Month
    CalInfo.D.struct = val(mid$(Date$,4,2))  'Day
    CalInfo.Y.struct = val(right$(Date$,4))  'Year
    M = CalInfo.M.struct  'Month
    D = CalInfo.D.struct  'Day
    Y = CalInfo.Y.struct  'Year

    'get DayCode
    if M <= 2 then
         M2 = M+12 : Y2 = Y-1
        else
         M2 = M : Y2 = Y
        end if
    x1 = int(Y2/4)
    x2 = int(Y2/100)
    x3 = int(Y2/400)
    x4 = 2*M2+int(0.6*(M2 + 1))
    x5 = Y2+D+1
    x = x1-x2+x3+x4+x5
    CalInfo.DayCode.struct = x-int(x/7)*7

    'get the first day position
    x6 = Y2+1+1
    f = x1-x2+x3+x4+x6
    CalInfo.FirstDayPos.struct = f-int(f/7)*7

    'check for leap year
    if   (Y/4)-int(Y/4) = 0 then leap = 1
    if (Y/100)-int(Y/100) = 0 then leap = 0
    if (Y/400)-int(Y/400) = 0 then leap = 1
    CalInfo.IsLeapYear.struct = leap

    'set day string
    CalInfo.Day$.struct = Day$(CalInfo.DayCode.struct)

        select case M
    case 1
        CalInfo.Month$.struct = "January"
        CalInfo.DaysInMonth.struct = 31
    case 2
        CalInfo.Month$.struct = "February"
        CalInfo.DaysInMonth.struct = 28 : checkLeap = 1
    case 3
        CalInfo.Month$.struct = "March"
        CalInfo.DaysInMonth.struct = 31
    case 4
        CalInfo.Month$.struct = "April"
        CalInfo.DaysInMonth.struct = 30
    case 5
        CalInfo.Month$.struct = "May"
        CalInfo.DaysInMonth.struct = 31
    case 6
        CalInfo.Month$.struct = "June"
        CalInfo.DaysInMonth.struct = 30
    case 7
        CalInfo.Month$.struct = "July"
        CalInfo.DaysInMonth.struct = 31
    case 8
        CalInfo.Month$.struct = "August"
        CalInfo.DaysInMonth.struct = 31
    case 9
        CalInfo.Month$.struct = "September"
        CalInfo.DaysInMonth.struct = 30
    case 10
        CalInfo.Month$.struct = "October"
        CalInfo.DaysInMonth.struct = 31
    case 11
        CalInfo.Month$.struct = "November"
        CalInfo.DaysInMonth.struct = 30
    case 12
        CalInfo.Month$.struct = "December"
        CalInfo.DaysInMonth.struct = 31
    case else
        CalInfo.Month$.struct = "ERROR"
        CalInfo.DaysInMonth.struct = M
    end select
    if checkLeap and CalInfo.IsLeapYear.struct then CalInfo.DaysInMonth.struct = 29

     'structure the calander days into the array
     'and set the week that the selected day falls on
    FirstDayPos = CalInfo.FirstDayPos.struct
    DaysInMonth = CalInfo.DaysInMonth.struct
    DaySelected = CalInfo.D.struct
    currentDay=1
    week = 0
    While currentDay < DaysInMonth+1
       calDisplay(week,FirstDayPos) = currentDay
       FirstDayPos = FirstDayPos + 1
       if DaySelected = currentDay then CalInfo.Week.struct = week
       if FirstDayPos = 7 then FirstDayPos = 0 : week = week + 1
       currentDay = currentDay + 1
       wend

    'set x and y pos for selected day
    CalInfo.DayPosX.struct = CalInfo.DayCode.struct
    CalInfo.DayPosY.struct = CalInfo.Week.struct

    end sub

function Day$(day)
    select case day
    case 0
        Day$ = "Sunday"
    case 1
        Day$ = "Monday"
    case 2
        Day$ = "Tuesday"
    case 3
        Day$ = "Wednesday"
    case 4
        Day$ = "Thursday"
    case 5
        Day$ = "Friday"
    case 6
        Day$ = "Saturday"
    case else
        Day$ = "ERROR"
    end select
    end function