Simple Calendar (Show only one month)

General FreeBASIC programming questions.
BasicCoder2
Posts: 3348
Joined: Jan 01, 2009 7:03

Re: Simple Calendar (Show only one month)

Postby BasicCoder2 » Jan 01, 2017 21:19

Another GUI display using tab controls and using code logic of Ircvs and dodicat's verse.

Code: Select all

const SCRW = 800
const SCRH = 500
const WINX = 50
const WINY = 10

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,mb
DIM shared v (6,7) AS STRING  'calendar month layout
dim shared as integer m,y     'month and year

dim shared as integer selectedTab

type TAB_LABEL
    as integer x,y,w,h,s
    as string  title
end type
dim shared as TAB_LABEL tabs(0 to 11)

type BUTTON
    as integer  x,y,w,h
    as string   t
end type
dim shared as BUTTON btn1,btn2
btn1.x = 12*8
btn1.y = 40
btn1.w = 8*4
btn1.h = 16
btn1.t = " <- "
btn2.x = 23*8
btn2.y = 40
btn2.w = 8*4
btn2.h = 16
btn2.t = " -> "

sub initialize()
    dim as integer position
    for i as integer = 0 to 11
        tabs(i).x = position
        tabs(i).y = 0
        tabs(i).s = 0
        read tabs(i).title
        tabs(i).h = 16
        tabs(i).w = len(tabs(i).title)*8+8
        position = position + tabs(i).w + 1
    next i
    tabs(0).s = 1
end sub
tabTitles:
data "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"

sub drawTabs()
    line (WINX,WINY+16)-(SCRW-WINX,SCRH-WINY),rgb(0,0,0),b
    for i as integer = 0 to 11
        line (tabs(i).x + WINX,tabs(i).y+ WINY)-(tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY+tabs(i).h),rgb(0,0,0),b
        if selectedTab = i then
            line (tabs(i).x + WINX+1,tabs(i).y+ WINY+1)-(tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY+tabs(i).h),rgb(255,255,255),bf
        else
            line (tabs(i).x + WINX+1,tabs(i).y+ WINY+1)-(tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY+tabs(i).h-1),rgb(200,200,200),bf
        end if
        draw string (tabs(i).x + WINX+4,tabs(i).y+ WINY+4),tabs(i).title,rgb(0,0,0)
       
        pset (tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY),rgb(255,255,255)
        pset (tabs(i).x + WINX+tabs(i).w-1,tabs(i).y+ WINY),rgb(0,0,0)
        pset (tabs(i).x + WINX+tabs(i).w-2,tabs(i).y+ WINY),rgb(0,0,0)
        pset (tabs(i).x + WINX+tabs(i).w,tabs(i).y+ WINY+1),rgb(0,0,0)
       
        pset (tabs(i).x + WINX,tabs(i).y+ WINY),rgb(255,255,255)
        pset (tabs(i).x + WINX+1,tabs(i).y+ WINY),rgb(0,0,0)
        pset (tabs(i).x + WINX+2,tabs(i).y+ WINY),rgb(0,0,0)
        pset (tabs(i).x + WINX,tabs(i).y+ WINY+1),rgb(0,0,0)
    next i
    'draw buttons
    line (btn1.x+WINX,btn1.y+WINY)-(btn1.x+btn1.w+WINX,btn1.y+btn1.h+WINY),rgb(0,0,0),b
    draw string (btn1.x+2+WINX,btn1.y+4+WINY),btn1.t
    line (btn2.x+WINX,btn2.y+WINY)-(btn2.x+btn2.w+WINX,btn2.y+btn2.h+WINY),rgb(0,0,0),b
    draw string (btn2.x+2+WINX,btn2.y+4+WINY),btn2.t
end sub

sub drawPage()
    Select Case As Const selectedTab
    Case 0
        draw string (WINX+10,SCRH+WINY-32),"January brings the snow, Makes our feet and fingers glow."
    Case 1
        draw string (WINX+10,SCRH+WINY-32),"February brings the rain, Thaws the frozen lake again."
    Case 2
        draw string (WINX+10,SCRH+WINY-32),"March brings breezes loud and shrill, Stirs the golden daffodil."
    Case 3
        draw string (WINX+10,SCRH+WINY-32),"April brings the primrose sweet, Scatters daisies at our feet."
    Case 4
        draw string (WINX+10,SCRH+WINY-32),"May brings flocks of pretty lambs, Skipping by their fleecy dams."
    Case 5
        draw string (WINX+10,SCRH+WINY-32),"June brings tulips, lillies, roses, Fills the children's hands with posies."
    Case 6
        draw string (WINX+10,SCRH+WINY-32),"Hot July brings cooling showers, Apricots and gillyflowers."
    Case 7
        draw string (WINX+10,SCRH+WINY-32),"August brings the sheaves of corn, Then the harvest home is borne."
    Case 8
        draw string (WINX+10,SCRH+WINY-32),"Warm September brings the fruit, Sportsmen then begin to shoot."
    Case 9
        draw string (WINX+10,SCRH+WINY-32),"Fresh October brings the pheasant, Then to gather nuts is pleasant."
    Case 10
        draw string (WINX+10,SCRH+WINY-32),"Dull November brings the blast, Then the leaves are falling past."
    Case Else
        draw string (WINX+10,SCRH+WINY-32),"Chill December brings the sleet, Blazing fire and Christmas treat."
    End Select

end sub

sub showCalendarMonth()

    draw string (WINX+16*8+12,WINY+46), str( y )

    draw string (WINX+64,WINY+72), "Mo  Tu  We  Th  Fr  Sa  Su"
   
    FOR j as integer = 1 TO 6
        FOR k as integer = 1 TO 7
            draw string (WINX + (k-1) * 32 + 64,(j-1)*32+WINY+96), v(j, k)
        NEXT k
        PRINT
    NEXT j
   
end sub

sub upDate()
    screenlock
    cls
    drawTabs()
    drawPage()
    showCalendarMonth()
    screenunlock()
end sub


sub makeCalendarMonth(y as integer, m as integer)
    DIM AS INTEGER a,c,d,dm,ds,f, Z
    DIM as string u(49)
    d = 1
    IF m = 2 THEN dm = 28

    If m = 2 And (y Mod 400 = 0) And (y Mod 4 = 0) or (y Mod 100 <> 0) And (y Mod 4 = 0) Then dm = 29

    IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
    IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30

    a = INT((14 - m) / 12)
    y = y - a
    m = m + (12 * a) - 2
    ds =((d + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)

    IF ds = 0 THEN ds = ds +7
    IF ds > 0 THEN ds = ds -1

    FOR n as integer = 1 TO 49
        u(n) = "  "
    NEXT n

    FOR n as integer = 1 TO dm
        f =  LEN(LTRIM(STR(n)))
        IF f =1 THEN
            u(n+ds) = " " + LTRIM(STR(n))
        ELSE
            u(n+ds) = LTRIM(STR(n))
        END IF   
    NEXT n

    c = 1

    FOR j as integer = 1 TO 6
        FOR k as integer = 1 TO 7
            v(j,k) = MID(u(c),1,3)
            c = c + 1
        NEXT k
    NEXT j

end sub

initialize()
y = 2017

do
    getmouse mx,my,,mb
    if mb=1 then
        'is it over tab
        for i as integer = 0 to 11
            if  mx>tabs(i).x+WINX and mx<tabs(i).x + tabs(i).w + WINX and _
                my>tabs(i).y+WINY and my<tabs(i).y + tabs(i).h + WINY then
                selectedTab = i
            end if
        next i
        'is it over button
        if  mx>btn1.x+WINX and mx<btn1.x + btn1.w + WINX and _
            my>btn1.y+WINY and my<btn1.y + btn1.h + WINY then
            y = y - 1
        end if
        if  mx>btn2.x+WINX and mx<btn2.x + btn2.w + WINX and _
            my>btn2.y+WINY and my<btn2.y + btn2.h + WINY then
            y = y + 1
        end if       
   end if
   
    m = selectedTab+1
    makeCalendarMonth(y,m)
    showCalendarMonth()
    upDate()
    while mb=1:getmouse mx,my,,mb:wend

    sleep 2
loop until multikey(&H01)
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show only one month)

Postby lrcvs » Jan 02, 2017 11:03

Hi

@ BasicCoder2 : Wow!!!
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show annual in lines)

Postby lrcvs » Jan 02, 2017 11:07

Hi

This program shows a complete annual calendar of 12 months in lines.

Code: Select all

'PROGRAM:CALENDAR, SHOW ANNUAL  IN LINES <<< !!!

DIM AS INTEGER a,c,d,dm,ds,f,j,k,m,n,y,z,W
DIM AS STRING E
DIM u (49) AS STRING

CLS
INPUT "YEAR (YYYY) = ";W
cls
FOR N = 1 TO 6
E = E + "SMTWTFS"'ENGLISH
'E = E + "DLMXJVS"'SPANISH
NEXT N
COLOR 10:locate 1,1:print E;:COLOR 14:PRINT "   ";W
COLOR 15
for z = 1 to 12
m = z
d = 1
ds = 0
Y=W

IF m = 2 THEN dm = 28

If m = 2 And (y Mod 400 = 0) And (y Mod 4 = 0) or (y Mod 100 <> 0) And (y Mod 4 = 0) Then dm = 29

IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30

a = INT((14 - m) / 12)
y = y - a
m = m + (12 * a) - 2
ds =((d + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)

FOR n = 1 TO 49
    u(n) = " "
NEXT n

FOR n = 1 TO dm
    u(n+ds) = RIGHT(LTRIM(STR(n)),1)
NEXT n

C = 1
FOR n = 1 TO dm+ds
    IF C = 1 THEN
        COLOR 12
    print u(n);
    ELSE
        COLOR 15
     print u(n);     
    END IF
    C = C + 1
    IF C = 8 THEN C = 1
NEXT n
PRINT
next z
SLEEP
END
Lothar Schirm
Posts: 333
Joined: Sep 28, 2013 15:08
Location: Bavaria, Germany

Re: Simple Calendar (Show only one month)

Postby Lothar Schirm » Jan 02, 2017 14:22

Again, very impressive FreeBASIC GUI examples by dodicat and BasicCoder2! I like it.
BasicCoder2
Posts: 3348
Joined: Jan 01, 2009 7:03

Re: Simple Calendar (Show only one month)

Postby BasicCoder2 » Jan 02, 2017 22:57

This is how I would display a complete calendar year.

Code: Select all

const SCRW = 1084
const SCRH = 500
const WINX = 8
const WINY = 100

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer mx,my,mb

DIM shared v (1 to 6,1 to 7) AS STRING  'calendar month layout
dim shared as integer m,y     'month and year
dim shared as string mnth(1 to 12)
for i as integer = 1 to 12
    read mnth(i)
next i
data "JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"

dim shared as integer posx,posy  'position to draw month data

type BUTTON
    as integer  x,y,w,h
    as string   t
end type
dim shared as BUTTON btn1,btn2
btn1.x = 8
btn1.y = 40
btn1.w = 8*4
btn1.h = 16
btn1.t = "<- "
btn2.x = 12*8
btn2.y = 40
btn2.w = 8*4
btn2.h = 16
btn2.t = " ->"

sub showCalendarMonth(m as integer)
    draw string (7*8,44),str(y)
   
    draw string (WINX+posx*180,WINY+posy*200-24), mnth(m)

    draw string (WINX+posx*180,WINY+posy*200), "Mo Tu We Th Fr Sa Su"
   
    FOR j as integer = 1 TO 6
        FOR k as integer = 1 TO 7
            draw string (WINX + (k-1) * 24+posx*180,(j-1)*24+WINY+posy*200+24), v(j, k)
        NEXT k
    NEXT j
    posx = posx + 1
    if posx = 6 then posx = 0:posy = posy + 1
end sub


sub makeCalendarMonth(y as integer, m as integer)
    DIM AS INTEGER a,c,d,dm,ds,f, Z
    dim as string u(1 to 49)
    d = 1
    IF m = 2 THEN dm = 28

    If m = 2 And (y Mod 400 = 0) And (y Mod 4 = 0) or (y Mod 100 <> 0) And (y Mod 4 = 0) Then dm = 29

    IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
    IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30

    a = INT((14 - m) / 12)
    y = y - a
    m = m + (12 * a) - 2
    ds =((d + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)

    IF ds = 0 THEN ds = ds +7
    IF ds > 0 THEN ds = ds -1

    FOR n as integer = 1 TO 49
        u(n) = "  "
    NEXT n

    FOR n as integer = 1 TO dm
        f =  LEN(LTRIM(STR(n)))
        IF f =1 THEN
            u(n+ds) = " " + LTRIM(STR(n))
        ELSE
            u(n+ds) = LTRIM(STR(n))
        END IF   
    NEXT n

    c = 1

    FOR j as integer = 1 TO 6
        FOR k as integer = 1 TO 7
            v(j,k) = MID(u(c),1,3)
            c = c + 1
        NEXT k
    NEXT j

end sub

sub drawCalendar(y as integer)
    screenlock
    cls
    print "The current time is: ";Time

    print "The current date is: ";Date


    posx = 0:posy = 0
    for m = 1 to 12
        makeCalendarMonth(y,m)
        showCalendarMonth(m)
    next m
    'draw buttons
    line (btn1.x,btn1.y)-(btn1.x+btn1.w,btn1.y+btn1.h),rgb(0,0,0),b
    draw string (btn1.x+4,btn1.y+4),btn1.t
    line (btn2.x,btn2.y)-(btn2.x+btn2.w,btn2.y+btn2.h),rgb(0,0,0),b
    draw string (btn2.x+4,btn2.y+4),btn2.t
    screenunlock
end sub

y = 2017

do
    getmouse mx,my,,mb
    if mb=1 then

        'is it over button
        if  mx>btn1.x and mx<btn1.x + btn1.w and _
            my>btn1.y and my<btn1.y + btn1.h then
            y = y - 1
        end if
        if  mx>btn2.x and mx<btn2.x + btn2.w and _
            my>btn2.y and my<btn2.y + btn2.h then
            y = y + 1
        end if       
    end if
   
    drawCalendar(y)

    while mb=1:getmouse mx,my,,mb:wend

    sleep 2
loop until multikey(&H01)
Last edited by BasicCoder2 on Jan 03, 2017 0:33, edited 3 times in total.
BasicCoder2
Posts: 3348
Joined: Jan 01, 2009 7:03

Re: Simple Calendar (Show only one month)

Postby BasicCoder2 » Jan 02, 2017 23:09

Lothar Schirm wrote:Again, very impressive FreeBASIC GUI examples by dodicat and BasicCoder2! I like it.

One issue with writing your own home spun controls is that although the screen reader NVDA used by the vision impaired can recognize and read microsoft controls it cannot read the native FB controls. FireFly might be an easy way to add controls but I think you need to be a Windows API programmer to use it.
.
MrSwiss
Posts: 2993
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Simple Calendar (Show only one month)

Postby MrSwiss » Jan 03, 2017 0:16

@BasicCoder2,

please declare your arrays in the FB way (to size them properly):

Code: Select all

v(1 To 6, 1 To 7)
'and (inside the Sub makeCalendarMonth() ):
u(1 To 42)
Otherwise, you are teaching beginners bad array sizing practices.
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show only one month)

Postby lrcvs » Jan 03, 2017 5:41

Delete by error in video.

Apologies!
Last edited by lrcvs on Jan 07, 2017 13:03, edited 1 time in total.
BasicCoder2
Posts: 3348
Joined: Jan 01, 2009 7:03

Re: Simple Calendar (Show only one month)

Postby BasicCoder2 » Jan 03, 2017 7:36

I guess it depends how you want to use the calendar.
Here is a graphic display modification of your code.
Using the Date function I have added code to make the current month green and the current day blue.

Code: Select all

'PROGRAM:CALENDAR, SHOW ANNUAL  IN LINES <<< !!!
screenres 1080,480,32
color rgb(0,0,0),rgb(255,255,255):cls

'================================================
dim as string theDate
dim as integer dd,mm,yy  'current day,month,year
theDate = date
mm = val(left(theDate,2))
dd = val(mid(theDate,4,2))
yy = val(right(theDate,4))
'================================================

DIM AS INTEGER a,c,d,dm,ds,f,j,k,m,n,y,z,W
DIM AS STRING E
DIM u (49) AS STRING

'CLS
'INPUT "YEAR (YYYY) = ";W

W = 2017

cls
locate 2,1
PRINT "   ";W:PRINT:PRINT:PRINT
print "       ";
FOR N = 1 TO 6
    print "S  M  T  W  T  F  S  ";'ENGLISH
    'E = E + "DLMXJVS"'SPANISH
NEXT N
PRINT
PRINT

dim as string mnth(1 to 12)
for i as integer = 1 to 12
    read mnth(i)
next i
data "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"

for i as integer = 1 to 12 'each month

    m = i
   
    if mm = m and W = yy then color rgb(0,255,0)  'show it is current month
   
    print "   ";mnth(i);" ";
    d = 1
    ds = 0
    Y=W
   
    color rgb(0,0,0) 'restore color

    IF m = 2 THEN dm = 28

    If m = 2 And (y Mod 400 = 0) And (y Mod 4 = 0) or (y Mod 100 <> 0) And (y Mod 4 = 0) Then dm = 29

    IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
    IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30

    a = INT((14 - m) / 12)
    y = y - a
    m = m + (12 * a) - 2
    ds =((d + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)

    FOR n = 1 TO 49
        u(n) = " "
    NEXT n

    FOR n = 1 TO dm
        u(n+ds) = STR(n) 'RIGHT(LTRIM(STR(n)),1)
    NEXT n

    C = 1
    FOR n = 1 TO dm+ds
        IF C = 1 THEN
            COLOR rgb(255,0,0)
        END IF
        if val(u(n))<10 then print " ";
        if val(u(n))=dd and mm = i and W = yy then color rgb(0,0,255)
        print u(n);" "; 
        C = C + 1
        IF C = 8 THEN C = 1
        COLOR rgb(0,0,0)
    NEXT n
    PRINT:PRINT
next i

for j as integer = 2 to 14
    for i as integer = 1 to 43
        line (i*24,j*16+2)-(i*24+24,j*16+16+2),rgb(100,100,100),b
    next i
next j

SLEEP
END
Last edited by BasicCoder2 on Jan 03, 2017 20:32, edited 2 times in total.
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show only one month)

Postby lrcvs » Jan 03, 2017 13:01

Hi

@ BasicCoder2: Only one word: "Perfect"
BasicCoder2
Posts: 3348
Joined: Jan 01, 2009 7:03

Re: Simple Calendar (Show only one month)

Postby BasicCoder2 » Jan 03, 2017 20:08

Nothing is perfect :)
You can always keep adding bells and whistles. A print calendar option might be nice.
Of course the heart of the calendar programs is your code to generate the numbers.
Using the Date function I have added code to make the current month green and the current day blue. See previous post.
,
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show only one month)

Postby lrcvs » Jan 04, 2017 22:35

Hi:

@ BasicCoder2:

Your program is very very fine now with this modification!

Nothing is perfect, ok!

Here is my new calendar.

I hope you like this new code!

Code: Select all

'Program: Calendar, show only one month
DIM AS INTEGER a,c,dm,ds,f,l,m,n,p,y,z
DIM AS STRING u
DIM v (6,7) AS STRING

CLS
INPUT "Month number 1...12 = ";m
INPUT "Year number yyyy = ";y
CLS

IF m = 2 THEN dm = 28
IF m = 2 AND (y MOD 400 = 0) AND (y MOD 4 = 0) OR (y MOD 100 <> 0) AND (y MOD 4 = 0) THEN dm = 29
IF m = 1 OR m = 3 OR m = 5 OR m = 7 OR m = 8 OR m = 10 OR m = 12 THEN dm = 31
IF m = 4 OR m = 6 OR m = 9 OR m = 11 THEN dm = 30

a = INT((14 - m) / 12)
y = y - a
m = m + (12 * a) - 2
ds =((1 + y + INT(y / 4) - INT(y / 100) + INT(y / 400) + INT((31 * m) / 12)) MOD 7)
IF ds = 0 THEN ds = ds + 7
IF ds > 0 THEN ds = ds - 1

FOR f = 1 TO 6
    FOR c = 1 to 7
        v(f,c)=STRING(3," ")
    NEXT c
NEXT f

FOR p = 1 TO dm
    u = ""
    u = LTRIM(STR(p))
    z = p+ds
    IF z <= 7 THEN
        f = 1
        c = z
        MID(v(f,c),2) = u
    ELSE
        c = z MOD 7
        f = INT(z/7)+1
             IF c = 0 THEN c = 7:f = f - 1
        MID(v(f,c),2) = u
    END IF
NEXT p


PRINT " Mo Tu We Th Fr Sa Su"

FOR f = 1 TO 6
    FOR c = 1 to 7
        PRINT v(f,c);
    NEXT c
    PRINT
NEXT f

SLEEP
END
Jawade
Posts: 224
Joined: Apr 25, 2008 19:13

Re: Simple Calendar (Show only one month)

Postby Jawade » Jan 10, 2017 18:05

What about this? http://jawade.nl/kalender.html It is in Dutch, it's a calendar, logbook,agenda and alarm in one.
lrcvs
Posts: 567
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Simple Calendar (Show only one month)

Postby lrcvs » Jan 10, 2017 23:24

Hi, Jawade:

Wow!

Certainly a great and good job!
It has many applications and options ...

In this post, other friends have shown their examples and they are also very very well worked...

My calendar is simpler, the only interesting thing about this program is that it works well and without errors...

Regards

Return to “General”

Who is online

Users browsing this forum: Josep Roca and 1 guest