Forum Liberty Basic France
• Index
Voici une petite boite de dialogue pour saisir une date.
Il faudrait que je la transforme en une SUB unique qui renverrait la date choisie....
Code TEXT :
Edité par cassiope01 Le 04/05/2011 à 12h54
Il faudrait que je la transforme en une SUB unique qui renverrait la date choisie....
Code TEXT :
' Calendar popup.bas ' by ShirleyMSmith ' modified by cassiope01 ' ' Released as Public Domain ' nomainwin Mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre" ' Mois$ = "January February March April May June July August September October November December" aDay$ = Date$("mm/dd/yyyy") YearLimitDown = 1904 nYearLimitUp = 180 dim nDay(42) dim mon$(12) dim year$(nYearLimitUp) for m = 1 to 12 :mon$(m) = word$(Mois$,m) :next 'list for months for y = 1 to nYearLimitUp :year$(y) = str$(YearLimitDown+y) :next 'list for years Xref = 29 Yref = 16 ' make a small calendar WindowWidth = 238 WindowHeight = 210 UpperLeftX = 70: UpperLeftY = 70 Graphicbox #cal.g, 7, 7, 219, 170 combobox #cal.month, mon$(), [MonthYear], 38, 15, 96, 20 combobox #cal.year, year$(), [MonthYear], 130, 15, 60, 20 Open "Calendrier" for Dialog_modal as #cal #cal, "trapclose [quit]" #cal.g, "down" #cal.g, "backcolor white" #cal.g, "rule xor" #cal.month "font courier_new bold 10" #cal.year "font courier_new bold 10" #cal.g "backcolor white" #cal.g "font courier_new bold 10"'; cls" #cal.g "Place 10 20" #cal.g "\<< >>" #cal.g "Place 15 161" ' #cal.g "\ Today: ";aDay$ #cal.g "\Aujourd'hui: ";word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/") #cal.g "font ms_sans_serif bold 9" #cal.g "Place 7 47" ' #cal.g "\Mon Tue Wed Thu Fri Sat Sun" #cal.g "\Lun Mar Mer Jeu Ven Sam Dim" #cal.g "font ms_sans_serif bold 10" [CalendarRePrint] firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5)) lastDay$ = Date$(Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1) dow = (firstDay+1) Mod 7 + 1 If dow < 1 Then dow= (dow+13) Mod 7 + 1 MonthName$ = Word$(Mois$,Val(Word$(lastDay$,1,"/"))) Yr$ = Right$(lastDay$,4) #cal.month, "select ";MonthName$ #cal.year, "select ";Yr$ #cal.g "setfocus" ldow = dow :d = 0 :da = 0 :dd = 0 for nd = 1 to 42 lig = int(nd/7) col = nd - (lig*7) if nd mod 7 = 0 then col = 7 :lig = lig - 1 'case of must col = 7 select case case ldow-1 > 0 d = d + 1 i = val(Mid$(date$(firstDay - d),4,2)) ldow = ldow - 1 nDay(nd) = i - ldow + d #cal.g "color lightgray" case dd < Val(Mid$(lastDay$,4,2)) dd = dd + 1 nDay(nd) = dd #cal.g "color black" if dd = val(word$(aDay$,2,"/")) then 'the day of aDay$ rcx1 = col rcy1 = 4 + lig end if case else da = da + 1 nDay(nd) = da #cal.g "color lightgray" end select #cal.g "place ";(col-1)*Xref+6;" ";1+(4+lig)*Yref #cal.g "\";Space$(7) #cal.g "place ";(col-1)*Xref+12;" ";1+(4+lig)*Yref #cal.g "\"; Using("##",nDay(nd)) next #cal.g "color black" #cal.g "Place ";(rcx1-1)*Xref+6;" ";(rcy1-1)*Yref+4 ' show specific date w/box around date #cal.g "box ";rcx1*Xref+6;" ";rcy1*Yref+4 #cal.g "flush calg" #cal.g "When leftButtonDown [calgButtonSingle]" #cal.g "When leftButtonDouble [calgButtonDouble]" double=0 Wait [calgButtonSingle] double=0 Goto [calgButton] Wait [calgButtonDouble] double=1 Goto [calgButton] Wait [MonthYear] #cal.month "contents? MonthName$" #cal.year "contents? Yr$" #cal.month "selectionindex? mo" aDay$ = right$(str$(100+mo),2);"/";word$(aDay$,2,"/");"/";Yr$ goto [CalendarRePrint] wait [calgButton] ' rcy ' | 1 2 3 4 5 6 7 <-- rcx ' | +--+--+--+--+--+--+--+ ' 1 | | ' + << month year >> + ' 2 | | ' +--+--+--+--+--+--+--+ ' 3 | L M M J V S D | ' +--+--+--+--+--+--+--+ ' 4 | | | | | | | | Xref = 29, Yref = 16 ---> dim. of a cell ' +--+--+--+--+--+--+--+ ' 5 | | | | | | | | so we have height = 10 x 16 -> rcy x Yref ' +--+--+--+--+--+--+--+ width = 7 x 29 -> rcx x Xref ' 6 | | | | | | | | ' +--+--+--+--+--+--+--+ so we can calculate rcx,rcy with MouseX,MouseY ' 7 | | | | | | | | ' +--+--+--+--+--+--+--+ ' 8 | | | | | | | | ' +--+--+--+--+--+--+--+ so we have 7x6 = 42 cells for days of month ' 9 | | | | | | | | ' +--+--+--+--+--+--+--+ '10 | T o d a y | ' +--+--+--+--+--+--+--+ rcx = int((MouseX-6)/Xref)+1 ' check mouse positions rcy = int((MouseY-4)/Yref)+1 dom$ = Mid$(aDay$,4,2) numD = date$(aDay$) firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5)) lastDay = Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1 select case case rcy < 3 and rcx = 1 and numD > date$("01/31/";YearLimitDown + 1) aDate$=Date$(firstDay-1) lastdom$=Mid$(aDate$,4,2) If Val(dom$) > Val(lastdom$) Then dom$=lastdom$ aDay$=Left$(aDate$,2);"/";dom$;Mid$(aDate$,6) case rcy < 3 and rcx = 7 and numD < date$("12/01/";YearLimitDown + nYearLimitUp) aDate$=Date$(lastDay+1) nxmo$=Date$(Date$(aDate$)+31) lastdom$=Date$(Date$(Left$(nxmo$,3);1;Right$(nxmo$,5))-1) lastdom$=Mid$(lastdom$,4,2) If Val(dom$) > Val(lastdom$) Then dom$ = lastdom$ aDay$=Left$(aDate$,2);"/";dom$;Mid$(aDate$,6) case rcy > 3 and rcy < 10 if rcy = 4 then i = rcx - dow + 1 else i = 8 - dow + ((rcy-5) * 7) + rcx dat$ = word$(aDay$,1,"/");"/";right$(str$(100+i),2);"/";word$(aDay$,3,"/") if date$(dat$) then #cal.g, "Place ";(rcx1-1)*Xref+6;" ";(rcy1-1)*Yref+4 ' hide last specific date w/box around date #cal.g, "box ";rcx1*Xref+6;" ";rcy1*Yref+4 #cal.g, "Place ";(rcx-1)*Xref+6;" ";(rcy-1)*Yref+4 ' show specific date w/box around date #cal.g, "box ";rcx*Xref+6;" ";rcy*Yref+4 aDay$ = dat$ rcx1 = rcx rcy1 = rcy if double = 1 then Notice "Date selected is "+aDay$ else select case case rcy = 4 dat$ = date$(firstDay - 1) 'change month (-1) case rcy > 7 dat$ = date$(lastDay + 1) 'change month (+1) end select n = nDay(7*(rcy-4)+rcx) aDay$ = word$(dat$,1,"/");"/";right$(str$(100+n),2);"/";word$(dat$,3,"/") end if case rcy = 10 aDay$ = Date$("mm/dd/yyyy") ' reprint calendar for 'today' end select double = 0 Goto [CalendarRePrint] Wait [quit] Close #cal End
Edité par cassiope01 Le 04/05/2011 à 12h54
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."
Web
Libertynaute Inactif
Groupe: Visiteur
Bonjour cassiope01,
Je vois ce programme peut-être un peu tard, mais je suis un petit nouveau ici, fraîchement débarqué.
Ton code tourne bien, mais il renvoie la date au format anglo-saxon, si j'ai bien vu tout.
Sur le Continent , c'est moins pratique.
Mais ça doit pouvoir s'arranger.
Claude
Je vois ce programme peut-être un peu tard, mais je suis un petit nouveau ici, fraîchement débarqué.
Ton code tourne bien, mais il renvoie la date au format anglo-saxon, si j'ai bien vu tout.
Sur le Continent , c'est moins pratique.
Mais ça doit pouvoir s'arranger.
Claude
Salut Claude,
tu peux récupérer ce petit prog pour lequel j'avais justement écrit ce petit module, et qui exploite tout ça au format du vieux continent
Gadget_Biorythm_Zodiac.zip
@+
Edité par cassiope01 Le 20/12/2011 à 11h44
tu peux récupérer ce petit prog pour lequel j'avais justement écrit ce petit module, et qui exploite tout ça au format du vieux continent

Gadget_Biorythm_Zodiac.zip
@+
Edité par cassiope01 Le 20/12/2011 à 11h44
____________________
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."
Devise Shadocks : "Mieux vaut mobiliser son intelligence pour des conneries, que mobiliser sa connerie pour des choses intelligentes"
Coluche disait : "C'est parce que la vitesse de la lumière est plus rapide que celle du son que certains peuvent paraîtrent brillants jusqu'à ce qu'ils ouvrent la bouche."
Web
• Index
1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie