Forum Liberty Basic France

Le 17/06/2011 à 14h01

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
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 :
 
' 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."

Web    
Le 17/06/2011 à 14h18

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
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... :siffle :siffle
____________________
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    
Le 17/06/2011 à 21h50

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 362
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
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Le 17/06/2011 à 22h46

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Merci pour le déplacement de sujet ;)

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

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."

Web    
Le 18/06/2011 à 10h14

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 203
J"aime beaucoup ! c'est amusant :)

Mail MSN Web    
Le 18/06/2011 à 10h53

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Merci,

c'est même peut-être un gadget utile, pour justifier d'une petite méforme... :top :siffle :lol
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...! :d

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."

Web    
Le 18/06/2011 à 12h41

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 238
Beau travail ;)
____________________

MSN Yahoo Web    
Le 18/06/2011 à 15h22

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Merci les gars :lu

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

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."

Web    
Le 20/12/2011 à 08h04

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Fichier complet (avec les signes chinois) :

Gadget_Biorythm_Zodiac.zip
____________________
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    
Visiteur
Le 22/12/2011 à 16h11

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
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 22/12/2011 à 20h24

Libertynaute Expert

Groupe: Membre

Inscrit le: 19/02/2011
Messages: 767
Je ne vois aucun pb !?!? Ou bien c'est que tu es né avant 1905 ... :lol

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... :siffle

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... :lol



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."

Web    

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie