jicehel
Number of posts : 15 Registration date : 2013-03-12
| Subject: 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 ' ------------------------------------------------------------------------------ | |
|