INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Number of weeks in a month.

Number of weeks in a month.

(OP)
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.

RE: Number of weeks in a month.

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.

RE: Number of weeks in a month.

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!

happy shades

Regards

Griff
Keep ing

RE: Number of weeks in a month.

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 ing

RE: Number of weeks in a month.

(OP)
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.

RE: Number of weeks in a month.

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

RE: Number of weeks in a month.

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.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close