2004-03-09 19:57

     DECLARE SUB NextMonth
     DECLARE SUB PrevMonth
     DECLARE SUB FillMonth(Month AS INTEGER, Year AS INTEGER)
     DECLARE SUB InitFillMonth
     DECLARE SUB DaysCalculation

     DECLARE FUNCTION DaysValue(TheDate AS STRING) AS SINGLE
     DECLARE FUNCTION DayOfWeek(TheDate AS STRING) AS INTEGER
     DECLARE FUNCTION DaysBetween(FutDate AS STRING, PrevDate AS STRING) AS SINGLE
     DECLARE FUNCTION WorkDaysBetween(FutDate AS STRING, PrevDate AS STRING) AS SINGLE
     DECLARE FUNCTION DaysOfMonth(TheMonth AS INTEGER, TheYear AS INTEGER) AS INTEGER

     FUNCTION DaysValue(TheDate AS STRING) AS SINGLE
'åéóáãùãÞ ðáñáìÝôñùí
      year=VAL(RIGHT$(TheDate,4))
      IF MID$(TheDate,2,1)="-" THEN
       month=VAL(LEFT$(TheDate,1))
       IF MID$(TheDate,4,1)="-" THEN day=VAL(MID$(TheDate,3,1)) ELSE day=VAL(MID$(TheDate,3,2))
      ELSE
       month=VAL(LEFT$(TheDate,2))
       IF MID$(TheDate,5,1)="-" THEN day=VAL(MID$(TheDate,4,1)) ELSE day=VAL(MID$(TheDate,4,2))
      END IF
'Ýëåã÷ïò ëáèþí
      IF year<1901 THEN GOTO erlabel:
      IF month>12 THEN GOTO erlabel:
      IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31 THEN GOTO erlabel:
      IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30 THEN GOTO erlabel:
      IF (month=2 AND (year-1901) MOD 4=3) AND day>29 THEN GOTO erlabel:
      IF (month=2 AND (year-1901) MOD 4<>3) AND day>28 THEN GOTO erlabel:
'õðïëïãéóìüò
      c=0
      DIM mc(11)
      c=c+(year-1901)*365
      c=c+(year-1901)\4
      mc(0)=0
      mc(1)=31
      IF (year-1901) MOD 4=3 THEN mc(2)=29 ELSE mc(2)=28
      mc(3)=31
      mc(4)=30
      mc(5)=31
      mc(6)=30
      mc(7)=31
      mc(8)=31
      mc(9)=30
      mc(10)=31
      mc(11)=30
      FOR i=0 TO (month-1)
       c=c+mc(i)
      NEXT i
      c=c+day
      DaysValue=c
      GOTO endlabel:
erlabel:
      DaysValue=0
endlabel:
     END FUNCTION

     FUNCTION DayOfWeek(TheDate AS STRING) AS INTEGER
      c= DaysValue(TheDate) MOD 7
      DayOfWeek = c+1
' 1 is Monday
     END FUNCTION

     FUNCTION DaysBetween(FutDate AS STRING, PrevDate AS STRING) AS SINGLE
' not including prevdate
      c=DaysValue(FutDate)-DaysValue(PrevDate)
      IF c>0 THEN DaysBetween=c ELSE DaysBetween=0
     END FUNCTION

     FUNCTION WorkDaysBetween(FutDate AS STRING, PrevDate AS STRING) AS SINGLE
      c=DaysValue(FutDate)-DaysValue(PrevDate)
      i=c\7
      j=c MOD 7
      w=DayOfWeek(PrevDate AS STRING)+1
      s=0
      FOR k=1 TO j
       IF w<6 THEN s=s+1
       w=w+1
       IF w=8 THEN w=1
      NEXT k
      IF c>0 THEN WorkDaysBetween=i*5+s ELSE WorkDaysBetween=0
     END FUNCTION

     FUNCTION DaysOfMonth(TheMonth AS INTEGER,TheYear AS INTEGER) AS INTEGER
      DIM mc(12)
      mc(0)=0
      mc(1)=31
      IF (TheYear-1901) MOD 4=3 THEN mc(2)=29 ELSE mc(2)=28
      mc(3)=31
      mc(4)=30
      mc(5)=31
      mc(6)=30
      mc(7)=31
      mc(8)=31
      mc(9)=30
      mc(10)=31
      mc(11)=30
      mc(12)=31
      DaysOfMonth=mc(TheMonth)
     END FUNCTION

' Copy and paste into your program

     DIM myFont12b AS QFONT
     myFont12b.Name = "Courier New"
     myFont12b.Size = 12
     myFont12b.AddStyles(fsBold)

     CREATE CalendarForm AS QFORM
      CAPTION = "Calendar"
      Width = 280
      Height = 300
      Center
      CREATE MonthLabel AS QLABEL
       Top=10
       Left=90
       font=myfont12b
      END CREATE
      CREATE YearLabel AS QLABEL
       Top=10
       Left=130
       font=myfont12b
      END CREATE
      CREATE EnterDateLabel AS QLABEL
       left=20
       top=200
       CAPTION="Enter a Date (mm-dd-yyyy)"
      END CREATE
      CREATE DaysBetweenLabel AS QLABEL
       left=150
       top=225
      END CREATE
      CREATE WorkDaysBetweenLabel AS QLABEL
       left=150
       top=250
      END CREATE
      CREATE CalendarDate AS QEDIT
       left=150
       top=195
       width=100
       text=DATE$
      END CREATE
      CREATE CalendarGrid AS QSTRINGGRID
       BorderStyle = 0
       Left = 20
       Top = 30
       Width = 230
       Height=140
       ColCount = 7
       RowCount = 7
       DefaultColWidth = 32
       DefaultRowHeight = 16
       FixedCols = 0
       cell(0,0)="Mon"
       cell(1,0)="Tue"
       cell(2,0)="Wed"
       cell(3,0)="Thu"
       cell(4,0)="Fri"
       cell(5,0)="Sat"
       cell(6,0)="Sun"
      END CREATE
      CREATE TodayButton AS QBUTTON
       Left = 50
       Top = 155
       Width = 170
       CAPTION = "Today is: "+DATE$
       OnClick = InitFillMonth
      END CREATE
      CREATE NextMonthButton AS QBUTTON
       Left = 220
       Top = 155
       Width = 30
       CAPTION = ">"
       OnClick = NextMonth
      END CREATE
      CREATE PrevMonthButton AS QBUTTON
       Left = 20
       Top = 155
       Width = 30
       CAPTION = "<"
       OnClick = PrevMonth
      END CREATE
      CREATE DaysCalcButton AS QBUTTON
       Left = 20
       Top = 235
       Width = 100
       CAPTION = "&Days Until Then ..."
       OnClick = DaysCalculation
      END CREATE
     END CREATE

'Insert your initialization code here
     CALL InitFillMonth

     SUB FillMonth(Month AS INTEGER, Year AS INTEGER)
      FOR i1=0 TO 6
       FOR j1=1 TO 6
        CalendarGrid.cell(i1,j1)=""
       NEXT j1
      NEXT i1
      ct=DaysOfMonth(Month,Year)
      dat$=STR$(Month)+"-1-"+STR$(Year)
      i=DayOfWeek(dat$)
      j=1
      FOR k=1 TO ct
       CalendarGrid.cell(i-1,j)=STR$(k)
       i=i+1
       IF i=8 THEN
        i=1
        j=j+1
       END IF
      NEXT k
     END SUB

     SUB InitFillMonth
'åéóáãùãÞ ðáñáìÝôñùí
      year=VAL(RIGHT$(DATE$,4))
      IF MID$(DATE$,2,1)="-" THEN
       month=VAL(LEFT$(DATE$,1))
      ELSE
       month=VAL(LEFT$(DATE$,2))
      END IF
      CALL FillMonth(month,year)
      MonthLabel.CAPTION=STR$(month)
      YearLabel.CAPTION=STR$(year)
     END SUB

     SUB NextMonth
      m=VAL(MonthLabel.CAPTION)
      y=VAL(YearLabel.CAPTION)
      m=m+1
      IF m=13 THEN
       m=1
       y=y+1
      END IF
      MonthLabel.CAPTION=STR$(m)
      YearLabel.CAPTION=STR$(y)
      CALL FillMonth(m,y)
     END SUB

     SUB PrevMonth
      m=VAL(MonthLabel.CAPTION)
      y=VAL(YearLabel.CAPTION)
      m=m-1
      IF m=0 THEN
       m=12
       y=y-1
      END IF
      MonthLabel.CAPTION=STR$(m)
      YearLabel.CAPTION=STR$(y)
      CALL FillMonth(m,y)
     END SUB

     SUB DaysCalculation
      a=daysbetween(CalendarDate.text, DATE$)
      b=workdaysbetween(CalendarDate.text, DATE$)
      daysbetweenlabel.CAPTION=STR$(a)+" Calendar Days"
      workdaysbetweenlabel.CAPTION=STR$(b)+" Work Days"
     END SUB

     CalendarForm.SHOWMODAL

2004-03-09 19:57