Discussion forum about PANORAMIC language

Mac, Windows & Android application development with PANORAMIC language
 
HomeFAQSearchRegisterMemberlistUsergroupsLog in
Latest topics
» Hello world.
by Mon Jun 19, 2017 1:37 am

» Biomorphes de PICKOVER
by Sun Jun 18, 2017 2:33 am

» In less than 10 lines of code
by Fri Jun 16, 2017 5:03 am

» Effect Dopler
by Fri Jun 16, 2017 3:29 am

» SuperEllipse
by Wed Jun 14, 2017 4:01 am

» Plants
by Wed Jun 14, 2017 3:38 am

» Mira's attractor
by Wed Jun 14, 2017 3:30 am

» Triangle of Sierpinski
by Wed Jun 14, 2017 3:22 am

» Esthétique polaire
by Wed Jun 14, 2017 3:16 am

» Butterfly effect : Lorenz equations
by Wed Jun 14, 2017 3:08 am

» Collision detection
by Tue Jun 13, 2017 5:09 am

» The Bees Laline Paull Epub Books
by Mon Oct 10, 2016 8:58 pm

» PANORAMIC for Mac OSX 10 is available
by Tue Aug 09, 2016 6:08 pm

» ide
by Sat Jul 16, 2016 12:27 am

» Can I change the program icon/logo in my application ?
by Thu Jul 07, 2016 3:32 am

Navigation
 Portal
 Index
 Memberlist
 Profile
 FAQ
 Search

Share | 
 

 Cool calendar from the Panoramic french part of the forum

View previous topic View next topic Go down 
AuthorMessage
jicehel



Number of posts : 15
Registration date : 2013-03-12

PostSubject: Cool calendar from the Panoramic french part of the forum   Tue Mar 12, 2013 4:13 am

Hi as it's very quiet on the english forum, i post a source code created by JL35, one of the actives programmers of the french part of the Panoramic forum.
So i'm not the author but i hope what you'll find this source code usefull
Code:
LABEL Descal, Chan, Edannee, Majart, Supart, Clickcel, Clickbut, Affet, Edf
DIM wc%, hr%, p%, p1%, tp%, lf%, i%, j%, x%(12,32), y%(12,32), yy%, xx%, lm(12)
DIM ms$(12), js$(6), feve$, fete$, Annee, Mois, Jour, dl%, df%, a$, b$, im%
DIM an$, mo$, jo$, ev$, c%, r%, aa, mm, jj, xdl%, v, vg, afet%, db%

DATA "JANUARY","FEBUARY","MARCH","APRIL","MAY","JUNE","JULLY","AGOUST"
DATA "SEPTEMBER","OCTOBER","NOVEMBER","DÉCEMBER"
DATA "Su","Mo","Tu","We","Th","Fr","Sa"
FOR i% = 1 TO 12: READ ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
lm(1)=31: lm(2)=28:lm(3)=31:lm(4)=30:lm(5)=31:lm(6)=30:lm(7)=31:lm(8)=31
lm(9)=30:lm(10)=31:lm(11)=30:lm(12)=31

feve$ = "C:\TEXTES\EvntAAAA.txt": ' fichiers 'événements'
fete$ = "C:\TEXTES\Fetes.txt": ' liste des fêtes du jour

wc% = 80: hr% = 17
p% = 1
tp% = 25: lf% = 0
WIDTH 0, lf%+wc%*12+6: HEIGHT 0,tp%+hr%*32+4: BORDER_SMALL 0: CAPTION 0, ""
PICTURE p%: TOP p%, tp%: WIDTH p%,wc%*12-10: HEIGHT p%,hr%*32-30
FOR j% = 0 TO 31
    FOR i% = 1 TO 12
        x%(i%, j%) = lf% + (i%-1)*(wc%-1)
        y%(i%, j%) = j%*(hr%-1)
    NEXT i%
NEXT j%
2D_TARGET_IS p%: PRINT_TARGET_IS p%
FONT_NAME p%,"Arial"
ON_CLICK p%, Clickcel

p1% = 20
PICTURE p1%: TOP p1%,-1*HEIGHT(p%): WIDTH p1%,WIDTH(p%): HEIGHT p1%,HEIGHT(p%)
HIDE p1%

BUTTON 2: TOP 2,0: LEFT 2,WIDTH(1)/2-140: WIDTH 2,130: HEIGHT 2,20
CAPTION 2,"<- Année précédente": FONT_BOLD 2
BUTTON 3: TOP 3,TOP(2): LEFT 3,LEFT(2)+WIDTH(2)+70: WIDTH 3,130: HEIGHT 3,HEIGHT(2)
CAPTION 3,"Année suivante ->" : FONT_BOLD 3
ON_CLICK 2, Chan: ON_CLICK 3, Chan
EDIT 4: TOP 4,TOP(2)-4: LEFT 4,LEFT(2)+WIDTH(2): WIDTH 4,48: COLOR 4,255,255,128
FONT_BOLD 4: FONT_SIZE 4,12: FONT_COLOR 4,160,0,0
BUTTON 5: TOP 5,TOP(2): LEFT 5,LEFT(4)+WIDTH(4)+1: WIDTH 5,20: HEIGHT 5,HEIGHT(2)
CAPTION 5, "OK": ON_CLICK 5, Edannee
CHECK 6: TOP 6,2: LEFT 6,5: WIDTH 6,50: CAPTION 6, "Fests": ON_CLICK 6, Affet
ALPHA 7: TOP 7,4: LEFT 7,60: CAPTION 7,"Ajourd'hui " + DATE$: FONT_BOLD 7
FONT_COLOR 7,0,0,255
PROGRESS_BAR 8: LEFT 8,LEFT(3)+WIDTH(3): WIDTH 8,280: MIN 8,0: MAX 8,12: HIDE 8
TOP 8,10: HEIGHT 8,10

FORM 10:BORDER_HIDE 10: HIDE 10: TOP 10,50: LEFT 10,50
TO_FOREGROUND 10: FONT_BOLD 10: COLOR 10,180,255,180
ALPHA 11: PARENT 11,10: TOP 11,3: LEFT 11,50: CAPTION 11,"Day :"
MEMO 12: PARENT 12,10: TOP 12,20: LEFT 12,5: WIDTH 12,WIDTH(10)-10
HEIGHT 12,HEIGHT(10)-60
BUTTON 13: PARENT 13,10: TOP 13,TOP(12)+HEIGHT(12)+8: LEFT 13,160
CAPTION 13,"Enregistrer": ON_CLICK 13, Clickbut
BUTTON 14: PARENT 14,10: TOP 14,TOP(13): LEFT 14,LEFT(13)+80
CAPTION 14,"Quitter": ON_CLICK 14, Clickbut
BUTTON 15: PARENT 15,10: TOP 15,TOP(13): LEFT 15,lEFT(13)-80
CAPTION 15,"Supprimer": ON_CLICK 15, Clickbut
BUTTON 16: PARENT 16,10: TOP 16,TOP(13)+5: LEFT 16,5: HEIGHT 16,18
WIDTH 16,60: CAPTION 16,"Edit Fichier": FONT_BOLD_OFF 16: ON_CLICK 16, Edf

im% = 99: IMAGE im%
dl% = 100: DLIST dl%
df% = 101: DLIST df%
IF FILE_EXISTS(fete$) = 1
    FILE_LOAD df%, fete$
    b$ = MID$(DATE$,4,2)+LEFT$(DATE$,2): a$ = ""
    FOR i% = 1 TO COUNT(df%)
        IF LEFT$(ITEM_READ$(df%,i%),4) = b$
            a$ = " - " + MID$(ITEM_READ$(df%,i%),6,100): EXIT_FOR
        END_IF
    NEXT i%
END_IF
CAPTION 7, "Today " + DATE$ + a$

Annee = VAL(RIGHT$(DATE$,4))
GOSUB Descal

END
' ==============================================================================
Descal:
SHOW 8: POSITION 8,1
TEXT 4, STR$(Annee)
Bisex(Annee)
lm(2) = 28: IF rs_bi% = 1 THEN lm(2) = 29
' Lecture du fichier 'Evénement' de l'année
feve$ = LEFT$(feve$,LEN(feve$)-8)+STR$(Annee)+".txt"
CLEAR dl%
IF FILE_EXISTS(feve$) = 1
    FILEBIN_OPEN_READ 1, feve$: i% = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
    IF i% < 10
        FILE_DELETE feve$: ' fichier vide, on le supprime
    ELSE
        FILE_LOAD dl%, feve$
    END_IF
END_IF
QPaques(Annee): ' quantièmes de Pâques Ascension Pentecôte rs_qpa, rs_qas, rs_qpe
2D_TARGET_IS p1%: PRINT_TARGET_IS p1%
db% = 1
FOR Mois = 1 TO 12
    POSITION 8,Mois
    FOR Jour = 0 TO lm(Mois)
        yy% = y%(mois, Jour): xx% = x%(Mois, Jour)
        IF Jour = 0
            2D_FILL_COLOR 255,255,128
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            PRINT_LOCATE xx%+2,yy%+2: PRINT ms$(Mois): ' nom du mois
        ELSE
            an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
            jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = "#" + an$ + mo$ + jo$
            JourSem(Annee,Mois,Jour)
            IF rs_js% = 0
                2D_FILL_COLOR 160,255,255
            ELSE
                2D_FILL_COLOR 210,255,255
            END_IF
            Jmq(Annee,Mois,Jour): ' rs_qa% = quantième du jour
            a$ = js$(rs_js%)+RIGHT$(" "+STR$(Jour),2)
            b$ = ""
            IF Mois = 1 AND Jour = 1 THEN b$ = "J.de l'An"
            IF Mois = 5 AND Jour = 1 THEN b$ = "F.Travail"
            IF Mois = 5 AND Jour = 8 THEN b$ = "Vict.1945"
            IF Mois = 7 AND Jour = 14 THEN b$ = "Fêt.Nat."
            IF Mois = 8 AND Jour = 15 THEN b$ = "Assomption."
            IF Mois = 11 AND Jour = 1 THEN b$ = "Toussaint"
            IF Mois = 11 AND Jour = 11 THEN b$ = "Arm.1918"
            IF Mois = 12 AND Jour = 25 THEN b$ = "NOEL"
            IF rs_qa% = rs_qpa THEN b$ = "Pâques"
            IF rs_qa% = rs_qas THEN b$ = "Ascension"
            IF rs_qa% = rs_qpe THEN b$ = "Pentecôte."
            IF COUNT(dl%) > 0
                FOR i% = 1 TO COUNT(dl%)
                    IF LEFT$(ITEM_READ$(dl%,i%), LEN(ev$)) = ev$
                        2D_FILL_COLOR 255,180,180
                    END_IF
                NEXT i%
            END_IF
            IF b$ <> "" THEN b$ = " " + b$
            a$ = a$ + b$
            IF afet% = 1
                FOR i% = db% TO COUNT(df%)
                    b$ = ITEM_READ$(df%, i%)
                    IF LEFT$(b$,4) = mo$+jo$
                        a$ = a$ + " " + MID$(b$,6,100): db% = i%: EXIT_FOR
                    END_IF
                NEXT i%
            END_IF
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            PRINT_LOCATE xx%+2,yy%+2: PRINT a$
        END_IF
    NEXT Jour
NEXT Mois
2D_IMAGE_COPY im%,0,0,WIDTH(p1%),HEIGHT(p1%)
2D_TARGET_IS p%: 2D_IMAGE_PASTE im%,0,0
HIDE 8
CAPTION 0, " - CALENDRIER " + STR$(Annee) + " -"
RETURN
' ------------------------------------------------------------------------------
Chan:
IF CLICKED(2) = 1
    Annee = Annee - 1
ELSE
    Annee = Annee + 1
END_IF
TEXT 4, STR$(Annee)
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Edannee:
i% = VAL(TEXT$(4))
IF i%<1700 OR i%>2900 THEN RETURN
Annee = i%
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Majart:
' enregistrer l'article modifié ou nouveau
an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = "#" + an$ + mo$ + jo$
v = VAL(MID$(ev$,2,8)): j% = 0
IF COUNT(dl%) > 0
    FOR i% = 1 TO COUNT(dl%)
        a$ = ITEM_READ$(dl%, i%)
        IF LEFT$(a$, 1) = "#" AND LEN(a$) > 8
            vg = VAL(MID$(a$,2,8))
            IF vg = v OR vg > v
                IF vg = v
                    ' article déjà existant, supprimer puis remplacere
                    xdl% = i%: GOSUB Supart
                END_IF
                a$ = ITEM_READ$(12,1)
                IF LEFT$(a$,1) = "#" THEN a$ = LTRIM$(MID$(a$,10,500))
                ITEM_INSERT dl%, i%, ev$ + " " + a$: j% = 1
                IF COUNT(12) > 1
                    FOR j% = 2 TO COUNT(12)
                        i% = i% + 1
                        ITEM_INSERT dl%, i%, ITEM_READ$(12, j%)
                    NEXT j%
                END_IF
                EXIT_FOR
            END_IF
        END_IF
    NEXT i%
END_IF
IF j% = 0
    IF ITEM_READ$(12,COUNT(12)) = "" THEN ITEM_DELETE 12,COUNT(12)
    ITEM_ADD dl%, ev$ + " " + ITEM_READ$(12, 1)
    IF COUNT(12) > 1
        FOR j% = 2 TO COUNT(12)
            ITEM_ADD dl%, ITEM_READ$(12, j%)
        NEXT j%
    END_IF
END_IF
FILE_SAVE dl%, feve$: ' enregistrer
RETURN
' ------------------------------------------------------------------------------
Supart:
' Supprimer l'article événement affiché
IF COUNT(12) = 0 THEN RETURN: ' pas d'article affiché, on ne fait rien
ITEM_DELETE dl%, xdl%: ' suppression de l'article (1ère ligne)
WHILE xdl%<=COUNT(dl%)
    IF LEFT$(ITEM_READ$(dl%, xdl%), 1) = "#" THEN EXIT_WHILE: ' article suivant
    ITEM_DELETE dl%, xdl%: ' suppression ligne suivante de l'article
END_WHILE
IF COUNT(dl%) = 0
    IF FILE_EXISTS(feve$) = 1 THEN FILE_DELETE feve$: ' suppression fichier vide
ELSE
    FILE_SAVE dl%, feve$: ' mise à jour du fichier correspondant
END_IF
RETURN
' ------------------------------------------------------------------------------
Clickcel:
xx% = MOUSE_X_POSITION(p%): yy% = MOUSE_Y_POSITION(p%)
Mois = 1+INT(xx%/(wc%-1)): Jour = INT(yy%/(hr%-1))
IF Jour > lm(Mois) THEN RETURN
CAPTION 11,"Journée du " + STR$(Jour)+ " " + ms$(Mois) + " " +STR$(Annee)
CLEAR 12
IF FILE_EXISTS(feve$) = 1
    FOR i% = 1 TO COUNT(dl%)
        a$ = ITEM_READ$(dl%, i%)
        IF LEFT$(a$,1) = "#" AND LEN(a$) > 8
            ' la date est de la forme #aaaammjj
            aa = VAL(MID$(a$,2,4)): mm = VAL(MID$(a$,6,2)): jj = VAL(MID$(a$,8,2))
            IF aa > Annee THEN EXIT_FOR
            IF aa = Annee AND mm = Mois AND jj = Jour
                ITEM_ADD 12, LTRIM$(MID$(a$,10,500))
                xdl% = i%: ' index de l'article affiché
                i% = i% + 1
                WHILE i% <= COUNT(dl%)
                    a$ = ITEM_READ$(dl%, i%)
                    IF LEFT$(a$, 1) = "#" THEN EXIT_WHILE: ' article suivant
                    ITEM_ADD 12, a$
                    i% = i% + 1
                END_WHILE
                EXIT_FOR
            END_IF
        END_IF
    NEXT i%
END_IF
SHOW 10: TO_FOREGROUND 10
RETURN
' ------------------------------------------------------------------------------
Clickbut:
IF CLICKED(14) = 1
    ' on quitte sans rien faire
ELSE
    IF CLICKED(15) = 1
        GOSUB Supart: ' supprimer l'article actuellement affiché
    ELSE
        IF COUNT(12) > 0
            GOSUB Majart: ' Enregistrer (modifs ou nouveau)
        END_IF
    END_IF
    GOSUB Descal: ' réaffichage du calendrier
END_IF
HIDE 10
RETURN
' ------------------------------------------------------------------------------
Affet:
IF FILE_EXISTS(fete$) = 0 THEN RETURN
IF afet% = 1
    afet% = 0
ELSE
    afet% = 1
END_IF
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Edf:
EXECUTE_WAIT "Notepad.exe " + feve$
RETURN
' ------------------------------------------------------------------------------
SUB QPaques(Annee)
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de Annee
' Résultats dans rs_qpa, rs_qas, rs_qpe
DIM_LOCAL qp_a,qp_b,qp_c,qp_d,qp_e,qp_f,qp_g,qp_h,qp_i,qp_k,qp_l,qp_m
DIM_LOCAL qp_bi,qp_ci,qp_cj
IF VARIABLE("rs_qpa") = 0 THEN DIM rs_qpa
IF VARIABLE("rs_qas") = 0 THEN DIM rs_qas
IF VARIABLE("rs_qpe") = 0 THEN DIM rs_qpe
qp_a = 19*FRAC(Annee/19)
qp_b = INT(Annee/100)
qp_c = 100*FRAC(Annee/100)
qp_ci = 4*FRAC(Annee/4)
qp_cj = 400*FRAC(Annee/400)
qp_bi = 0: IF qp_ci = 0 AND (qp_c <> 0 OR qp_cj = 0) THEN qp_bi = 1
qp_d = INT(qp_b/4)
qp_e = 4*FRAC(qp_b/4)
qp_f = INT((qp_b + 8) / 25)
qp_g = INT((qp_b - qp_f + 1) / 3)
qp_h = 30*FRAC((19 * qp_a + qp_b - qp_d - qp_g + 15)/30)
qp_i = INT(qp_c/4)
qp_k = 4*FRAC(qp_c/4)
qp_l = 7*FRAC((32 + 2 * qp_e + 2 * qp_i - qp_h - qp_k)/7)
qp_m = INT((qp_a + 11 * qp_h + 22 * qp_l) / 451)
rs_qpa = qp_h + qp_l - 7 * qp_m + 81 + qp_bi
rs_qpa = INT(rs_qpa + .1)
rs_qas = rs_qpa + 39: rs_qpe = rs_qpa + 49
END_SUB
' ------------------------------------------------------------------------------
SUB JourSem(Annee,Mois,Jour)
' Jour de la semaine d'une date donnée (0= Dimanche à 6= Samedi) -> rs_js%
DIM_LOCAL js_d
IF VARIABLE("rs_js%") = 0 THEN DIM rs_js%
js_d = Annee
IF Mois<3 THEN js_d = js_d-1
js_d=INT(23*Mois/9)+Jour+4+Annee+INT(js_d/4)-INT(js_d/100)+INT(js_d/400)
IF Mois>=3 THEN js_d = js_d-2
rs_js% = js_d-7*INT(js_d/7)
END_SUB
' ------------------------------------------------------------------------------
SUB Jmq(Annee,Mois,Jour)
' Quantième de l'année en fonction de Annee, Mois, Jour -> rs_qa%
DIM_LOCAL Jm_Q, Jm_m
IF VARIABLE("rs_qa%") = 0 THEN DIM rs_qa%
Jm_Q = 0
IF Mois > 1
    FOR Jm_m = 1 TO Mois - 1
        SELECT Jm_m
            CASE 1: Jm_Q = Jm_Q+31
            CASE 2: Jm_Q = Jm_Q+28
IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN Jm_Q=Jm_Q+1
            CASE 3: Jm_Q = Jm_Q+31
            CASE 4: Jm_Q = Jm_Q+30
            CASE 5: Jm_Q = Jm_Q+31
            CASE 6: Jm_Q = Jm_Q+30
            CASE 7: Jm_Q = Jm_Q+31
            CASE 8: Jm_Q = Jm_Q+31
            CASE 9: Jm_Q = Jm_Q+30
            CASE 10: Jm_Q = Jm_Q+31
            CASE 11: Jm_Q = Jm_Q+30
        END_SELECT
    NEXT Jm_m
END_IF
rs_qa% = Jm_Q+Jour
END_SUB
' ------------------------------------------------------------------------------
SUB Bisex(Annee)
IF VARIABLE("rs_bi%") = 0 THEN DIM rs_bi%
rs_bi% = 0
IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN rs_bi% = 1
END_SUB
' ------------------------------------------------------------------------------
Back to top Go down
View user profile
 
Cool calendar from the Panoramic french part of the forum
View previous topic View next topic Back to top 
Page 1 of 1
 Similar topics
-
» Test javascript Calendar
» DJ IRIE Calendar Contest *Must live in South Beach and 21 or older*
» Sentinel Spectrum Calendar Photo 4 *australia only*
» Cool Mandelbrot fractal video
» Won 2nd place in the Miss Bikini Calendar challenge !!

Permissions in this forum:You cannot reply to topics in this forum
Discussion forum about PANORAMIC language :: Panoramic for Windows :: Source code (snippets)-
Jump to: