Agenda annuel

Micoute · Message par **Micoute** » mar. 19/févr./2013 11:51

Bonjour à tous,

Je souhaiterais faire un agenda annuel où j'ai un DateGadget (#ChoixDate) et 3 boutons pour manipuler la date courante, le premier bouton recule la date d'un jour à chaque clic (hier, avant-hier, ...), le second nous affiche le date du jour et le troisième avance la date d'un jour à chaque clic (demain, après-demain, ...), j'ai essayé de faire :

Procedure JourMoins1()
Jour2-1
SetGadgetState(#ChoixDate, Date(Annee,Mois,Jour2,0,0,0))
EndProcedure

mais ça ne fonctionne pas.

Je vous remercie de votre aide qui me sera d'un grand secours.

Je peux vous donner du code, mais il est très incomplet.

MLD · Message par **MLD** » mer. 20/févr./2013 8:58

Salut a mon voisin de l'autre coté de la baie du mont st Michel

Regarde ceci.

Code : Tout sélectionner

;====== MLD ===
;== 15/2/2012 =
;=== PB 4.61 ==
;==============

Enumeration 1 ; cal jour
#fenagd = 1
#btJm1 = 2
#btJp1 = 3
#btajd = 4
#text1 = 5
#text2 = 6
#text3 = 7
#text4 = 8

#txtj1 = 10
#txtj2 = 11
#txtj3 = 12
#txtj4 = 13
#txtj5 = 14
#txtj6 = 15
#txtj7 = 16
#txtj8 = 17
#txtj9 = 18
#txtj10 = 19
#txtj11 = 20
#txtj12 = 21
#txtj13 = 22
#txtj14 = 23
#txtj15 = 24
#txtj16 = 25
#txtj17 = 26
#txtj18 = 27
#txtj19 = 28
#txtj20 = 29
#txtj21 = 30
#txtj22 = 31
#txtj23 = 32
#txtj24 = 33
#txtj25 = 34
#txtj26 = 35
#txtj27 = 36
#txtj28 = 37
#txtj29 = 38
#txtj30 = 39
#txtj31 = 40
#txtj32 = 41
#txtj33 = 42
#txtj34 = 43
#txtj35 = 44
#txtj36 = 45
#txtj37 = 46
#txtj38 = 47
#txtj39 = 48
#txtj40 = 49
#txtj41 = 50
#txtj42 = 51

#txtj43 = 60
#txtj44 = 61
#txtj45 = 62
#txtj46 = 63
#txtj47 = 64
#txtj48 = 65
#txtj49 = 66
#txtj50 = 67
#txtj51 = 68
#txtj52 = 69
#txtj53 = 70
#txtj54 = 71
#txtj55 = 72
#txtj56 = 73
#txtj57 = 74
#txtj58 = 75
#txtj59 = 76
#txtj60 = 77
#txtj61 = 78
#txtj62 = 79
#txtj63 = 80
#txtj64 = 81
#txtj65 = 82
#txtj66 = 83
#txtj67 = 84
#txtj68 = 85
#txtj69 = 86
#txtj70 = 87
#txtj71 = 88
#txtj72 = 89
#txtj73 = 90
#txtj74 = 91
#txtj75 = 92
#txtj76 = 93
#txtj77 = 94
#txtj78 = 88
#txtj79 = 89
#txtj80 = 90
#txtj81 = 91
#txtj82 = 92
#txtj83 = 93
#txtj84 = 94
#txtj85 = 95
#txtj86 = 96
#txtj87 = 97
#txtj88 = 98
#txtj89 = 99
#txtj90 = 100
#txtj91 = 101

#txtm = 102
EndEnumeration
Enumeration 2 ;jours de la semaine + mois
#txtjs1 = 111
#txtjs2 = 112
#txtjs3 = 113
#txtjs4 = 114
#txtjs5 = 115
#txtjs6 = 116
#txtjs7 = 117
#txtjs8 = 118

#txt2js1 = 120
#txt2js2 = 121
#txt2js3 = 122
#txt2js4 = 123
#txt2js5 = 124
#txt2js6 = 125
#txt2js7 = 126
#txt2m = 128
#btmp1 = 130;bt des mois
#btmm1 = 131
EndEnumeration

Enumeration 3;agenda
#btstop = 140
#bteffrv = 141 ; bt efface un rendez-vous
#bteffan = 142 ;bt efface année
#textefan = 143
#stringefan = 144
#btokefan = 145
;pour ls autres bt et gads
#texttrai1 = 150
#texttrai2 = 151
#texth8 = 152
#texth830 = 153
#texth9 = 154
#texth930 = 155
#texth10 = 156
#texth1030 = 157
#texth11 = 158
#texth1130 = 159
#texth12 = 160
#texth1230 = 161
#texth13 = 162
#texth1330 = 163
#texth14 = 164
#texth1430 = 165
#texth15 = 166
#texth1530 = 167
#texth16 = 168
#texth1630 = 169
#texth17 = 170
#texth1730 = 171
#texth18 = 172
#texth1830 = 173
#texth19 = 174
#texth1930 = 175
#texth20 = 176

#stringh1 = 177
#stringh2 = 178
#stringh3 = 179
#stringh4 = 180
#stringh5 = 181
#stringh6 = 182
#stringh7 = 183
#stringh8 = 184
#stringh9 = 185
#stringh10 = 186
#stringh11 = 187
#stringh12 = 188
#stringh13 = 189
#stringh14 = 190
#stringh15 = 191
#stringh16 = 192
#stringh17 = 193
#stringh18 = 194
#stringh19 = 195
#stringh20 = 196
#stringh21 = 197
#stringh22 = 198
#stringh23 = 199
#stringh24 = 200
#stringh25 = 201
EndEnumeration

Enumeration 4
#Fag = 500
EndEnumeration
Global FontID1 = LoadFont(1,"MS san serif",18 ,#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"MS san serif",32 ,#PB_Font_HighQuality)
Global FontID3 = LoadFont(3,"MS san serif",10 ,#PB_Font_HighQuality)
Global tdate$
Global indstrok.B = 0
Global av$
Declare affcal(tdate$,ind.b)
Declare moischif(nommois$)
Declare compare(av$,ap$)
Procedure GestionCaret(Gadget) ; Gestion du caret dans stringGadget
      SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)    
      y = Debut_Position
      Texte.s = GetGadgetText(Gadget)
      x =Len(Texte)
      Texte2.s = Left(Texte,y ) + Right(Texte,x-y)
      SendMessage_(GadgetID(Gadget), #EM_SETSEL, x, x) 
EndProcedure
;=========== fichier =================
Global numenrfag.w
Procedure.l nbenrfag(fichier$)
ReadFile(#Fag,fichier$)
lectlig$ = ReadString(#Fag)
nbenrligne.l = Lof(#Fag)/(Len(lectlig$)+2)
CloseFile(#Fag)
ProcedureReturn nbenrligne.l
EndProcedure

Procedure.l enrfag(Numenrfich.w)
a$ = Str(Numenrfich.w) + Space(5 - Len(Str(Numenrfich.w)))+Chr(191)
b$ = Right(GetGadgetText(102),4) 
c$ = Str(moischif(Trim(Mid(GetGadgetText(102),1,Len(GetGadgetText(102))-4))))
d$ = GetGadgetText(6)
e$ = (b$ + c$ + d$) + Space(8 - (Len(b$)+Len(c$)+Len(d$)))+Chr(191)
ligjour$ = a$ + e$
For zz = 177 To 201 
ligjour$ = ligjour$ + GetGadgetText(zz)+ Space(60 - Len(GetGadgetText(zz)))+Chr(191)
Next 
OpenFile(#Fag,"Agd.mld")
Nbenrfich.w = (Lof(#Fag)/(Len(ligjour$)+2))
If Numenrfich.w > Nbenrfich.w
 FileSeek(#Fag,Lof(#Fag));positionne a la fin du fichier
Else
 FileSeek(#Fag,(Numenrfich.w * 1542)-1542);positionne sur le début de la bonne ligne 
EndIf 
WriteStringN(#Fag,ligjour$);enregistre
CloseFile(#Fag)
EndProcedure 

Procedure controllect()
For xz = 177 To 201 ;raz des strings
 SetGadgetText(xz,"")
Next 
b$ = Right(GetGadgetText(102),4) 
c$ = Str(moischif(Trim(Mid(GetGadgetText(102),1,Len(GetGadgetText(102))-4))))
d$ = GetGadgetText(6)
e$ = b$ + c$ + d$
Okenr.b = 0
If ReadFile(#Fag, "Agd.mld")
    While Eof(#Fag) = 0   
      ligjour$ = ReadString(#Fag)
      If e$ = Trim(StringField(ligjour$,2,Chr(191)))
       okenr = 1
       Break
      EndIf 
    Wend
    CloseFile(#Fag)
EndIf
If okenr = 1 ;des enregistrement a cette date existe    
   indstring.w = 2 ;remplis les strings
   For zz = 177 To 201 
    indstring = indstring +1 
    SetGadgetText(zz,Trim(StringField(ligjour$,indstring ,Chr(191))))
    GestionCaret(zz) 
   Next
   Global numenrfag.w = Val(StringField(ligjour$,1,Chr(191))) ; indique le numéro de ligne enregistrée
   For zx = 177 To 201 
     av$ = av$ + Trim(GetGadgetText(zx)); remplis une variable avec les strings pour comparaison avant enr
   Next 
Else
   For zx = 177 To 201 
     av$ = av$ + Trim(GetGadgetText(zx)); remplis une variable avec les strings pour comparaison avant enr
   Next 
   numenrfag.w = 0  
EndIf
SetActiveGadget(177) 
EndProcedure

Procedure controlenr()
OpenFile(#Fag,"Agd.mld") ;pour la première utilisation du logiciel
If nbenrfag("Agd.mld")= 0
 enrfag(1)
EndIf
For zx = 177 To 201 ;remplis une variable avec les strings pour comparaison avant enr (pour <> avec la var lecture)
   ap$ = ap$ + Trim(GetGadgetText(zx))
Next
If numenrfag.w = 0  ; c'est un nouvel enr
  If compare(av$,ap$) = 1
   numenrfag.w = nbenrfag("Agd.mld") +1
   enrfag(numenrfag.w)
  EndIf
Else
  If compare(av$,ap$) = 1 ;c'est une modif des RV
   enrfag(numenrfag.w)
  EndIf
EndIf   
EndProcedure

;======================================
Procedure bissextile(annee) 
    If (annee % 4 = 0 And annee % 100 <> 0) Or annee % 400 = 0
        bissextile= #True
    Else
        bissextile = #False
    EndIf
    ProcedureReturn bissextile
EndProcedure 

Procedure Ffix(j,m)
Dt$ = Str(j) + "/" + Str(m)
Select Dt$
 Case "1/1" ;1er janvier
  indf.B = 1 
 Case "1/5" ;1er mai
  indf.B = 1
 Case "8/5" ;8 mai
  indf.B = 1
 Case "14/7" ;14 juillet
  indf.B = 1 
 Case "15/8" ;15 aout
  indf.B = 1 
 Case "1/11" ;1 Novembre
  indf.B = 1
 Case "11/11" ;11 novembre
  indf.B = 1 
 Case "25/12" ;25 décembre
  indf.B = 1
 Default
  indf.B = 0
EndSelect
ProcedureReturn indf.B         
EndProcedure

Procedure calulftrelig(jr,mr,y)
datref$ = FormatDate("%dd%mm%yyyy",Date(y,mr,jr,0,0,0)) 
;dimanche de paque
c.w = y / 100 
n.w =  (y % 19) 
k.w = (c - 17) / 25 
b.w = c /4 
e.w = (c - k) / 3 
f.w = c - b - e + (19 * n) + 15 
h.w =  (f % 30) 
p.w = h / 28 
q.w = 29 / (h + 1)
r.w = (21 - n) / 11 
i.w = h - (p * (1 - (p * q * r)))
s.w = y / 4 
t.w = c / 4 
u.w = y + s + i + 2 - c + t 
j.w =  (u % 7) 
w.w = (i - j + 40) / 44  
m.w = 3 + w  
x.w = m / 4 
d.w = i - j + 28 - (31 * x)
 Dimanchepaque$ = FormatDate("%dd%mm%yyyy",Date(y,m,d,0,0,0))  
 lundipaque$ = FormatDate("%dd%mm%yyyy",AddDate(Date(y,m,d,0,0,0),#PB_Date_Day,1))
 jeudiasc$ = FormatDate("%dd%mm%yyyy",AddDate(Date(y,m,d,0,0,0),#PB_Date_Day,39))
 dimanchepent$ =  FormatDate("%dd%mm%yyyy",AddDate(Date(y,m,d,0,0,0),#PB_Date_Day,49))
 lundipent$ = FormatDate("%dd%mm%yyyy",AddDate(Date(y,m,d,0,0,0),#PB_Date_Day,50)) 
 indftm.b = 0
 If datref$ = Dimanchepaque$
  indftm.b = 1
 EndIf 
 If datref$ = lundipaque$
  indftm.b = 1
 EndIf 
 If datref$ = jeudiasc$
  indftm.b = 1
 EndIf
 If datref$ = dimanchepent$
  indftm.b = 1
 EndIf  
 If datref$ = lundipent$
  indftm.b = 1
 EndIf
ProcedureReturn indftm.b
EndProcedure
Procedure.s calculnumjour(an,mois,jour,z1,z2,z3);calcul le nombre de jour écoulé a la date indiqué et ce qui reste
;======= calcul jour ==========
 If bissextile(an) = 1
  totalj.w = 366
 Else
  totalj.w = 365
 EndIf
nbjt.w = DayOfYear(Date(an, mois, jour, 0, 0, 0))
diffjour.w = totalj - nbjt.w  
;======= calcul num semaine =====
Weeknum=0
For i=1 To DayOfYear(Date(an, mois, jour, 0, 0, 0))
 day_of_week=DayOfWeek(AddDate( Date(Year(Date()),01,01,1,1,1), #PB_Date_Day , i-1))
 If i = 1 And day_of_week <> 1 : Weeknum = 1 : EndIf
 If day_of_week= 1 And i <> 1 
   Weeknum=Weeknum+1
 EndIf
Next i
If Weeknum = 53 :Weeknum = 1 : EndIf 
ProcedureReturn "Semaine: " + Str(Weeknum) + "    " + "Jour: " + Str(nbjt.w) + "/" + Str(totalj) + "-" +  Str(diffjour)
EndProcedure

Procedure calculnbjm(an,mois,jour,z1,z2,z3)
Select mois  
 Case 1,3,5,7,8,10,12 ; calcul le nombre de jours par mois
  nbjpm.w = 31
 Case 2
  If bissextile(an) = 1 ; tien compte des années bissextiles
   nbjpm.w = 29
  Else
   nbjpm.w = 28
  EndIf  
 Case 4,6,9,11
  nbjpm.w = 30
EndSelect
ProcedureReturn  nbjpm.w
EndProcedure

Procedure cal()
; ============ cal gauche================
posh = 20
poshl = 21
posv = 50
posvh = 16
posjs = 34
posD.w = 0
For x = 10 To 51
 posD = posD +1
 Select x
  Case 11 To 16 ,18 To 23 ,25 To 30,32 To 37, 39 To 44,46 To 51
   posh = posh + poshl 
 EndSelect
 If x = 17 Or x = 24 Or x = 31 Or x = 38 Or x = 45
  posv = posv + posvh
  posh = 20
 EndIf  
 TextGadget(x,posh,posv,20,15,"",#PB_Text_Center|#SS_NOTIFY)
 SetGadgetFont(x, FontID(3))
 SetGadgetColor(x, #PB_Gadget_BackColor,$CCCCCC)
Next
posh = 20
For y= 1 To 7
 numsem$ = StringField("Lu,Ma,Me,Je,Ve,Sa,Di",y,",")
 TextGadget(y +110,posh,posjs,20,15,numsem$,#PB_Text_Center)
 SetGadgetColor(y +110, #PB_Gadget_BackColor,$CCCCCC)
 posh = posh + poshl              
Next
TextGadget(102,20,posjs-16,140,15,"",#PB_Text_Center)
; ================ cal droit =====================
posh = 340
poshl = 21
posv = 50
posvh = 16
posjs = 34
posD = 0
For x = 60 To 101
 posD = posD +1
 Select x
  Case 61 To 66 ,68 To 73 ,75 To 80,82 To 87, 89 To 94, 96 To 101;place les textgad
   posh = posh + poshl 
 EndSelect
 If x = 67 Or x = 74 Or x = 81 Or x = 88 Or x = 95;1er textgad de la ligne
  posv = posv + posvh
  posh = 340
 EndIf  
 TextGadget(x,posh,posv,20,15,"",#PB_Text_Center)
 SetGadgetFont(x, FontID(3))
 SetGadgetColor(x, #PB_Gadget_BackColor,$CCCCCC)
Next
posh = 340
For y= 1 To 7
 numsem$ = StringField("Lu,Ma,Me,Je,Ve,Sa,Di",y,",");inscrit les jours
 TextGadget(y +120,posh,posjs,20,15,numsem$,#PB_Text_Center)
 SetGadgetColor(y +120, #PB_Gadget_BackColor,$CCCCCC)
 posh = posh + poshl              
Next
TextGadget(128,340,posjs-16,140,15,"",#PB_Text_Center);mois
EndProcedure

Procedure affcal(tdate$,ind.b)
jour.w = Val(Left(tdate$,2));transforme la date en chiffres
mois.w = Val(Mid(tdate$,3,2))
an.w = Val(Right(tdate$,4))
Moisl$ = "JANVIER,FEVRIER,MARS,AVRIL,MAI,JUIN,JUILLET,AOUT,SEPTEMBRE,OCTOBRE,NOVEMBRE,DECEMBRE" 
Jourl$ = "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" 
For x = 10 To 51
 SetGadgetText(x,"");raz des textgad et couleurs
 SetGadgetColor(x,#PB_Gadget_FrontColor,$0)
Next
For xa = 16 To 51 Step 7
 SetGadgetColor(xa,#PB_Gadget_FrontColor,$0000FF)
Next
If ind.b = 1
 For xx = 60 To 101
  SetGadgetText(xx,"")
  SetGadgetColor(xx,#PB_Gadget_FrontColor,$707070) 
 Next
  For xb = 66 To 101 Step 7
  SetGadgetColor(xb,#PB_Gadget_FrontColor,$0000FF)
 Next
EndIf   
;=========== affiche cal gauche ===========
premjour.w = DayOfWeek(Date(an,mois,1,0,0,0));Calcul le 1er jour du mois
If premjour.w = 0 :premjour.w  = 7 :EndIf ; pour le placement donne le num 7 au dimanche au lieu de 0
nbjpm.w = calculnbjm(an,mois,jour,0,0,0)
jm = 0
For j = 10 + (premjour.w -1)  To (10 + nbjpm.w + (premjour.w-1))-1; remplis les textgads en tenant compte du 
 jm = jm +1                ; premier jour du mois
 SetGadgetText(j,Str(jm))
 If Ffix(jm,mois) = 1 Or calulftrelig(jm,mois,an)
  SetGadgetColor(J,#PB_Gadget_FrontColor,$0000FF)
 EndIf  
Next
numois.w = Month(Date(an,mois,jour,0,0,0))
SetGadgetText(102,StringField(Moisl$,numois.w,",")+ " " + Str(an))
SetGadgetColor(102,#PB_Gadget_BackColor,$CCCCCC)
TextGadget(5,167,15,163,30,StringField(Jourl$,DayOfWeek(Date(an,mois,jour,0,0,0))+1,","),#PB_Text_Center)
SetGadgetColor(5, #PB_Gadget_BackColor,$CCCCCC)
SetGadgetFont(5, FontID(1))
TextGadget(6,167,45,163,40,Str(jour),#PB_Text_Center)
SetGadgetColor(6, #PB_Gadget_BackColor,$CCCCCC)
SetGadgetFont(6, FontID(2))
SetGadgetColor(6, #PB_Gadget_FrontColor,$0045FF)  
TextGadget(7,167,100,163,25,StringField(Moisl$,numois.w,","),#PB_Text_Center)
SetGadgetColor(7, #PB_Gadget_BackColor,$CCCCCC)
SetGadgetFont(7, FontID(1))
Static empljour.w
Static colorbase  
If empljour.w <> 0
 SetGadgetColor(empljour.w,#PB_Gadget_FrontColor,colorbase)
EndIf
empljour.w = (10 + premjour.w + jour) -2
colorbase = GetGadgetColor(empljour.w,#PB_Gadget_FrontColor)
SetGadgetColor(empljour,#PB_Gadget_FrontColor,$D61CB4)
TextGadget(8,167,130,163,17,calculnumjour(an,mois,jour,0,0,0),#PB_Text_Center)
SetGadgetColor(8,#PB_Gadget_FrontColor,$858585)
SetGadgetColor(8, #PB_Gadget_BackColor,$CCCCCC)
If indstrok.B = 1;permet d'afficher dans les strings
 controllect()
EndIf 
;============ affiche cal droit ===============
;attention si cal gauche est a 12 mois rectifier la date
If ind = 1
 If mois.w = 12
  jour.w = Val(Left(tdate$,2))
  mois.w = 0 
  an.w = an.w + 1 
 EndIf
  premjour2.w = DayOfWeek(Date(an,mois+1,1,0,0,0))
 If premjour2.w = 0 :premjour2.w = 7 :EndIf 
 mois = mois +1
 nbjpm2.w = calculnbjm(an,mois,jour,0,0,0)
 jmd = 0
 For jd = 60 + (premjour2.w-1) To (60 + nbjpm2.w + (premjour2.w-1))-1
  jmd = jmd +1 
  SetGadgetText(jd,Str(jmd)) 
  If Ffix(jmd,mois) = 1 Or calulftrelig(jmd,mois,an)
  SetGadgetColor(Jd,#PB_Gadget_FrontColor,$0000FF)
 EndIf 
 Next
 numois2.w = Month(Date(an,mois,1,0,0,0))
 SetGadgetText(128,StringField(Moisl$,numois2.w,",")+ " " + Str(an))
 SetGadgetColor(128, #PB_Gadget_BackColor,$CCCCCC)
EndIf
EndProcedure

Procedure moischif(nommois$)
Select nommois$
 Case "JANVIER"
  numero.w = 1
 Case "FEVRIER"
  numero.w = 2
 Case "MARS"
  numero.w = 3
 Case "AVRIL"
  numero.w = 4
 Case "MAI"
  numero.w = 5
 Case "JUIN"
  numero.w = 6
 Case "JUILLET"
  numero.w = 7
 Case "AOUT"
  numero.w = 8
 Case "SEPTEMBRE"
  numero.w = 9
 Case "OCTOBRE"
  numero.w = 10
 Case "NOVEMBRE"
  numero.w = 11
 Case "DECEMBRE"
  numero.w = 12 
EndSelect  
ProcedureReturn numero.w 
EndProcedure

Procedure compare(av$,ap$)
indenr.B = 0
If Len(av$) <> Len(ap$)
 indenr = 1
Else
 For zz.w = 1 To Len(av$)
  If Mid(av$,zz,1) <> Mid(ap$,zz,1) 
    indenr = 1
    Break
  EndIf
 Next
EndIf
ProcedureReturn indenr       
EndProcedure

Procedure supan(an$)
If an$ <> ""
 indgr.w = 0
 Dim Tabrv.s(0) 
 If ReadFile(#Fag, "Agd.mld")
    While Eof(#Fag) = 0   
      ligjour$ = ReadString(#Fag)
      If an$ <> Trim(Left(Trim(StringField(ligjour$,2,Chr(191))),4))
       indgr = indgr + 1 
       ReDim Tabrv(indgr)
       Debug ligjour$
       Tabrv.s(indgr) = ligjour$
     EndIf 
    Wend
 EndIf    
 CloseFile(#Fag)
 CreateFile(#Fag, "Agd.mld")
 For zy.w = 1 To ArraySize(Tabrv())
  WriteStringN(#Fag,Tabrv(zy))
 Next 
 FreeArray(Tabrv.s())
 HideGadget(143,1)
 HideGadget(144,1)
 HideGadget(145,1)
 SetActiveGadget(177)
 SetGadgetState(142,0)    
EndIf 
EndProcedure
OpenWindow(1, 0, 0, 500, 750, "",#PB_Window_BorderLess|#PB_Window_ScreenCentered  )
StickyWindow(1, 1)
SetWindowColor(1,$CCCCCC)
cal()
tdate$ = FormatDate("%dd%mm%yyyy",Date())
affcal(tdate$,1)
TextGadget(150,30,150,440,1,"")
SetGadgetColor(150,#PB_Gadget_BackColor,$FF0000)
TextGadget(151,30,705,440,1,"")
SetGadgetColor(151,#PB_Gadget_BackColor,$FF0000)
ButtonGadget(2,200,715,40,30,Chr(60))
ButtonGadget(4,240,715,40,30,Chr(60)+ Chr(62))
ButtonGadget(3,280,715,40,30,Chr(62))
ButtonGadget(130,320,715,40,30,Chr(62)+ Chr(62))
ButtonGadget(131,160,715,40,30,Chr(60)+ Chr(60))
ButtonGadget(140,400,715,40,30,"Stop")
ButtonGadget(141,360,715,40,30,"Eff R-V")
ButtonGadget(142,120,715,40,30,"Eff An",#PB_Button_Toggle)
TextGadget(143,5,712,80,15,"Supprime année")
HideGadget(143,1)
SetGadgetColor(143,#PB_Gadget_BackColor,$CCCCCC)
StringGadget(144, 5,730,80,15,"",#PB_String_Numeric|#ES_CENTER)
HideGadget(144,1)
SendMessage_(GadgetID(144), #EM_LIMITTEXT,4, 0) 
SetGadgetColor(144,#PB_Gadget_BackColor,$2C2CEE)
ButtonGadget(145,90,720,20,20,"Ok")
HideGadget(145,1)
hth.w = 150 : Hr.w = 7: d.B = 0
For z = 152 To 176
 hth.w = hth.w + 20 
  If d.b = 0
   d.B = 1
   Hr.w = Hr +1 
   afh$ = Str(Hr.w)+ "h"
   hth.w = hth.w + 2
   colorh.f = $CD0000
  Else
   d.B = 0
   afh$ = "30"
   colorh.f = $5E798B
  EndIf 
 TextGadget(z,90,hth.w,20,18,afh$,#PB_Text_Center)
 SetGadgetColor(z, #PB_Gadget_BackColor,$CCCCCC)
 SetGadgetColor(z, #PB_Gadget_FrontColor,colorh.f )
 StringGadget(z+25,115,hth.w-1,300,14,"",#PB_String_BorderLess)
 SendMessage_(GadgetID(z+25), #EM_LIMITTEXT, 60, 0) 
 SetGadgetColor(z+25, #PB_Gadget_BackColor,$D0D0D0)
Next
SetActiveGadget(177)
indstrok.B = 1 ;indique que les strings peuvent recevoir du texte
controllect()
Repeat
   Event = WaitWindowEvent()
     Select Event
      Case #WM_KEYDOWN ; déplacement dans les strings avec flèches haute et basse
       id_touche = EventwParam()
       If id_touche = 40  And GetActiveGadget() => 177 And GetActiveGadget() < 201 ;descend
        SetActiveGadget(GetActiveGadget()+1)
       EndIf 
       If id_touche = 38  And  GetActiveGadget() > 177 And GetActiveGadget() <= 201 ;monte
        SetActiveGadget(GetActiveGadget()-1)
       EndIf 
      Case #WM_LBUTTONDOWN
       SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0);pour bouger la fenetre
      Case #PB_Event_Gadget
       If EventGadget() => 177 And EventGadget()<= 201 ;scrute et indique qu'elle ligne de RV est active
         lignerv.w = EventGadget()
       EndIf
       Select EventGadget() ; Gadgets
        Case 10 To 51
         If GetGadgetText(EventGadget()) <> "" ; pas de clik sur case vide  
          controlenr();enr s'il a lieu avant changement de date
          jour.w = Val(GetGadgetText(EventGadget()))
          mois.w = moischif(GetGadgetText(7))
          an.w = Val(Right(GetGadgetText(102),4))
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
          affcal(tdate$,ind.b)   
         EndIf 
        Case 2
         controlenr();enr s'il a lieu avant changement de date
         ind.b = 0
         jour.w = Val(Left(tdate$,2));transforme la date en chiffres
         mois.w = Val(Mid(tdate$,3,2))
         an.w = Val(Right(tdate$,4))
         jour = jour -1
         If jour = 0
           ind.b = 1 
           mois = mois - 1 : jour = calculnbjm(an,mois,1,0,0,0)
          If mois = 0 
           mois = 12
           an = an -1 
           jour = calculnbjm(an,mois,1,0,0,0)
          EndIf 
         EndIf
         tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
         affcal(tdate$,ind.b)     
        Case 3
         controlenr();enr s'il a lieu avant changement de date
         ind = 0
         jour.w = Val(Left(tdate$,2));transforme la date en chiffres
         mois.w = Val(Mid(tdate$,3,2))
         an.w = Val(Right(tdate$,4))
         nbjpm.w = calculnbjm(an,mois,jour,0,0,0)
         jour = jour +1 
         If jour > nbjpm
          ind.b = 1 
          jour = 1 : mois = mois + 1 
          If mois > 12 : mois = 1:an = an +1: jour = 1:EndIf
         EndIf
         tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
         affcal(tdate$,ind.b)  
        Case 4
         controlenr();enr s'il a lieu avant changement de date
         tdate$ = FormatDate("%dd%mm%yyyy",Date()) 
         affcal(tdate$,1)
        Case 130
         controlenr();enr s'il a lieu avant changement de date
         jour.w = Val(Left(tdate$,2));transforme la date en chiffres
         mois.w = Val(Mid(tdate$,3,2))
         an.w = Val(Right(tdate$,4))
         ind.b = 1 
         jour = 1 : mois = mois + 1 
         If mois > 12 : mois = 1:an = an +1: jour = 1:EndIf
         dateact$ = FormatDate("%dd%mm%yyyy",Date())
         anact.w = Val(Right(dateact$,4))
         moiact.w = Val(Mid(dateact$,3,2))
         If anact = an And moiact = mois
          tdate$ = FormatDate("%dd%mm%yyyy",Date()) 
         Else 
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
         EndIf 
         affcal(tdate$,ind.b)  
        Case 131 
         controlenr();enr s'il a lieu avant changement de date
         jour.w = Val(Left(tdate$,2));transforme la date en chiffres
         mois.w = Val(Mid(tdate$,3,2))
         an.w = Val(Right(tdate$,4))
         ind.b = 1 
         mois = mois - 1 : jour = calculnbjm(an,mois,1,0,0,0)
         If mois = 0 
          mois = 12
          an = an -1 
          jour = calculnbjm(an,mois,1,0,0,0)
         EndIf
         dateact$ = FormatDate("%dd%mm%yyyy",Date())
         anact.w = Val(Right(dateact$,4))
         moiact.w = Val(Mid(dateact$,3,2))
         If anact = an And moiact = mois
          tdate$ = FormatDate("%dd%mm%yyyy",Date()) 
         Else 
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
         EndIf 
         affcal(tdate$,ind.b)
        Case 141 ;efface un R-V
         SetGadgetText(lignerv.w,"")
         SetActiveGadget(lignerv.w)
        Case 142 ;efface une année(prépare)
         If GetGadgetState(142) = 1
          HideGadget(143,0)
          HideGadget(144,0)
          HideGadget(145,0)
          SetActiveGadget(144)
         Else
          HideGadget(143,1)
          HideGadget(144,1)
          HideGadget(145,1)
          SetActiveGadget(177)
         EndIf 
        Case 145 ;efface une année
         supan(GetGadgetText(144)) 
        Case 140;bt stop 
         controlenr();enr s'il a lieu avant arrêt 
         CloseWindow(1)
         DestroyWindow_(Tooltip.l)
         Break  
       EndSelect
   EndSelect
Until Event = #PB_Event_CloseWindow
End

Micoute · Message par **Micoute** » mer. 20/févr./2013 9:11

Bonjour MLD,

je suis encore complètement subjugué par ce joli travail, j'avais oublié qu'on pouvait faire des choses aussi belles avec PB, je ne pourrai jamais te remercier assez et du coup, je me sens redevable. Je pense que comme moi, tu aimes les belles choses et quand c'est beau, ça marche forcément mieux.

En tous cas, je te remercie encore du fond du coeur.

Michel L.

MLD · Message par **MLD** » mer. 20/févr./2013 15:15

@Micoute
Merci. Bien entendu les boutons en bas peuvent êtres remplacés par des boutons avec images.
C'est ce que j'ai fait pour le logiciel complet. Car cet agenda sert dans un logiciel de gestion de cabinet d'avocats.

Micoute · Message par **Micoute** » mer. 20/févr./2013 17:32

Bonjour et merci MLD,

Justement, je pensais le relooker, maintenant que j'ai compris le principe, je vais même peut-être le refondre pour qu'il soit personnalisé.

Je suis très content d'être de retour sur PB !

Et bravo aussi à tous les membres de ce forum.

PureBasic

Agenda annuel

Agenda annuel

Re: Agenda annuel

Re: Agenda annuel

Re: Agenda annuel

Re: Agenda annuel