Number of weeks in a month.

hag99 · Jan 17, 2007

I need to create a calendar that lists the number of weeks in the months of the year. Some have 5 some have 4. So click on 2007 and it will display number of weeks for each month. Click on 2008 and it will dispaly number of weeks in each month etc etc. Any code or ideas will be very helpful.

rob444 · Jan 17, 2007

Only 1 month has 4 weeks during non-leap years.
February.
Every other month has more than 4 weeks but never a full 5 weeks.
Just write a program to "catch" the leapyear and give february 5 weeks in that year too.

Rob.

GriffMG · Jan 17, 2007

Hag,

Can you be a bit more specific?

Do you mean you want to know the number of lines (i.e. weeks) that would be shown on a calendar for a given month?

Code:

        Dec 2006
   S  M  T  W  T  F  S
1                  1  2
2   3  4  5  6  7  8  9
3  10 11 12 13 14 15 16
4  17 18 19 20 21 22 23
5  24 25 26 27 28 29 20
6  31

        Jan 2007
   S  M  T  W  T  F  S
1      1  2  3  4  5  6
2   7  8  9 10 11 12 13 
3  14 15 16 17 18 19 20
4  21 22 23 24 25 26 27
5  28 29 30 31
6

From the examples above you can see there might even be six in some cases!

B-)

Regards

Griff
Keep [Smile]ing

GriffMG · Jan 18, 2007

I don't know if this will help, but you are completely welcome to use it - it's code that I wrote in the early 90's and still use today (amazingly!)

Code:

SET EPOCH TO 1980
SET DATE BRITISH
SET CENTURY ON
pop_calendar()

PROCEDURE POP_CALENDR
PRIVATE OLDSCRN,MNTH,MYR,NMNTH,NYR,LMNTH,LYR
SAVE SCREEN TO OLDSCRN
DROP_TITLE("Calendar")
MNTH = MONTH(DATE())
MYR  = YEAR(DATE())
NMNTH = MONTH(DATE())
NYR  = YEAR(DATE())
** work out last month...
LMNTH = MNTH -1
IF LMNTH < 1
   LMNTH = 12
   LYR = MYR - 1
ELSE
   LYR = MYR
ENDIF
SHOW_CALNDR(LMNTH,LYR,4,7)
SHOW_CALNDR(MNTH ,MYR,4,28)
** work out the next month...
NMNTH = NMNTH +1
IF NMNTH > 12
   NMNTH = 1
   NYR = NYR + 1
ELSE
   NYR = NYR
ENDIF
SHOW_CALNDR(NMNTH,NYR,4,49)
** work out the next month...
NMNTH = NMNTH +1
IF NMNTH > 12
   NMNTH = 1
   NYR = NYR + 1
ELSE
   NYR = NYR
ENDIF
SHOW_CALNDR(NMNTH,NYR,12,7)
** work out the next month...
NMNTH = NMNTH +1
IF NMNTH > 12
   NMNTH = 1
   NYR = NYR + 1
ELSE
   NYR = NYR
ENDIF
SHOW_CALNDR(NMNTH,NYR,12,28)
** work out the next month...
NMNTH = NMNTH +1
IF NMNTH > 12
   NMNTH = 1
   NYR = NYR + 1
ELSE
   NYR = NYR
ENDIF
SHOW_CALNDR(NMNTH,NYR,12,49)
E_MSG(" Waiting")
RESTORE SCREEN FROM OLDSCRN
RETURN
*!*****************************************************************************
*!
*!       Function: SHOW_CALNDR()
*!
*!      Called by: POP_CALENDR        (procedure in ACCOUNTS.PRG)
*!
*!          Calls: DROP_BOX()         (function  in GENPROC.PRG)
*!               : STRMNTH()          (function  in ACCOUNTS.PRG)
*!
*!*****************************************************************************
FUNCTION SHOW_CALNDR
** function to show the calendar for a given month and year...
** month and year passed as parameters, along with top,left co-ords
PARAMETER MNTH,MYR,WROW,WCOL
** private vars to hold temp data
PRIVATE MNTH,MYR,LINE,X,COL,THEMNTH,WROW,WCOL,OLDCOLOR
LINE = 2
** set the color
OLDCOLOR = SETCOLOR("W/B")
** paint a box
DROP_BOX(WROW,WCOL+1,WROW+6,WCOL+20)
@ WROW,WCOL+1 CLEAR TO WROW+6,WCOL+20
** put up the sunday-sat marks
@ WROW+1,WCOL+2  SAY "S  M  T  W  T  F  S"
SETCOLOR("W+/B")
@ WROW+0,WCOL+2  SAY STRMNTH(MNTH)+STR(MYR,4)+" "
** up to 31 days in any month
FOR X = 1 TO 31
   ** create a string representation for the date in the month...
   THEMNTH = CTOD(STR(X,2)+"/"+STR(MNTH)+"/"+STR(MYR))
   ** this will be empty for 30 of Feb etc!
   IF .NOT. EMPTY(THEMNTH)
      ** if it isn't the must be an OK day...!
      COL = DOW(THEMNTH)
      DO CASE
            ** if it's today...
         CASE DATE() = THEMNTH
            ** highlight it...
            SETCOLOR("W+/B")
         CASE COL = 1 .OR. COL = 7
            ** if it's sat/sun the lo-lite it
            SETCOLOR("GR+/B")
         OTHERWISE
            ** or leave it alone
            SETCOLOR("W/B")
      ENDCASE
      ** say the day number...
      @ WROW+LINE,((COL-1)*3)+1+WCOL SAY STR(X,2)
      ** increment the positions...
      IF COL = 7
         ** looking out for the end of the month/line
         LINE = LINE +1
         IF LINE > 6
            LINE = 2
         ENDIF
      ENDIF
   ELSE
      X = 32
   ENDIF
NEXT
SETCOLOR(OLDCOLOR)
RETURN(.T.)
*!*****************************************************************************
*!
*!       Function: STRMNTH()
*!
*!      Called by: SHOW_CALNDR()      (function  in ACCOUNTS.PRG)
*!
*!*****************************************************************************
FUNCTION STRMNTH
** this is just a function to return the month as a string...
PARAMETER MMNTH
PRIVATE MMNTH
DECLARE M[12]
M[1] = " January "
M[2] = " February "
M[3] = " March "
M[4] = " April "
M[5] = " May "
M[6] = " June "
M[7] = " July "
M[8] = " August "
M[9] = " September "
M[10]= " October "
M[11]= " November "
M[12]= " December "
RETURN(M[MMNTH])

*!*****************************************************************************
*!
*!       Function: DROP_BOX()
*!
*!
*!          Calls: BGC()              (function  in ?)
*!
*!*****************************************************************************
FUNCTION DROP_BOX
PARAMETERS T,L,B,R
PRIVATE T,L,B,R,X,I
*FOR X = T TO B
RESTSCREEN(T+1,L+1,B+1,R+1,BGC(SAVESCREEN(T+1,L+1,B+1,R+1),8))
*NEXT
FOR X = T TO B
   @ X,L CLEAR TO X,R
   FOR I = 1 TO 20 && Short delay loop...
   NEXT I
NEXT
@ T,L TO B,R
RETURN(.T.)
*!*****************************************************************************
*!
*!       Function: D_MSG()
*!
*!
*!          Calls: BGC()              (function  in ?)
*!
*!*****************************************************************************
FUNCTION D_MSG
PARAMETER MSG
PRIVATE MSG,OLDCOLOR,X,STRING,Y,VAL_STRING,Z
DECLARE HI_LITE[20],HI_POS[20]
VOID=AFILL(HI_LITE,"")
VOID=AFILL(HI_POS,-1)
OLDCOLOR=SETCOLOR("W/R")
RESTSCREEN(24,2,24,78,BGC(SAVESCREEN(24,2,24,78),8))
IF !EMPTY(MSG)
   IF LEFT(MSG,1) <> " "
      MSG = " "+MSG
   ENDIF
ENDIF
STRING     =""
VAL_STRING =""
Y=0
IF "$"$MSG .OR. "@"$MSG
   ** Scan string looking for Highlighters...
   FOR X =1 TO LEN(MSG)
      DO CASE
            ** Highlight next char only...
         CASE SUBSTR(MSG,X+Y,1) ="$"
            Y=Y+1
            HI_LITE[Y] =SUBSTR(MSG,X+Y,1)
            HI_POS[Y]  =X
            ** Highlight next word only...
         CASE SUBSTR(MSG,X+Y,1) ="@"
            Y=Y+1
            FOR Z =0 TO 10
               IF !(SUBSTR(MSG,X+Y+Z,1)$" -,.>])")
                  HI_LITE[Y] =HI_LITE[Y]+SUBSTR(MSG,X+Y+Z,1)
               ELSE
                  Z =10
               ENDIF
            NEXT
            HI_POS[Y] =X
      ENDCASE
      STRING =STRING+SUBSTR(MSG,X+Y,1)
   NEXT
ELSE
   STRING=MSG
ENDIF
** Display the string...
@ 23,1 SAY LEFT(STRING+SPACE(77),77)
VOID=SETCOLOR("W+/R")
** Just do the highlights...
FOR X =1 TO Y
   IF HI_POS[X] <> -1
      @ 23,HI_POS[X] SAY HI_LITE[X]
      ** Not using the VAL_string...
      ** VAL_STRING=VAL_STRING+HI_LITE[X]
   ELSE
      X =Y+1
   ENDIF
NEXT
VOID=SETCOLOR(OLDCOLOR)
RETURN(STRING)
*!*****************************************************************************
*!
*!       Function: E_MSG()
*!
*!
*!          Calls: D_MSG()            (function  in GENPROC.PRG)
*!
*!*****************************************************************************
FUNCTION E_MSG
PARAMETER STRING
PRIVATE STRING
D_MSG(STRING+", Press any key...")
TONE(100,4)
INKEY(0)
RETURN(.T.)

*!******************************************************************************
*!
*! Procedure BGC
*!
*!******************************************************************************
FUNCTION BGC
  PARAMETERS STRING,X
  ** pass the function the 'save screen' string and the ascii value to be used
  PRIVATE X,I,NEWSTRING
  ** invent a new string...
  NEWSTRING=""
  FOR I = 1 TO LEN(STRING) STEP 2
    ** take each alternate char and add to new string...
    NEWSTRING = NEWSTRING+SUBSTR(STRING,I,1)+CHR(X)
  NEXT
  ** return the new string to the caller...
  RETURN(NEWSTRING)

*!*****************************************************************************
*!
*!       Function: DROP_TITLE()
*!
*!
*!          Calls: DROP_BOX()         (function  in GENPROC.PRG)
*!
*!*****************************************************************************
FUNCTION DROP_TITLE
PARAMETER STRING
PRIVATE STRING,OLDCOLOR
OLDCOLOR = SETCOLOR("GR+/B,W+/R")
DROP_BOX(0,2,2,77)
SETCOLOR("W/B,W+/R")
@ 1,15 SAY LEFT(STRING+SPACE(60),60)
@ 1,4 SAY "F1-Q.Keys"
SETCOLOR("W+/B,W+/R")
@ 1,4 SAY "F1"
*SETCOLOR("GR+/B,W+/R")
SETCOLOR(OLDCOLOR)
RETURN(.T.)

Regards

Griff
Keep [Smile]ing

hag99 · Jan 19, 2007

Thank you all for your help. There are 52 weeks a year. And 13 weeks a quarter. Its a combination of 2 months with 4 weeks and one with five. And each year it changes. So say 2008 how do I know which has 4 and which have 5. Thats my issue. How to solve it. Thanks again. And any thoughts will be helpful.

TonHu · Jan 20, 2007

So the answer rob444 gave is the answer you require? You'll only need a LeapYear function to determine whether the requested year is a leapyear.

TIA
TonHu

JCreamerII · Jan 29, 2007

Hag99,

Do you need to know how many weeks per month? What's a week, seven days starting from Sunday? Can't you just count the number of Saturdays in each month? Test each day and if it's a Saturday increment your counter for that month. This would be pretty quick to write & clipper knows about leap years.

Thanks

Jim C.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Number of weeks in a month.

hag99

Technical User

rob444

Programmer

GriffMG

Programmer

GriffMG

Programmer

hag99

Technical User

TonHu

Programmer

JCreamerII

MIS

Similar threads

Part and Inventory Search

Sponsor