Forum Liberty Basic France
• Index
• Projets open source » Gadget avec la date de naissance : biorythme, signes, etc... Avec mémorisation des anniversaires.
Le texte des "Observations" que j'ai trouvé bien sympathique et pas "prise de tête", est issu d'un programme trouvé sur Delphi.fr écrit par... je sais plus qui !?!? désolé...
On peut mémoriser l'anniversaire d'autant de personnes qu'on veut...
Code VB :
Edité par cassiope01 Le 18/06/2011 à 05h10
On peut mémoriser l'anniversaire d'autant de personnes qu'on veut...
Code VB :
' Base on Calendar popup.bas ' by ShirleyMSmith ' ' modified by cassiope01 ' ' Released as Public Domain ' nomainwin GLOBAL Mois$, Jour$, Gwidth, Gheight, YearLimitDown, nYearLimitUp, Xref, Yref, index, current, selection DIM info$(10,10) DIM nDay(2,42) dim date.g(2) dim rcx(2) dim rcy(2) dim dow(2) dim mon$(12) dim names$(20) dim Name$(20) dim temp$(20) Mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre" 'EU format ' Mois$ = "January February March April May June July August September October November December" 'US format Jour$ = "Mar Mer Jeu Ven Sam Dim Lun" ' Jour$ = "Tue Wed Thu Fri Sat Sun Mon" aDay$ = Date$("mm/dd/yyyy") j = date$(aDay$) date$ = JourSem$(j)+" "+mid$(aDay$,4,2)+" "+NomMois$(j)+" "+right$(aDay$,4)+space$(6)+left$(time$(),5) if fileExists(DefaultDir$, "Gadget.ini") then open "Gadget.ini" for input as #bgk WHILE EOF(#bgk)=0 LINE INPUT #bgk, n$ index = index + 1 'Count DATAs in the file WEND close #bgk REDIM names$(index + 20) 'dimensionne la variable namas$() aux nbre de noms existant + 20 ajouts potentiels REDIM Name$(index + 20) open "Gadget.ini" for input as #bgk WHILE EOF(#bgk)=0 k = k + 1 LINE INPUT #bgk, names$(k) 'Load in the array Name$(k) = word$(names$(k),2) WEND lastselected = val(word$(names$(k),1)) close #bgk else date.g(1) = date$("08/10/1961") 'date.born index = 1 Name$(index) = "Moi" names$(index) = date.g(1);" ";Name$(index) 'futur first record of Gadget.ini lastselected = index nobody = 1 end if date.g(2) = date$("days") 'date.bio YearLimitDown = 1904 nYearLimitUp = 180 Xref = 29 Yref = 16 ' dtbio$ = aDay$ 'date format US dtbio$ = word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/") 'date format Europe 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 WindowWidth = 850 WindowHeight = 340 ' UpperLeftX = 100: UpperLeftY = 100 UpperLeftX=(DisplayWidth-WindowWidth)/16 UpperLeftY=(DisplayHeight-WindowHeight)/8 ForegroundColor$ = "darkgreen" Graphicbox #cal.g1, 7, 35, 219, 170 Graphicbox #cal.g2, 620, 35, 219, 170 Graphicbox #cal.bio, 230, 7, 384, 200 combobox #cal.month1, mon$(), MonthYear, 40, 42, 95, 20 combobox #cal.year1, year$(), MonthYear, 130, 42, 60, 20 combobox #cal.month2, mon$(), MonthYear, 655, 42, 95, 20 combobox #cal.year2, year$(), MonthYear, 744, 42, 60, 20 statictext #cal.born, "Date de naissance", 28, 6, 200, 20 BUTTON #cal.default, "", ValidName, UL, 850, 206, 10, 20 'hidden button for validate name combobox... combobox #cal.who, Name$(), Names, 7, 206, 120, 18 statictext #cal.dtbio, "Date du biorythme", 640, 6, 210, 20 statictext #cal.cycle, "Nbre de Jours dans les cycles au :", 140, 210, 200, 20 statictext #cal.dbio, dtbio$, 348, 210, 100, 20 statictext #cal.valeurs, "", 425, 210, 400, 20 statictext #cal.com, "Observation", 10, 230, 835, 37 groupbox #cal.grp, "", 5, 260, 834, 51 statictext #cal.naiss, "Né(e) le ", 10, 270, 240, 20 statictext #cal.anniv, "Anniversaire dans ", 10, 289, 300, 20 statictext #cal.age, "Age ", 360, 270, 450, 20 statictext #cal.zodiac, "Zodiac : ", 320, 289, 515, 18 Open "GADGETS Date de Naissance"+space$(15)+date$ for Dialog_modal as #cal ' Open "GADGETS Date de Naissance"+space$(15)+date$ for graphics_nf_nsb as #cal #cal, "trapclose [quit]" #cal.bio "home; posxy CenterX CenterY" Gwidth = CenterX * 2 Gheight = CenterY * 2 #cal.born "!font Arial bold 14" #cal.dtbio "!font Arial bold 14" #cal.com "!font Comic_Sans_MS 10" #cal.cycle "!font Arial 10" #cal.dbio "!font Arial 10 bold" #cal.valeurs "!font Arial 10" #cal.naiss "!font Arial 10 bold" #cal.age "!font Arial 10 bold" #cal.anniv "!font Arial 10 bold" #cal.zodiac "!font Arial 10 bold" #cal.who "font Arial 9 bold" if lastselected > date$("01/01/1902") then 'read last date or item used... #cal.who "selectindex ";0 date.g(1) = lastselected else #cal.who "selectindex ";lastselected date.g(1) = val(word$(names$(lastselected),1)) end if if nobody = 0 then index = index - 1 'erase the last record, just here to remenber the last date or item used... call biorythm date.g(1), date.g(2) for i = 1 to 2 call InitilizeGB "#cal.g";i', x, y call CalendarRePrint "#cal.g";i, x, y next wait sub InitilizeGB Handle$', x, y w$ = right$(Handle$,1) aDay$ = Date$("mm/dd/yyyy") handle.m$ = "#cal.month"+w$ 'comboboxes handle.y$ = "#cal.year"+w$ #handle.m$ "font courier_new bold 10" #handle.y$ "font courier_new bold 10" #Handle$ "down; rule xor" #Handle$ "font courier_new bold 10" '; cls" #Handle$ "Place 10 20" #Handle$ "\<< >>" if val(w$) = 1 then #Handle$ "color lightgray" #Handle$ "Place 15 161" ' #Handle$ "\ Today: ";aDay$ 'US format #Handle$ "\Aujourd'hui: ";word$(aDay$,2,"/");"/";word$(aDay$,1,"/");"/";word$(aDay$,3,"/") 'EU format if val(w$) = 1 then #Handle$ "color darkgreen" #Handle$ "font ms_sans_serif bold 9" #Handle$ "Place 7 47" ' #Handle$ "\Sun Mon Tue Wed Thu Fri Sat" 'US format #Handle$ "\Lun Mar Mer Jeu Ven Sam Dim" 'EU format #Handle$ "font ms_sans_serif bold 10" #Handle$ "when leftButtonDown calgButton" end sub sub CalendarRePrint Handle$, PosX, PosY w = val(right$(Handle$,1)) Handle.g$ = "#cal.g";w aDay$ = date$(date.g(w)) if w = 1 then call MajWho date.g(w) 'maj who combobox... 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(w) = (firstDay+1) Mod 7 + 1 'EU format ' dow(w) = (firstDay+2) Mod 7 + 1 'US format If dow(w) < 1 Then dow(w) = (dow(w)+13) Mod 7 + 1 MonthName$ = Word$(Mois$,Val(Word$(lastDay$,1,"/"))) Yr$ = Right$(lastDay$,4) handle.m$ = "#cal.month";w 'comboboxes handle.y$ = "#cal.year";w #handle.m$ "select ";MonthName$ #handle.y$ "select ";Yr$ #Handle.g$ "setfocus" ldow = dow(w) :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(w,nd) = i - ldow + d #Handle.g$ "color lightgray" case dd < Val(Mid$(lastDay$,4,2)) dd = dd + 1 nDay(w,nd) = dd #Handle.g$ "color black" if dd = val(word$(aDay$,2,"/")) then 'the day of aDay$ rcx(w) = col rcy(w) = 4 + lig end if case else da = da + 1 nDay(w,nd) = da #Handle.g$ "color lightgray" end select #Handle.g$ "place ";(col-1)*Xref+6;" ";1+(4+lig)*Yref #Handle.g$ "\";Space$(7) #Handle.g$ "place ";(col-1)*Xref+12;" ";1+(4+lig)*Yref #Handle.g$ "\"; Using("##",nDay(w,nd)) next #Handle.g$ "color black" #Handle.g$ "Place ";(rcx(w)-1)*Xref+6;" ";(rcy(w)-1)*Yref+4 ' show specific date w/box around date #Handle.g$ "box ";rcx(w)*Xref+6;" ";rcy(w)*Yref+4 #Handle.g$ "flush; discard" End sub sub ValidName Handle$ 'hidden button for validate name combobox... #cal.who "selectionindex? id" #cal.who "contents? text$" select case case word$(names$(selection),1)<>"" and text$ = "" conf$ = "SUPPRIMER ";names$(selection);" ?" confirm conf$; answer$ if answer$ = "yes" then names$(selection) = "" Name$(selection) = "" call MajArray 'MAJ of array names$() etc... #cal.who "reload" selection = 0 #cal.who "selectindex ";selection end if case text$ <> "" and text$ <> word$(names$(id),2) conf$ = "CREER ";date.g(1);" ";text$;" ?" confirm conf$; answer$ if answer$ = "yes" then index = index + 1 names$(index) = str$(date.g(1))+" "+text$ Name$(index) = text$ #cal.who "reload" selection = index #cal.who "selectindex ";selection end if end select call CalendarRePrint "#cal.g1", PosX, PosY call biorythm date.g(1), date.g(2) end sub sub MajArray 'mise à jour du tableau en cas d'effacement d'une des données... for i = 1 to index if val(word$(names$(i),1)) > 0 then ind = ind + 1 next redim temp$(ind+20) :ind = 0 for i = 1 to index if val(word$(names$(i),1)) > 0 then ind = ind + 1 :temp$(ind) = names$(i) next redim names$(ind+20) :redim Name$(ind+20) index = ind for i = 1 to index names$(i) = temp$(i) :Name$(i) = word$(names$(i),2) next end sub sub Names Handle$ 'chose name in combobox current = 0 #cal.who "selectionindex? i" if i then date.g(1) = val(word$(names$(i),1)) : current = i 'current = selected by combobox call CalendarRePrint "#cal.g1", PosX, PosY call biorythm date.g(1), date.g(2) end if end sub sub MajWho daten 'search 'daten' in database if current = 0 then #cal.who "selectindex ";0 for i = 1 to index 'date selected by founding in database ? if val(word$(names$(i),1)) = daten then #cal.who "selectindex ";i selection = i exit for end if next end if current = 0 end sub sub MonthYear Handle$ w = val(right$(Handle$,1)) handle.m$ = "#cal.month";w 'comboboxes handle.y$ = "#cal.year";w #handle.m$ "contents? MonthName$" #handle.y$ "contents? Yr$" #handle.m$ "selectionindex? mo" date.g(w) = date$(right$(str$(100+mo),2);"/";word$(date$(date.g(w)),2,"/");"/";Yr$) if date.g(w) = 0 then aDay$ = right$(str$(100+mo),2);"/";word$(date$(date.g(w)),2,"/");"/";Yr$ firstDay = Date$(Left$(aDay$,3);1;Right$(aDay$,5)) date.g(w) = Date$(Left$(Date$(firstDay+31),3);1;Right$(Date$(firstDay+31),5))-1 end if call CalendarRePrint Handle$, PosX, PosY call biorythm date.g(1), date.g(2) end sub Sub calgButton Handle$, MouseX, MouseY w = val(right$(Handle$,1)) aDay$ = date$(date.g(w)) Handle.g$ = "#cal.g";w rcx = int((MouseX-6)/Xref)+1 ' check (grid) mouse position 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) '"<<" last month (same day) 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) '">>" next month (same day) 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(w) + 1 else i = 8 - dow(w) + ((rcy-5) * 7) + rcx dat$ = word$(aDay$,1,"/");"/";right$(str$(100+i),2);"/";word$(aDay$,3,"/") if date$(dat$) then #Handle.g$ "Place ";(rcx(w)-1)*Xref+6;" ";(rcy(w)-1)*Yref+4 ' hide last specific date w/box around date #Handle.g$ "box ";rcx(w)*Xref+6;" ";rcy(w)*Yref+4 #Handle.g$ "Place ";(rcx-1)*Xref+6;" ";(rcy-1)*Yref+4 ' show specific date w/box around date #Handle.g$ "box ";rcx*Xref+6;" ";rcy*Yref+4 aDay$ = dat$ rcx(w) = rcx 'change only if date valid rcy(w) = rcy else if firstDay > date$("01/31/";YearLimitDown + 1) and lastDay < date$("12/01/";YearLimitDown + nYearLimitUp) then 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(w,7*(rcy-4)+rcx) aDay$ = word$(dat$,1,"/");"/";right$(str$(100+n),2);"/";word$(dat$,3,"/") end if end if case rcy = 10 and w = 2 aDay$ = Date$("mm/dd/yyyy") ' reprint calendar for 'today' end select date.g(w) = date$(aDay$) call CalendarRePrint Handle$, PosX, PosY call biorythm date.g(1), date.g(2) end sub sub biorythm date.born, date.bio pi = asn(1) * 2 Xd = 0 ' paramètres pour le traçage Xf = Gwidth - Xd NbJrEcran = 21 ' nombre de jour visualisés sur l'écran JrEcrPix = Gwidth/(NbJrEcran + 1) ' nombre de pixels pour un jour #cal.bio "cls; down; color lightgray" for x = 1 to NbJrEcran + 1 #cal.bio "line ";x*JrEcrPix;" 20 ";x*JrEcrPix;" ";Gheight 'lignes verticales des jours next #cal.bio "line 0 ";10+Gheight/2;" ";Gwidth;" ";10+Gheight/2 'ligne horizontale centrale '{ écart de date pour le 1er jour à gauche sur le diagramme...} N = (date.bio - int(NbJrEcran/2)) - date.born dN = 0 P = 0 CasPhys = 0 CasEmot = 0 CasCere = 0 PhEmCe = 0 for Xt = Xd to Xf '{ amplitude du cycle } Phys = sin(2*pi*(N+dN)/23) Emot = sin(2*pi*(N+dN)/28) Cere = sin(2*pi*(N+dN)/33) 'Affichage des Jours du mois et Jours de la semaine if Xt > 0 and Jc < NbJrEcran and int(Xt mod JrEcrPix) = 0 then 'chaque jours Jc = Jc + 1 DJc$ = date$(date.bio - int(NbJrEcran/2) + Jc) DJc = date$(word$(DJc$,1,"/")+"/"+word$(DJc$,2,"/")+"/"+word$(DJc$,3,"/")) Js$ = left$(JourSem$(DJc),1) #cal.bio "color lightgray; place ";dN*JrEcrPix-4;" 16 ;|";Js$ '1ère lettre du jour de la semaine. if Js$ = "D" then #cal.bio "color lightgray; line ";Xt;" 20 ";Xt;" ";Gheight 'si Dimanche : un trait vertical supplémentaire. end if '{ calcul valeurs du jour du Biorythme + infos + Commentaires Biorythme + Note } if DJc = date.bio and J = 0 then ' #cal "font ";font$ #cal.bio "color darkred; line ";Xt;" 20 ";Xt;" ";Gheight 'MARQUE verticale centrale = jour référence. CALL Commentaire Phys, Emot, Cere, 48+Gheight JrPhys = (date.bio - date.born) mod 23 JrEmot = (date.bio - date.born) mod 28 JrCere = (date.bio - date.born) mod 33 ' #cal.dbio date$(date.bio) 'format US #cal.dbio mid$(date$(date.bio),4,3)+left$(date$(date.bio),3)+right$(date$(date.bio),4) 'date format Europe #cal.valeurs "(B) Physique = ";JrPhys;" (V) Emotionnel = ";JrEmot;" (R) Cérébral = ";JrCere J = 1 end if '{ Y = Y central - valeur de Phys en integer x grossissement 85 : mise à l'échelle de la fenêtre} YPhys = 10 + Gheight/2 - int(Phys*85) YEmot = 10 + Gheight/2 - int(Emot*85) YCere = 10 + Gheight/2 - int(Cere*85) '{ traçage des courbes } #cal.bio "color blue ;set ";Xt;" ";YPhys #cal.bio "color green ;set ";Xt;" ";YEmot #cal.bio "color red ;set ";Xt;" ";YCere '{ Pixel suivant et delta jour } P = P + 1 dN = P / JrEcrPix next call Date.Infos date.born, date.bio #cal.bio "flush; discard" end sub sub Date.Infos Dborn, Dday 'Gadgets about date.born if Dborn = 0 or Dday = 0 then exit sub #cal.naiss "Né(e) le ";JourSem$(Dborn);" ";word$(date$(Dborn),2,"/");" ";NomMois$(Dborn);" ";right$(date$(Dborn),4) #cal.age "Age : ";str$(Dday - Dborn);" jours soit : ";DiffDate$(Dborn,Dday) y$ = str$(Year(Dday)) m$ = str$(Month(Dborn)) d$ = str$(Day(Dborn)) date.birth = date$(m$;"/";d$;"/";y$) if date.birth < Dday then date.birth = date$(m$;"/";d$;"/";val(y$)+1) 'if the birthday is passed this year... #cal.anniv "Anniversaire dans : ";DiffDate$(date.birth,Dday) #cal.zodiac "Signe du Zodiac : ";Zodiac$(Dborn);" - ";SigneChinois$(Dborn) end sub Sub Commentaire Phys, Emot, Cere, Yc 'Interprétation du Biorythme...! if (Phys<-0.18) then CasPhys = 0 if ((Phys>-0.18) and (Phys<0.18)) then CasPhys = 1 if (Phys>0.18) then CasPhys = 2 if (Emot<-0.18) then CasEmot = 0 if (Emot>-0.18) and (Emot<0.18) then CasEmot = 1 if (Emot>0.18) then CasEmot = 2 if (Cere<-0.18) then CasCere = 0 if (Cere>-0.18) and (Cere<0.18) then CasCere = 1 if (Cere>0.18) then CasCere = 2 Select case right$(str$(1000 + CasPhys * 100 + CasEmot * 10 + CasCere),3) case "000" :C$ = "Vos trois cycles en période de récupération vous donnent un certain recul par rapport à tout ce qui vous entoure. Choisissez des activités reposantes." case "001" :C$ = "Il n'y aurait que vous, vous seriez bien resté au chaud dans votre lit douillet toute la journée. Alors surtout n'essayez pas d'innover." case "002" :C$ = "Vous posez sur les choses et sur les gens (y compris vous-même) un regard juste et lucide. Optez pour des activités demandant réflexion." case "010" :C$ = "Vous ne vous sentez pas dans votre assiette. Evitez de prendre une décision qui engagerait votre avenir, vous pourriez vous en mordre les doigts." case "011" :C$ = "Vous avez tendance à vous poser des tas de questions inutiles et à ne pas leur trouver de réponse, ce qui risque de retentir sur votre humeur." case "012" :C$ = "Vous aurez tendance à fuir le brouhaha pour vous retirer dans votre tour d'ivoire et y réfléchir à loisir. Profitez-en pour faire des projets." case "020" :C$ = "L'humeur est bonne et favorable aux rencontres, mais vous n'avez pas les pieds sur terre. Programmez ce jour-là des sorties, expos, cinéma." case "021" :C$ = "Laissez-vous guider par votre humeur qui vous rend optimiste. Votre jugement risque de ne pas être très sûr, entourez-vous de bons conseils." case "022" :C$ = "Aidé par votre flair et votre perspicacité, vous porterez un regard d'artiste sur le monde. Votre sensibilité et votre esprit favorisent la création." case "100" :C$ = "Aujourd'hui il vaut mieux ne pas compter sur vous pour remuer ciel et terre. Lire un bon bouquin au coin du feu, c'est tout ce qui vous tente." case "101" :C$ = "Vous vous demander si la vie vaut bien la peine d'être vécue. Ne cherchez surtout pas la réponse, livrez-vous plutôt à vos passe-temps préférés." case "102" :C$ = "Vous risquez de vous lever du pied gauche et d'être mal en point. Mais votre sens du devoir prendra le dessus et vous fera oublier ce jour gris." case "110" :C$ = "La moindre petite contrariété peut prendre à vos yeux des allures de catastrophe. Recherchez le calme et la solitude par dessus tout." case "111" :C$ = "Cette combinaison ne se produit que 8 fois en 54 ans. Vous avez donc le temps de vous préparer et de vous en remettre, alors dorlotez-vous." case "112" :C$ = "Votre humeur noire et vos observations aigres-douces (même justifiées) peuvent ne pas plaire à tout le monde, mettez de l'eau dans votre vin." case "120" :C$ = "Heureusement que vos amis sont là pour vous entourer d'affection et vous prodiguer leurs conseils. Vous avez envie d'être dorloté." case "121" :C$ = "Votre entourage va bénéficier de votre indulgence et de vos largesses. Prenez garde à ne pas vous laisser rouler, ne soyez pas trop poire. " case "122" :C$ = "Vous avez l'esprit clair et une façon de réagir positive, mais n'en faites pas trop, physiquement vous risqueriez bien de ne pas suivre." case "200" :C$ = "Aujourd'hui vous risquez de ne pas vous sentir très concerné par ce que vous faites. Alors contentez-vous de menus travaux." case "201" :C$ = "Vous avez un peu de mal à rassembler vos idées et à vous faire comprendre. Gare aux étourderies, sourtout réfléchissez avant d'agir." case "202" :C$ = "Vous ne manquerez ni de vivacité d'esprit, ni de vitalité et vous vous sentez de taille à surmonter les difficultés, profitez-en pour vous organiser." case "210" :C$ = "Vous avez du mal à le cacher : un rien vous agace. Evitez de vous mettre en colère, cela risquerait bien de se retourner contre vous." case "211" :C$ = "La forme est bonne mais le moral et les idées sont en roue libre. Contentez vous de tâches routinières, cela vaut beaucoup mieux." case "212" :C$ = "Animé par l'envie d'agir et la volonté d'arriver à vos fins, vous avez quelques difficultés à supporter les contrariétés ou les contre-temps." case "220" :C$ = "Vous voyez la vie en rose et comme la forme suit, vous vous montrez sous votre meilleur jour. N'hésitez pas à entreprendre." case "221" :C$ = "Vos relations avec les autres sont assez chaleureuses. Laissez-vous aller à votre bonne humeur et évitez de prendre des décisions importantes." case "222" :C$ = "Débordant d'énergie, vous vous sentez en pleine forme. Votre moral est au plus haut, votre esprit est alerte, bref la vie est vraiment belle." end Select #cal.com "Observation : "+C$ end sub function SigneChinois$(dt) 'base on "Signes Chinois.txt" d$ = date$(dt) year$ = right$(d$,4) if val(year$) < 1901 or val(year$) > 2019 then exit function if fileExists(DefaultDir$, "Signes Chinois.txt") = 0 then exit function open "Signes Chinois.txt" for input as #c WHILE EOF(#c) = 0 and l < 3 LINE INPUT #c, ref$ if instr(ref$,year$) then l = l + 1 l$(l) = ref$ end if WEND close #c a = instr(l$(1),year$) if dt < date$("02/"+mid$(l$(1),a+6,2)+"/"+year$) then l = 1 else l = 2 SigneChinois$ = "Signe Chinois : "+ word$(l$(l),6,";") + " - Élément : " + word$(l$(l),5,";") end function function Zodiac$(dt) zod$ = "2101_Verseau 2002_Poissons 2103_Bélier 2104_Taureau 2005_Gémeaux 2206_Cancer "+_ "2207_Lion 2408_Vierge 2309_Balance 2410_Scorpion 2311_Sagitaire 2312_Capricorne" d$ = date$(dt) month = val(left$(d$,2)) dy = val(mid$(d$,4,2)) Zodiac$ = word$(zod$,month) if dy < val(left$(Zodiac$,2)) then month = month - 1 if month = 0 then month = 12 Zodiac$ = mid$(word$(zod$,month),6) end function function DiffDate$(date1,date2) ' difference between date1 and date2 in Years, Months, Days if date1 = 0 or date2 = 0 then exit function if date1 > date2 then dtemp = date1 'for the continuation, date1 MUST be < date2 date1 = date2 date2 = dtemp end if dyy = Year(date2) - Year(date1) dmm = Month(date2) - Month(date1) if dmm < 0 then dyy = dyy - 1 : dmm = dmm + 12 ddd = Day(date2) - Day(date1) if ddd < 0 then dmm = dmm - 1 ddd = ddd + GetDaysOfMonth(Month(date1), Year(date1)) if dmm < 0 then dyy = dyy - 1 : dmm = dmm + 12 end if if dyy then Y$ = str$(dyy)+" An(s)" if dmm then M$ = str$(dmm)+" Mois" DiffDate$ = Y$;" ";M$;" ";str$(ddd);" Jour(s)" end function function GetDaysOfMonth(Month,Year) 'nbre de jours pour ce Mois 'Stefan Pendl for GetDaysOfMonth = 31 to 28 step -1 if date$(Month; "/"; GetDaysOfMonth; "/"; Year) > 0 then exit for next end function FUNCTION Day(days) d$ = date$(days) Day=val(mid$(d$,4,2)) END FUNCTION FUNCTION Month(days) d$ = date$(days) Month = val(left$(d$,2)) END FUNCTION FUNCTION Year(days) d$ = date$(days) Year = val(right$(d$,4)) END FUNCTION FUNCTION JourSem$(Jour) JourSem$ = word$(Jour$, Jour mod 7+1) END FUNCTION FUNCTION NomMois$(Jour) NomMois$ = word$(Mois$, Month(Jour)) END FUNCTION function fileExists(path$, filename$) 'DIM info$(10,10) doit déjà être déclarée files path$, filename$, info$() ' path$ = DefaultDir$ en général... fileExists = val(info$(0, 0)) 'non zéro si vrai end function [quit] open "Gadget.ini" for output as #sv 'sauvegarde dernière date de naissance utilisée #cal.who "selectionindex? id" index = index + 1 if id = 0 then names$(index) = str$(date.g(1)) else names$(index) = str$(id) for i = 1 to index if names$(i) <> "" then #sv, names$(i) next close #sv Close #cal End
Edité par cassiope01 Le 18/06/2011 à 05h10
____________________
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
Oups ! je me suis trompé de Section... si un gentil administrateur pouvait déplacer ce post dans la section "Projets open source" ce serait sympa...


____________________
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
Oui, ça à l'aire bien fait mais c'est quoi le principe ??
Cordialement
Jagang
PS : C'est bon, le sujet à été déplacé par un admin
Cordialement
Jagang
PS : C'est bon, le sujet à été déplacé par un admin
Merci pour le déplacement de sujet
Le principe de quoi Jagang... il suffit de s'en servir pis c'est tout...
Que voudrais-tu savoir exactement ??
@+

Le principe de quoi Jagang... il suffit de s'en servir pis c'est tout...

Que voudrais-tu savoir exactement ??
@+
____________________
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
J"aime beaucoup ! c'est amusant

Merci,
c'est même peut-être un gadget utile, pour justifier d'une petite méforme...
Et même épater les ceuss dont c'est l'anniversaire... pas sûr que tout le monde connaisse son signe chinois et son élément par exemple... infos pêchée sur wiki...!
A mince, mais je ne vous ai pas donné le fichier txt des signes chinois...!
Signes Chinois.txt faire clic droit, puis "Enregistrer sous" ...
Edité par cassiope01 Le 18/06/2011 à 15h24
c'est même peut-être un gadget utile, pour justifier d'une petite méforme...



Et même épater les ceuss dont c'est l'anniversaire... pas sûr que tout le monde connaisse son signe chinois et son élément par exemple... infos pêchée sur wiki...!
A mince, mais je ne vous ai pas donné le fichier txt des signes chinois...!

Signes Chinois.txt faire clic droit, puis "Enregistrer sous" ...
Edité par cassiope01 Le 18/06/2011 à 15h24
____________________
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
Beau travail

Merci les gars
faut bien essayer de faire vivre ce petit forum...
J'avoue être un peu désappointé par la désaffection des francophones pour ce forum, donc pour JB/LB...
Qu'en pensez-vous ?

faut bien essayer de faire vivre ce petit forum...


J'avoue être un peu désappointé par la désaffection des francophones pour ce forum, donc pour JB/LB...


Qu'en pensez-vous ?
____________________
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
____________________
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
Fonctionne quasiment OK. Amusant.
Un peu de difficulté pour introduire ma date de naissance, et elle ne semble pas
se répercuter dans le programme.
Je serais Lion, Boeuf et Métal alors que je suis plutôt Bélier, Cochon et Euro.
Il y a encore quelque chose qui accroche là-dedans.
Ou alors je n'ai pas compris la méthode.
C'est mieux de le dire si on le voit.
Cela montre qu'Il y a des membres qui essayent les codes, c'est plutôt encourageant,
on ne travaille pas dans le vide.
Amicalement.
Claude
EDIT : je retrouve cette conversion-ci qui est sans piège, et que j'ai déjà utilisé sans ennui:
'date au format numérique p ex 2011/12/22
'les autres formats ne le font pas, ou si peu:
Datum$ = DATE$("yyyy/mm/dd")
EuroDate$ = WORD$(Datum$, 3, "/") +"/" + WORD$(Datum$, 2, "/") + "/" + WORD$(Datum$, 1, "/")
Edité par Visiteur Le 22/12/2011 à 16h30
Un peu de difficulté pour introduire ma date de naissance, et elle ne semble pas
se répercuter dans le programme.
Je serais Lion, Boeuf et Métal alors que je suis plutôt Bélier, Cochon et Euro.
Il y a encore quelque chose qui accroche là-dedans.
Ou alors je n'ai pas compris la méthode.
C'est mieux de le dire si on le voit.
Cela montre qu'Il y a des membres qui essayent les codes, c'est plutôt encourageant,
on ne travaille pas dans le vide.
Amicalement.
Claude
EDIT : je retrouve cette conversion-ci qui est sans piège, et que j'ai déjà utilisé sans ennui:
'date au format numérique p ex 2011/12/22
'les autres formats ne le font pas, ou si peu:
Datum$ = DATE$("yyyy/mm/dd")
EuroDate$ = WORD$(Datum$, 3, "/") +"/" + WORD$(Datum$, 2, "/") + "/" + WORD$(Datum$, 1, "/")
Edité par Visiteur Le 22/12/2011 à 16h30
Je ne vois aucun pb !?!? Ou bien c'est que tu es né avant 1905 ...
Dans le calendrier de gauche tu choisis ton mois et ton année en haut, puis tu cliques sur ton jour, puis en dessous tu peux rentrer ton prénom, puis tu tapes 'Entrer', et pis c'est tout !
C'est justement fait pour concerver toutes les dates d'anniversaires que tu veux...
Pour supprimer un prénom, et ben tu l'effaces et tu tapes 'Entrer'...
Tout est simple tu vois !
La date au format Europe est écrite correctement en bas du calendrier.
Le calendrier de droite est simplement le jour d'aujourd'hui ou un autre de ton choix !
En cliquant sur le mot 'Aujourd'hui' en bas de ce calendrier, tu y reviens (à Aujourd'hui ! ).
Par défaut le programme se réouvrira aux dates où tu l'as quitté.
@+
NB: tu racontes des carabistouilles parce qu'en Avril 1947 l'€uro n'existait pas encore...
Edité par cassiope01 Le 23/12/2011 à 17h59

Dans le calendrier de gauche tu choisis ton mois et ton année en haut, puis tu cliques sur ton jour, puis en dessous tu peux rentrer ton prénom, puis tu tapes 'Entrer', et pis c'est tout !
C'est justement fait pour concerver toutes les dates d'anniversaires que tu veux...

Pour supprimer un prénom, et ben tu l'effaces et tu tapes 'Entrer'...
Tout est simple tu vois !
La date au format Europe est écrite correctement en bas du calendrier.
Le calendrier de droite est simplement le jour d'aujourd'hui ou un autre de ton choix !
En cliquant sur le mot 'Aujourd'hui' en bas de ce calendrier, tu y reviens (à Aujourd'hui ! ).
Par défaut le programme se réouvrira aux dates où tu l'as quitté.
@+
NB: tu racontes des carabistouilles parce qu'en Avril 1947 l'€uro n'existait pas encore...

Edité par cassiope01 Le 23/12/2011 à 17h59
____________________
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
• Projets open source » Gadget avec la date de naissance : biorythme, signes, etc... Avec mémorisation des anniversaires.
• 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