PureBasic

Code annuler par MLD

Bonjour a tous

KCC Merci.

Agenda principalement destiné a des prises de rendez vous
L'enregistrement des lignes ou l'enregistrement des modifications est automatique.
Pour avoir l'ouverture d'une date un clique sur un des jours de l'un ou l'autre calendrier.
J'ai indiquer dans le code a quel bouton correspond les icones. a vous de mettre les votres.

Code : Tout sélectionner

;============== MLD =================
;== 20/1/2014- modif le 26/08/2017 ==
;=========== PB 5.60 ================
;==============
XIncludeFile "SGcal.pbi"
Enumeration 1 ; cal jour
#fenagd = 1
#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
#btimp = 146
;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
#texttrai3 = 202
#texttrai4 = 203
#texttrai5 = 204
#agimg = 205
#textinfo = 206
EndEnumeration

Enumeration 4
#Fag = 500
EndEnumeration
Enumeration 5;image
#Image0 = 900
#Image1 = 901
#Image2 = 902
#Image3 = 903
#Image4 = 904
EndEnumeration
CatchImage(#Image0, ?Image0)
CatchImage(#Image1, ?Image1)
CatchImage(#Image2, ?Image2)
CatchImage(#Image3, ?Image3)
CatchImage(#Image4, ?Image4)

DataSection
Image0: :IncludeBinary "47.ico";icone pour le bouton arrêt du logiciel
Image1: :IncludeBinary "283.ico";icone pour le bouton efface la ligne en cours
Image2: :IncludeBinary "315.ico";icone pour le bouton imprime
Image3: :IncludeBinary "378.ico";icone pour le bouton supprime une année
Image4: :IncludeBinary "380.ico";icone montre ou réveil matin pour faire joli 
EndDataSection

If DefaultPrinter() <> 0
 printer_DC.l = StartDrawing(PrinterOutput())
 If printer_DC.l
  DPIHZ.l = GetDeviceCaps_(printer_DC,#LOGPIXELSX)
 EndIf
 StopDrawing()
EndIf
Select DPIHZ.l
 Case 600
  Global FontID6 = LoadFont(6,"MS san serif",60 ,#PB_Font_HighQuality);pour imprimante
 Default 
  Global FontID6 = LoadFont(6,"MS san serif",30 ,#PB_Font_HighQuality);pour imprimante
EndSelect
Global tdate$
Global indstrok.B = 0
Global av$
Declare affcal(tdate$)
Declare moischif(nommois$)
Declare compare(av$,ap$)

Procedure Forme(win)
 Region = CreateRoundRectRgn_(0, 0, WindowWidth(win), WindowHeight(win), 20, 20) ; Création de la région pour faire une fenêtre avec les angles arrondis
 SetWindowRgn_(WindowID(win), Region, #True) ; On applique la région
 DeleteObject_(Region) ; On supprime la région
EndProcedure

Procedure ToolTipMic(WindowNumber.l,GadgetNumber.l,Text.s,couleurf)
  Protected Balloon.TOOLINFO
  Tooltip=CreateWindowEx_(0,"ToolTips_Class32","",#WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON,0,0,0,0,WindowID(WindowNumber),0,GetModuleHandle_(0),0)
  SendMessage_(Tooltip,#TTM_SETTIPTEXTCOLOR,GetSysColor_(#COLOR_INFOTEXT),0)
  SendMessage_(Tooltip,#TTM_SETTIPBKCOLOR,couleurf,0)
  SendMessage_(Tooltip,#TTM_SETMAXTIPWIDTH,0,180)
  Balloon\cbSize=SizeOf(TOOLINFO)
  Balloon\uFlags=#TTF_IDISHWND | #TTF_SUBCLASS
  If IsGadget(GadgetNumber)
    Balloon\hwnd=GadgetID(GadgetNumber)
    Balloon\uId=GadgetID(GadgetNumber)
  Else
    Balloon\hwnd=GadgetNumber
    Balloon\uId=GadgetNumber
  EndIf
  Balloon\lpszText=@Text
  SendMessage_(Tooltip,#TTM_ADDTOOL,0,@Balloon)
  ProcedureReturn Tooltip
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(tdate$,4) 
c$ = Mid(tdate$,3,2)
If Left(c$,1) = "0" :c$ = Mid(c$,2,1):EndIf 
d$ = Left(tdate$,2)
If Left(d$,1) = "0" :d$ = Mid(d$,2,1):EndIf 
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(tdate$)
For xz = 177 To 201 ;raz des strings
 SetGadgetText(xz,"")
Next 
Global av$ = ""
b$ = Right(tdate$,4) 
c$ = Mid(tdate$,3,2)
If Left(c$,1) = "0" :c$ = Mid(c$,2,1):EndIf 
d$ = Left(tdate$,2)
If Left(d$,1) = "0" :d$ = Mid(d$,2,1):EndIf 
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
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
ap$ = ""   
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.i DF(date.i);dimanche europe
  d.i = DayOfWeek(date)
  If d = 0 :d = 7 :EndIf ;dimanche, retourne 7 au lieu de 0
  ProcedureReturn d
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 =====
Date = Date(an,mois,jour,z1,z2,z3)
jda.i = DayOfYear(date): an.i = Year(date)
  DjanP.i = 4 - DF(Date(an, 1, 4, 0,0,0));dernier jour année précédente
  Djan.i = 4 - DF(Date(an,12,28, 0,0,0)) + DayOfYear(Date(an,12,31, 0,0,0));dernier jour de l'année
  If jda.i <= Djan.i
    If jda.i <= DjanP.i
     jda.i + DayOfYear(Date(an-1,12,31, 0,0,0));le 1er est dans la dernière semaine de l'année précédente.
     DjanP.i = 4 - DF(Date(an-1,1,4, 0,0,0))
    EndIf
    Weeknum = Round((jda-DjanP)/7, #PB_Round_Up)
  Else ;si non c'est dans la 1ere semaine
    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,kl(posh),kh(posv),kl(20),kh(15),"",#PB_Text_Center|#SS_NOTIFY)
 resizefontecran(x,1)
 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,kl(posh),kh(posjs),kl(20),kh(15),numsem$,#PB_Text_Center)
 resizefontecran(y,1)
 SetGadgetColor(y +110, #PB_Gadget_BackColor,$CCCCCC)
 posh = posh + poshl              
Next
TextGadget(102,kl(20),kh(posjs-16),kl(140),kh(15),"",#PB_Text_Center)
resizefontecran(102,1)
; ================ 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,kl(posh),kh(posv),kl(20),kh(15),"",#PB_Text_Center|#SS_NOTIFY)
 resizefontecran(x,1)
 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,kl(posh),kh(posjs),kl(20),kh(15),numsem$,#PB_Text_Center)
 SetGadgetColor(y +120, #PB_Gadget_BackColor,$CCCCCC)
 resizefontecran(y,1)
 posh = posh + poshl              
Next
TextGadget(128,kl(340),kh(posjs-16),kl(140),kh(15),"",#PB_Text_Center);mois
resizefontecran(128,1)
TextGadget(8,kl(167),kh(130),kl(163),kh(17),"",#PB_Text_Center)
resizefontecran(8,1)
SetGadgetColor(8,#PB_Gadget_FrontColor,$858585)
SetGadgetColor(8, #PB_Gadget_BackColor,$CCCCCC)
EndProcedure

Procedure affcal(tdate$)
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
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
;=========== 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)
;=== affichage du centre cal ========
TextGadget(5,kl(167),kh(15),kl(163),kh(30),StringField(Jourl$,DayOfWeek(Date(an,mois,jour,0,0,0))+1,","),#PB_Text_Center)
SetGadgetColor(5, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(5,2)
TextGadget(6,kl(167),kh(45),kl(163),kh(40),Str(jour),#PB_Text_Center)
SetGadgetColor(6, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(6,4)
SetGadgetColor(6, #PB_Gadget_FrontColor,$0045FF)  
TextGadget(7,kl(167),kh(100),kl(163),kh(25),StringField(Moisl$,numois.w,","),#PB_Text_Center)
SetGadgetColor(7, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(7,2)
;========================================== 
;===== calcul num semaine et nb jour ====== 
 SetGadgetText(8,calculnumjour(an,mois,jour,0,0,0))
;===========================================
;===== calcul la position du jour (aujourd'hui) ======
 If mois = Val(FormatDate("%mm",Date()))
  posjourj.w = (10 + premjour.w + Val(FormatDate("%dd",Date())) ) -2
  SetGadgetColor(posjourj.w,#PB_Gadget_FrontColor,$D61CB4) ;et color
 EndIf 
;============================================
;============ affiche cal droit ===============
; ;attention si cal gauche est a 12 mois rectifier la date
 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)
If indstrok.B = 1;permet d'afficher dans les strings
 controllect(tdate$)
EndIf
EndProcedure

Procedure clickcal(tdate$,gad,gd.s)
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" 
;=== affichage du centre cal ========
numois.w = Month(Date(an,mois,1,0,0,0))
If DayOfWeek(Date(an,mois,jour,0,0,0)) = 0
 cj.w = 1
Else
 cj.w = DayOfWeek(Date(an,mois,jour,0,0,0)) +1 
EndIf 
SetGadgetText(5,StringField(Jourl$,cj,","))
SetGadgetText(6,Str(jour))
SetGadgetText(7,StringField(Moisl$,numois.w,","))
;===== calcul num semaine et nb jour ====== 
SetGadgetText(8,calculnumjour(an,mois,jour,0,0,0))
;===========================================
Static posclik.w
Static colorbase
If posclik.w <> 0
 SetGadgetColor(posclik.w,#PB_Gadget_FrontColor,colorbase)
EndIf
posclik.w = gad
colorbase = GetGadgetColor(posclik.w,#PB_Gadget_FrontColor)
SetGadgetColor(posclik.w,#PB_Gadget_FrontColor,$00FFFF) 
If indstrok.B = 1;permet d'afficher dans les strings
 controllect(tdate$)
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 infos(*valeur)
Select *valeur
   Case 1 
    SetGadgetColor(206,#PB_Gadget_FrontColor,$0000FF)
    SetGadgetText(206, "Il manque une date ?")
    Sleep_(3500)
    SetGadgetText(206, "") 
   Case 2
    SetGadgetColor(206,#PB_Gadget_FrontColor,$006400)
    SetGadgetText(206, "Année supprimée")
    Sleep_(2500)
    HideGadget(143,1)
    SetGadgetText(144,"")
    HideGadget(144,1)
    HideGadget(145,1)
    SetActiveGadget(177)
    SetGadgetState(142,0)
    SetGadgetText(206, "")  
EndSelect
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)
       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())
 CreateThread(@infos(),2)     
Else
 CreateThread(@infos(),1) 
EndIf
EndProcedure

Procedure impjour(obget$)
If  DPIHZ = 600;prend en compte  le DPI imprimante 300 ou 600
 kdpi.l = 1
Else 
 kdpi.l = 2
EndIf  
If StartPrinting(objet$)
 htpagemm =  PrinterPageHeight() 
 margg = 229/kdpi.l
 margd = 229/kdpi.l
 margbas = htpagemm - (1145/kdpi.l)
 intlig = 68/kdpi.l
 deplig = 687/kdpi.l
 If StartDrawing(PrinterOutput())
  DrawingMode(#PB_2DDrawing_Transparent)
  FrontColor($0)
  DrawingFont(FontID(6))
  a$ = GetGadgetText(5) + " " + GetGadgetText(6) + " " + GetGadgetText(7)+ " " + Right(tdate$,4)
  DrawText(280/kdpi.l,229/kdpi.l,a$)
  lig = lig + (intlig*6)
  DrawText(margg ,lig ,"") 
  For z = 152 To 176
   lig = lig + (intlig*3)
   ip$ = GetGadgetText(z) + "   " + GetGadgetText(z + 25)
   DrawText(margg + (40/kdpi.l),lig ,ip$) 
  Next 
  EndIf
  StopDrawing()
  StopPrinting()  
EndIf  
EndProcedure
OpenWindow(1,Xwp(0,1),ywp(0,1),Lw(500,3),Hw(750,5), "Agenda",#PB_Window_BorderLess|#PB_Window_ScreenCentered  )
Forme(1)
StickyWindow(1, 1)
SetWindowColor(1,$CCCCCC)
cal()
tdate$ = FormatDate("%dd%mm%yyyy",Date())
affcal(tdate$)
TextGadget(150,kl(30),kh(157),kl(18),kh(1),"")
SetGadgetColor(150,#PB_Gadget_BackColor,$FF0000)
TextGadget(202,kl(132),kh(157),kl(76),kh(1),"")
SetGadgetColor(202,#PB_Gadget_BackColor,$FF0000)
TextGadget(203,kl(292),kh(157),kl(76),kh(1),"")
SetGadgetColor(203,#PB_Gadget_BackColor,$FF0000)
TextGadget(204,kl(452),kh(157),kl(18),kh(1),"")
SetGadgetColor(204,#PB_Gadget_BackColor,$FF0000)
TextGadget(151,kl(30),kh(702),kl(440),kh(1),"")
SetGadgetColor(151,#PB_Gadget_BackColor,$FF0000)
ImageGadget(205,kl(50),kh(180),kl(40),kh(40),ImageID(#Image4)) 
ButtonGadget(4,kl(210),kh(150),kl(80),kh(15),Chr(60)+ Chr(62))
ButtonGadget(130,kl(370),kh(150),kl(80),kh(15),Chr(62)+ Chr(62))
ButtonGadget(131,kl(50),kh(150),kl(80),kh(15),Chr(60)+ Chr(60))
ButtonImageGadget(140,kl(420),kh(707),kl(40),kh(40),ImageID(#Image0))
ToolTipMic(1,140, "Arrêt Agenda",$C9FBFD)
ButtonImageGadget(141,kl(380),kh(707),kl(40),kh(40),ImageID(#Image1))
ToolTipMic(1,141, "Efface la ligne en cours",$C9FBFD)
ButtonImageGadget(146,kl(340),kh(707),kl(40),kh(40),ImageID(#Image2))
ToolTipMic(1,146, "Imprime la journée",$C9FBFD)
ButtonImageGadget(142,kl(300),kh(707),kl(40),kh(40),ImageID(#Image3),#PB_Button_Toggle)
ToolTipMic(1,142,"Supprime une année",$C9FBFD)
TextGadget(143,kl(145),kh(712),kl(80),kh(15),"Supprime année")
resizefontecran(143,1)
HideGadget(143,1)
SetGadgetColor(143,#PB_Gadget_BackColor,$CCCCCC)
StringGadget(144,kl(145),kh(728),kl(80),kh(16),"",#PB_String_Numeric|#ES_CENTER|#PB_String_BorderLess)
resizefontecran(144,1)
HideGadget(144,1)
SendMessage_(GadgetID(144), #EM_LIMITTEXT,4, 0) 
SetGadgetColor(144,#PB_Gadget_BackColor,$2C2CEE)
ButtonGadget(145,kl(230),kh(718),kl(20),kh(20),"Ok")
HideGadget(145,1)
TextGadget(206,kl(10),kh(716),kl(100),kh(15),"",#PB_Text_Center)
resizefontecran(206,1)
SetGadgetColor(206,#PB_Gadget_BackColor,$CCCCCC)
hth.w = 155 : 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,kl(90),kh(hth.w),kl(20),kh(18),afh$,#PB_Text_Center)
 SetGadgetColor(z, #PB_Gadget_BackColor,$CCCCCC)
 SetGadgetColor(z, #PB_Gadget_FrontColor,colorh.f)
 StringGadget(z+25,kl(115),kh(hth.w-1),kl(300),kh(14),"",#PB_String_BorderLess)
 SendMessage_(GadgetID(z+25), #EM_LIMITTEXT, 60, 0) 
 SetGadgetColor(z+25, #PB_Gadget_BackColor,$D0D0D0)
 resizefontecran(z,1)
  resizefontecran(z+25,1)
Next
SetActiveGadget(177)
indstrok.B = 1 ;indique que les strings peuvent recevoir du texte
controllect(tdate$)
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)
        GestionCaret(GetActiveGadget()) 
       EndIf 
       If id_touche = 38  And  GetActiveGadget() > 177 And GetActiveGadget() <= 201 ;monte
        SetActiveGadget(GetActiveGadget()-1)
        GestionCaret(GetActiveGadget()) 
       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()
         Select EventType();met la 1er lettre des strings en majuscule 
         Case #PB_EventType_Change
          If Len(GetGadgetText(lignerv.w)) = 1
           SetGadgetText(lignerv.w,UCase(GetGadgetText(lignerv.w)))
           GestionCaret(GetActiveGadget()) 
          EndIf
        EndSelect 
       EndIf
       Select EventGadget() ; Gadgets
        Case 10 To 51 ;Gère les clics sur cal gauche
         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(Mid(GetGadgetText(102),1,Len(GetGadgetText(102))-5))
          an.w = Val(Right(GetGadgetText(102),4))
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
          clickcal(tdate$,EventGadget(),"g")   
         EndIf 
        Case 60 To 101;Gère les clics sur cal droit
         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(Mid(GetGadgetText(128),1,Len(GetGadgetText(128))-5))
          an.w = Val(Right(GetGadgetText(128),4))
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
          clickcal(tdate$,EventGadget(),"d")
         EndIf 
        Case 4;remet a la date du jour
         controlenr();enr s'il a lieu avant changement de date
         tdate$ = FormatDate("%dd%mm%yyyy",Date()) 
         affcal(tdate$)
        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))
         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$)  
        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))
         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$)
        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 146 ;imprime
         If DefaultPrinter()
         impjour("Agenda")
        Else
         Debug " impréssion impossible"
        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

code a compiler sous SGcal.pbi

Code : Tout sélectionner

#Ldef = 1280 :#Hdef = 800

Enumeration
  #Fdefend = 0
  #StatusBardefend = 4
  #ouvmpcab = 150
EndEnumeration  
Global FontID1 = LoadFont(1,"MS san serif",12 ,#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"MS san serif",18 ,#PB_Font_HighQuality)  
Global FontID3 = LoadFont(3,"MS san serif",14 ,#PB_Font_HighQuality) 
Global FontID4 = LoadFont(4,"MS san serif",36 ,#PB_Font_HighQuality) 
Global FontID5 = LoadFont(5,"MS san serif",28 ,#PB_Font_HighQuality) 
Global EPframeH.d,EPframeL.d 

Procedure resizefontecran(gad,num.b)
definecrlt.d = GetSystemMetrics_(#SM_CXSCREEN)
Select num
  Case 1
    If definecrlt.d > 1441
      
      SetGadgetFont(gad, FontID(1))
    EndIf  
  Case 2
    If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(2))
    Else
      SetGadgetFont(gad, FontID(3)) 
    EndIf
   Case 3
     If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(3))
    Else
      SetGadgetFont(gad, FontID(1)) 
    EndIf
   Case 4
     If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(4))
    Else
      SetGadgetFont(gad, FontID(5)) 
    EndIf 
  EndSelect      
EndProcedure

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
;>>>>>>>>>>>>>>>>>>>>>>>>> Fen auto >>>>>>>>>>>>>>>>>>>>>
Procedure Ywp(hp.d,optwp.i)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Select optwp.i
  Case 1
   ProcedureReturn 0 ;en haut de l'écran
 Case 2
  If definecrht.d = #Hdef
   ProcedureReturn hp * 1
  Else
   ProcedureReturn hp * (definecrht /#Hdef)
  EndIf 
EndSelect   
EndProcedure

Procedure Hw(Dh.d,optw.i)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Define tepSVEData.RECT:Define tpeAPPData.APPBARDATA
SHAppBarMessage_(5,tpeAPPData)
tepSVEData\top = tpeAPPData\rc\Top
tepSVEData\bottom = tpeAPPData\rc\Bottom
htTaskbarwin = tepSVEData\bottom - tepSVEData\top
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
GetTitleBarInfo_(WindowID(2000),pti)
If OSVersion() = #PB_OS_Windows_XP
 EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
 EPframeH = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
 EPframeL = WindowX(2000, #PB_Window_InnerCoordinate)  
EndIf  
Httitre.i = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select optw.i
 Case 1 ;fen avec titre et haut max
  Hbw.d = definecrht - (Httitre.i + EPframeH) 
  ProcedureReturn Hbw.d
 Case 2 ;fen avec titre et barre de tache win visible
  Hbw.d = definecrht - (htTaskbarwin  + Httitre.i  + EPframeH)
  ProcedureReturn Hbw.d
 Case 3 ; fen sans titre et hauteur max
  Hbw.d = definecrht
  ProcedureReturn Hbw.d 
 Case 4 ; fen sans titre et barre de tache win visible
  Hbw.d = definecrht - htTaskbarwin 
  ProcedureReturn Hbw.d
 Case 5 ;fen quelconque
  If definecrht <> #Hdef
   hwq.d =  Dh * (definecrht /#Hdef)
   ProcedureReturn Hwq.d
  Else
   Hwq.d =  Dh
   ProcedureReturn Hwq.d 
  EndIf  
EndSelect 
EndProcedure

Procedure XWp(lp.d,optwp.i)
definecrlt.d = GetSystemMetrics_(#SM_CXSCREEN)
Select optwp.i
 Case 1
  ProcedureReturn 2 ;a gauche
 Case 2
  If definecrlt <> #Ldef
   ProcedureReturn lp.d * (definecrlt /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf 
EndSelect 
EndProcedure

Procedure Lw(Dl.d,optw.i)
definecrlarg = GetSystemMetrics_(#SM_CXSCREEN)
Select optw.i
 Case 1 ;largeur max avec bordure
  Lbw.d = definecrlarg - ((EPframeL*2)+4)
  ProcedureReturn Lbw.d
 Case 2 ;largeur max sans bordure
  Lbw.d = definecrlarg
   ProcedureReturn Lbw.d
 Case 3 ;largeur quelconque
  If definecrlarg <> #Ldef
    hwq.d = Dl* (definecrlarg /#Ldef)
    ProcedureReturn hwq.d
  Else 
    Lbw.d = Dl
    ProcedureReturn Lbw.d
  EndIf
EndSelect  
EndProcedure

Procedure kh(Gh.d)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
If definecrht = #Hdef
 ProcedureReturn Gh 
Else 
 ProcedureReturn Gh * (definecrht/#Hdef)
EndIf 
EndProcedure

Procedure kl(Gl.d)
definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN) 
If definecrlarg = #Ldef
 ProcedureReturn Gl
Else
 ProcedureReturn Gl *(definecrlarg /#Ldef)
EndIf
EndProcedure

De rien, c'est sincère

Je vois qu'il y a encore eu embrouille à un endroit ou il n'y aurait jamais du en avoir.

Probablement du à une nouvelle preuve d'ouverture d'esprit ostentatoire

Bon, je réitère donc mes compliments, il a vraiment de la gueule ton calendrier, bravo

Kwai chang caine a écrit :De rien, c'est sincère

Je vois qu'il y a encore eu embrouille à un endroit ou il n'y aurait jamais du en avoir.
Probablement du à une nouvelle preuve d'ouverture d'esprit ostentatoire

Bon, je réitère donc mes compliments, il a vraiment de la gueule ton calendrier, bravo

je suppose que tu réponds a un message privé ?...en publique

car sinon, je ne comprends pas a quoi tu réponds ...

non , il n'y a pas eu d'embrouilles .....
explication :

je trouve bien que MLD partage un code , seulement c'est mieux qu'il soit compilable
il y a un manque d'icones .... j'ai trouvé des icônes, j'ai donc pu compiler le code de MLD
seulement, il ne c'est jamais lancé !! chez moi ça compile puis plus rien !!

au début j'ai crus a une erreur de Procedure inexistante ,mais en fait, la procedure est dans le Deuxième code ...
(on peut se poser la question de savoir pourquoi avoir mis des procedures a divers endroits... surtout en utilisant un Pbi .... mais c'est pas la seule question qui me taraudes a propos du code de MLD )

du coup j'en suis venu a dire que tu (Kcc) n'avais pas pu tester le code de MLD , puisque celui ci ne se compile pas chez moi .....
je ne vois pas de raisons, qui font que ça compile chez toi ...

dans le doute, j'ai testé sur l’éditeur Officiel , car il m'arrive d'avoir des différences avec EPB (rare cependant)

c'est confirmé , chez moi le code de MLD ne compile pas (Pb 5.60 x86 /x64) ! et sans erreur apparentes !!! ...
ça compile ... puis retour a l'editeur sans autre messages
j'ai désactivé mon anti virus et mon firewall pour voir, mas ça ne change rien ...bref ... il est possible que ça vienne de chez moi

la dessus , Falsam et moi-meme trouvions que de mélanger les deux codes (mon agenda , et celui de MLD) dans le meme topic
n'etait pas une bonne chose pour la lisibilité du forum ....

donc j'ai demandé a Falsam s'il pouvait séparer les deux topics .... comme ça au moins on sait de quel code on parle

tu vois, pas d'embrouilles ..(du moins de mon coté ) , juste de la clarté !

ps: les embrouilles viennent souvent des lanceurs d'alertes ...(surtout en messages privé pour pas qu'on puisse se défendre.... heureusement, de temps en temps, il y a des fuites

)

@MLD :
la question qui me taraude est la suivante :

pourquoi faire ceci :

Code : Tout sélectionner

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

puis en lisant la suite du code, je comprends que tu "nommes" tes enumerations
ainsi : Enumeration 1 ; Enumeration 2 , enumeration 3 ect ....
seulement il y a un truc que tu ne semble pas avoir compris

lorsque tu ecris : Enumeration 5 par exemple , ça signifie que tout ce qui suit sera enuméré a partir du chiffre 5
donc

Code : Tout sélectionner

enumeration 5 
#truc
#bidule
Endenumeration

#truc sera egale a 5
#bidule sera egale a 6 etc .....

sachant cela , j'ai du mal a comprendre a quoi ça sert de mettre entre Enumeration et EndEnumeration des constantes auquel tu attribues des valeurs !!??
ça n'a pas de sens en fait

soit tu fait :

Code : Tout sélectionner

Enumeration 111  ;jours de la semaine + mois
#txtjs1 ; =111
#txtjs2 ;= 112
#txtjs3 ;= 113
#txtjs4 ;= 114
#txtjs5 ;= 115
#txtjs6 ;= 116
#txtjs7 ;= 117
#txtjs8 ;= 118
#txt2js1; = 119
#txt2js2 ;= 120
#txt2js3 ;= 121
#txt2js4 ;= 122
#txt2js5 ;= 123
#txt2js6 ;= 124
#txt2js7 ;= 125
#txt2m ;= 126
#btmp1 ;= 127 ;bt des mois
#btmm1 ;= 128
EndEnumeration

soit tu fais :

Code : Tout sélectionner

;;; 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

@zorro

1° Je n'est eu aucun message privé avec KCC.
2° Je veux bien donner un code pour que tout le monde en profite, cela entre passionnés et a titre d'exemples. Mais pour les icones, vu que je suis assez nul en dessins, j'ai mis des heures pour
certaines pour les réalisées; De ce fait je ne souhaite pas les partagées. Ce qui m'étonne c'est que tu nas pas de bibliothèque d'icones perso.
3° Ce code ne pose aucun problème de compilation. KCC l'a certainement compilé, sinon il ne pouvait pas savoir qu'il ressemble a un vrai répertoire comme il y en a sur nombre de bureaux. Que d'autre
fassent un test, et donnent le résultat.
4° le code en pbi: A l'époque les modules n’existait pas dans PB. J'ai donc programmé des procédures dans un pbi. C'est procédures sont utilisées dans de nombreux autres logicels. Ceci m'évite de
réécrire plusieurs fois le même code. Il me semble que c'était la fonction première de pbi
5° Ma façon d'écrire les énumérations: Effectivement je peu faire autrement par exemple Enumeration ;1 cal jour au lieu de : Enumeration 1 ; cal jour. Mais a partir du moment ou chaque constantes a
une valeur cela n'a plus aucune importance.
Pourquoi numéroté des énumérations ? Simplement pour plus de clarté quand je reprend un code plusieurs mois après, voir plusieurs années.
Pourquoi numéroté directement les constantes, plutôt que de mettre des noms. Lorsque l'on produit des logiciel avec des dizaines de milliers de lignes, et plusieurs centaines de gadgets, il est
facile de cette manière de faire des boucles par exemple de coloration des gadgets, sans ce préoccupé comment PB a géré le numérotage des gadgets. Cela fait gagné a la fin de nombreuses lignes
de code Donc une plus grande rapidité.
Mais chacun code a sa manière.

6° Avant la manipulation de Falsam, J'aurai apprécié une demande de votre part (Falsam et toi). Simple correction

utiliser les tableaux !

Bonne chance.

MLD a écrit :
1° Je n'est eu aucun message privé avec KCC.

bon , on aurai pu le croire a en juger par la teneur des propos de Kcc ...

2° Je veux bien donner un code pour que tout le monde en profite, cela entre passionnés et a titre d'exemples. Mais pour les icones, vu que je suis assez nul en dessins, j'ai mis des heures pour
certaines pour les réalisées; De ce fait je ne souhaite pas les partagées. Ce qui m'étonne c'est que tu nas pas de bibliothèque d'icones perso.

Normal, j'utilise tres peu les icones, le text je trouve ça plus parlant

3° Ce code ne pose aucun problème de compilation. KCC l'a certainement compilé, sinon il ne pouvait pas savoir qu'il ressemble a un vrai répertoire comme il y en a sur nombre de bureaux. Que d'autre
fassent un test, et donnent le résultat.

c'est pourquoi j'ai précisé " il est possible que ça vienne de chez moi" ... mais c'est quand meme étonnant, oui j'aimerai aussi avoir d'autres retours....

4° le code en pbi: A l'époque les modules n’existait pas dans PB. J'ai donc programmé des procédures dans un pbi. C'est procédures sont utilisées dans de nombreux autres logicels. Ceci m'évite de
réécrire plusieurs fois le même code. Il me semble que c'était la fonction première de pbi

oui , le probleme c'est d'avoir mis des procedures qui sont appelées par le premier listing (le PBI) ,dans le deuxieme listing (le PB)
qui fait que si tu compile le Pbi seul , ben ça plante ... mais comme je l'ai dis, j'ai vu apres coup que la procedure manquante est dans le Pb
mais il n'empeche que ça compile pas chez moi (tout ton prg) , et que j'aimerai bien savoir pourquoi ...

5° Ma façon d'écrire les énumérations: Effectivement je peu faire autrement par exemple Enumeration ;1 cal jour au lieu de : Enumeration 1 ; cal jour. Mais a partir du moment ou chaque constantes a une valeur cela n'a plus aucune importance.

ben disons que dans ce cas => "chaque constantes a une valeur" : les mots Enumeration et Endenumeration, ne servent a rien ! ...

Pourquoi numéroté directement les constantes, plutôt que de mettre des noms. Lorsque l'on produit des logiciel avec des dizaines de milliers de lignes, et plusieurs centaines de gadgets, il est
facile de cette manière de faire des boucles par exemple de coloration des gadgets, sans ce préoccupé comment PB a géré le numérotage des gadgets. Cela fait gagné a la fin de nombreuses lignes
de code Donc une plus grande rapidité.

heu... si tu utilise les enumeration-EndEnumeration ,sans preciser leur valeurs les contantes se suivent, donc l'emploi des boucles est possible aussi ....

exemple :

Code : Tout sélectionner

Enumeration 1
Riri
Fifi
Loulou
EndEnumeration

tu retrouvera les valeurs des constantes avec une boucle
For i=1 to 3 :debug i :Next i

si tu utilises :

Code : Tout sélectionner

Enumeration 100
Riri
Fifi
Loulou
EndEnumeration

tu retrouvera les valeurs des constantes avec une boucle
For i=100 to 103 :debug i :Next i

CQFD !

Mais chacun code a sa manière.

oui c'est clair

6° Avant la manipulation de Falsam, J'aurai apprécié une demande de votre part (Falsam et toi). Simple correction

pour cette dernière remarque,j’hésite a répondre ... bon tant pis on verra comment tu va le prendre

mon petit monsieur , avant de donner des leçons de savoir vivre, il faut aussi balayer devant sa porte
en effet, c'est quand meme toi qui sans me demander mon avis est venu "Poluer" mon topic Agenda , avec ton code Mal foutu qui ne se compile pas !

(en esperant quand meme que tu pratiques/comprends un peu l'ironie )

@celtic88 : t'a fumé quoi ? , en fait, tu parles de quoi ?

Hi , Zorro

j ai remarquer dans son code qu'il ya beaucoup de variable qui peuvent être stocker dans un tableau pour que le code soit moins groo et plus beau à lire

...

et pour ne rien t cacher oui j ai fumé quelque joints

,

https://www.youtube.com/watch?v=CHekNnySAfM

@Zorro

Spécialement pour ta machine infernale qui ne compile que ce qui est [basic]

J'ai modifier mon code et virer les icônes. J'ai nommé ce logiciel AgendaSimple. J'ai failli écrire Agenda_pour_les_nulls.

Moi aussi Monseigneur j'ai de l'humour.

Je préfère le 1er code mais.....

Code : Tout sélectionner

;===============================
;MLD AgendaSimple le 28/8/2017==
;Compilation PB5.60           ==
;===============================
Enumeration 1 ; cal jour
#fenagd = 1
#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
#btimp = 146
;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
#texttrai3 = 202
#texttrai4 = 203
#texttrai5 = 204
#agimg = 205
#textinfo = 206
EndEnumeration

Enumeration 4
#Fag = 500
EndEnumeration

Global FontID1 = LoadFont(1,"MS san serif",12 ,#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"MS san serif",18 ,#PB_Font_HighQuality)  
Global FontID3 = LoadFont(3,"MS san serif",14 ,#PB_Font_HighQuality) 
Global FontID4 = LoadFont(4,"MS san serif",36 ,#PB_Font_HighQuality) 
Global FontID5 = LoadFont(5,"MS san serif",28 ,#PB_Font_HighQuality) 
Global EPframeH.d,EPframeL.d 
#Ldef = 1280:#Hdef = 800

If DefaultPrinter() <> 0
 printer_DC.l = StartDrawing(PrinterOutput())
 If printer_DC.l
  DPIHZ.l = GetDeviceCaps_(printer_DC,#LOGPIXELSX)
 EndIf
 StopDrawing()
EndIf
Select DPIHZ.l
 Case 600
  Global FontID6 = LoadFont(6,"MS san serif",60 ,#PB_Font_HighQuality);pour imprimante
 Default 
  Global FontID6 = LoadFont(6,"MS san serif",30 ,#PB_Font_HighQuality);pour imprimante
EndSelect
Global tdate$
Global indstrok.B = 0
Global av$
Declare affcal(tdate$)
Declare moischif(nommois$)
Declare compare(av$,ap$)

Procedure resizefontecran(gad,num.b)
definecrlt.d = GetSystemMetrics_(#SM_CXSCREEN)
Select num
  Case 1
    If definecrlt.d > 1441
      
      SetGadgetFont(gad, FontID(1))
    EndIf  
  Case 2
    If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(2))
    Else
      SetGadgetFont(gad, FontID(3)) 
    EndIf
   Case 3
     If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(3))
    Else
      SetGadgetFont(gad, FontID(1)) 
    EndIf
   Case 4
     If definecrlt.d > 1400
      SetGadgetFont(gad, FontID(4))
    Else
      SetGadgetFont(gad, FontID(5)) 
    EndIf 
  EndSelect      
EndProcedure

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
;>>>>>>>>>>>>>>>>>>>>>>>>> Fen auto >>>>>>>>>>>>>>>>>>>>>
Procedure Ywp(hp.d,optwp.i)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Select optwp.i
  Case 1
   ProcedureReturn 0 ;en haut de l'écran
 Case 2
  If definecrht.d = #Hdef
   ProcedureReturn hp * 1
  Else
   ProcedureReturn hp * (definecrht /#Hdef)
  EndIf 
EndSelect   
EndProcedure

Procedure Hw(Dh.d,optw.i)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Define tepSVEData.RECT:Define tpeAPPData.APPBARDATA
SHAppBarMessage_(5,tpeAPPData)
tepSVEData\top = tpeAPPData\rc\Top
tepSVEData\bottom = tpeAPPData\rc\Bottom
htTaskbarwin = tepSVEData\bottom - tepSVEData\top
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
GetTitleBarInfo_(WindowID(2000),pti)
If OSVersion() = #PB_OS_Windows_XP
 EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
 EPframeH = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
 EPframeL = WindowX(2000, #PB_Window_InnerCoordinate)  
EndIf  
Httitre.i = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select optw.i
 Case 1 ;fen avec titre et haut max
  Hbw.d = definecrht - (Httitre.i + EPframeH) 
  ProcedureReturn Hbw.d
 Case 2 ;fen avec titre et barre de tache win visible
  Hbw.d = definecrht - (htTaskbarwin  + Httitre.i  + EPframeH)
  ProcedureReturn Hbw.d
 Case 3 ; fen sans titre et hauteur max
  Hbw.d = definecrht
  ProcedureReturn Hbw.d 
 Case 4 ; fen sans titre et barre de tache win visible
  Hbw.d = definecrht - htTaskbarwin 
  ProcedureReturn Hbw.d
 Case 5 ;fen quelconque
  If definecrht <> #Hdef
   hwq.d =  Dh * (definecrht /#Hdef)
   ProcedureReturn Hwq.d
  Else
   Hwq.d =  Dh
   ProcedureReturn Hwq.d 
  EndIf  
EndSelect 
EndProcedure

Procedure XWp(lp.d,optwp.i)
definecrlt.d = GetSystemMetrics_(#SM_CXSCREEN)
Select optwp.i
 Case 1
  ProcedureReturn 2 ;a gauche
 Case 2
  If definecrlt <> #Ldef
   ProcedureReturn lp.d * (definecrlt /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf 
EndSelect 
EndProcedure

Procedure Lw(Dl.d,optw.i)
definecrlarg = GetSystemMetrics_(#SM_CXSCREEN)
Select optw.i
 Case 1 ;largeur max avec bordure
  Lbw.d = definecrlarg - ((EPframeL*2)+4)
  ProcedureReturn Lbw.d
 Case 2 ;largeur max sans bordure
  Lbw.d = definecrlarg
   ProcedureReturn Lbw.d
 Case 3 ;largeur quelconque
  If definecrlarg <> #Ldef
    hwq.d = Dl* (definecrlarg /#Ldef)
    ProcedureReturn hwq.d
  Else 
    Lbw.d = Dl
    ProcedureReturn Lbw.d
  EndIf
EndSelect  
EndProcedure

Procedure kh(Gh.d)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
If definecrht = #Hdef
 ProcedureReturn Gh 
Else 
 ProcedureReturn Gh * (definecrht/#Hdef)
EndIf 
EndProcedure

Procedure kl(Gl.d)
definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN) 
If definecrlarg = #Ldef
 ProcedureReturn Gl
Else
 ProcedureReturn Gl *(definecrlarg /#Ldef)
EndIf
EndProcedure 

Procedure Forme(win)
 Region = CreateRoundRectRgn_(0, 0, WindowWidth(win), WindowHeight(win), 20, 20) ; Création de la région pour faire une fenêtre avec les angles arrondis
 SetWindowRgn_(WindowID(win), Region, #True) ; On applique la région
 DeleteObject_(Region) ; On supprime la région
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(tdate$,4) 
c$ = Mid(tdate$,3,2)
If Left(c$,1) = "0" :c$ = Mid(c$,2,1):EndIf 
d$ = Left(tdate$,2)
If Left(d$,1) = "0" :d$ = Mid(d$,2,1):EndIf 
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(tdate$)
For xz = 177 To 201 ;raz des strings
 SetGadgetText(xz,"")
Next 
Global av$ = ""
b$ = Right(tdate$,4) 
c$ = Mid(tdate$,3,2)
If Left(c$,1) = "0" :c$ = Mid(c$,2,1):EndIf 
d$ = Left(tdate$,2)
If Left(d$,1) = "0" :d$ = Mid(d$,2,1):EndIf 
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
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
ap$ = ""   
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.i DF(date.i);dimanche europe
  d.i = DayOfWeek(date)
  If d = 0 :d = 7 :EndIf ;dimanche, retourne 7 au lieu de 0
  ProcedureReturn d
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 =====
Date = Date(an,mois,jour,z1,z2,z3)
jda.i = DayOfYear(date): an.i = Year(date)
  DjanP.i = 4 - DF(Date(an, 1, 4, 0,0,0));dernier jour année précédente
  Djan.i = 4 - DF(Date(an,12,28, 0,0,0)) + DayOfYear(Date(an,12,31, 0,0,0));dernier jour de l'année
  If jda.i <= Djan.i
    If jda.i <= DjanP.i
     jda.i + DayOfYear(Date(an-1,12,31, 0,0,0));le 1er est dans la dernière semaine de l'année précédente.
     DjanP.i = 4 - DF(Date(an-1,1,4, 0,0,0))
    EndIf
    Weeknum = Round((jda-DjanP)/7, #PB_Round_Up)
  Else ;si non c'est dans la 1ere semaine
    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,kl(posh),kh(posv),kl(20),kh(15),"",#PB_Text_Center|#SS_NOTIFY)
 resizefontecran(x,1)
 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,kl(posh),kh(posjs),kl(20),kh(15),numsem$,#PB_Text_Center)
 resizefontecran(y,1)
 SetGadgetColor(y +110, #PB_Gadget_BackColor,$CCCCCC)
 posh = posh + poshl              
Next
TextGadget(102,kl(20),kh(posjs-16),kl(140),kh(15),"",#PB_Text_Center)
resizefontecran(102,1)
; ================ 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,kl(posh),kh(posv),kl(20),kh(15),"",#PB_Text_Center|#SS_NOTIFY)
 resizefontecran(x,1)
 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,kl(posh),kh(posjs),kl(20),kh(15),numsem$,#PB_Text_Center)
 SetGadgetColor(y +120, #PB_Gadget_BackColor,$CCCCCC)
 resizefontecran(y,1)
 posh = posh + poshl              
Next
TextGadget(128,kl(340),kh(posjs-16),kl(140),kh(15),"",#PB_Text_Center);mois
resizefontecran(128,1)
TextGadget(8,kl(167),kh(130),kl(163),kh(17),"",#PB_Text_Center)
resizefontecran(8,1)
SetGadgetColor(8,#PB_Gadget_FrontColor,$858585)
SetGadgetColor(8, #PB_Gadget_BackColor,$CCCCCC)
EndProcedure

Procedure affcal(tdate$)
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
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
;=========== 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)
;=== affichage du centre cal ========
TextGadget(5,kl(167),kh(15),kl(163),kh(30),StringField(Jourl$,DayOfWeek(Date(an,mois,jour,0,0,0))+1,","),#PB_Text_Center)
SetGadgetColor(5, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(5,2)
TextGadget(6,kl(167),kh(45),kl(163),kh(40),Str(jour),#PB_Text_Center)
SetGadgetColor(6, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(6,4)
SetGadgetColor(6, #PB_Gadget_FrontColor,$0045FF)  
TextGadget(7,kl(167),kh(100),kl(163),kh(25),StringField(Moisl$,numois.w,","),#PB_Text_Center)
SetGadgetColor(7, #PB_Gadget_BackColor,$CCCCCC)
resizefontecran(7,2)
;========================================== 
;===== calcul num semaine et nb jour ====== 
 SetGadgetText(8,calculnumjour(an,mois,jour,0,0,0))
;===========================================
;===== calcul la position du jour (aujourd'hui) ======
 If mois = Val(FormatDate("%mm",Date()))
  posjourj.w = (10 + premjour.w + Val(FormatDate("%dd",Date())) ) -2
  SetGadgetColor(posjourj.w,#PB_Gadget_FrontColor,$D61CB4) ;et color
 EndIf 
;============================================
;============ affiche cal droit ===============
; ;attention si cal gauche est a 12 mois rectifier la date
 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)
If indstrok.B = 1;permet d'afficher dans les strings
 controllect(tdate$)
EndIf
EndProcedure

Procedure clickcal(tdate$,gad,gd.s)
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" 
;=== affichage du centre cal ========
numois.w = Month(Date(an,mois,1,0,0,0))
If DayOfWeek(Date(an,mois,jour,0,0,0)) = 0
 cj.w = 1
Else
 cj.w = DayOfWeek(Date(an,mois,jour,0,0,0)) +1 
EndIf 
SetGadgetText(5,StringField(Jourl$,cj,","))
SetGadgetText(6,Str(jour))
SetGadgetText(7,StringField(Moisl$,numois.w,","))
;===== calcul num semaine et nb jour ====== 
SetGadgetText(8,calculnumjour(an,mois,jour,0,0,0))
;===========================================
Static posclik.w
Static colorbase
If posclik.w <> 0
 SetGadgetColor(posclik.w,#PB_Gadget_FrontColor,colorbase)
EndIf
posclik.w = gad
colorbase = GetGadgetColor(posclik.w,#PB_Gadget_FrontColor)
SetGadgetColor(posclik.w,#PB_Gadget_FrontColor,$00FFFF) 
If indstrok.B = 1;permet d'afficher dans les strings
 controllect(tdate$)
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 infos(*valeur)
Select *valeur
   Case 1 
    SetGadgetColor(206,#PB_Gadget_FrontColor,$0000FF)
    SetGadgetText(206, "Il manque une date ?")
    Sleep_(3500)
    SetGadgetText(206, "") 
   Case 2
    SetGadgetColor(206,#PB_Gadget_FrontColor,$006400)
    SetGadgetText(206, "Année supprimée")
    Sleep_(2500)
    HideGadget(143,1)
    SetGadgetText(144,"")
    HideGadget(144,1)
    HideGadget(145,1)
    SetActiveGadget(177)
    SetGadgetState(142,0)
    SetGadgetText(206, "")  
EndSelect
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)
       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())
 CreateThread(@infos(),2)     
Else
 CreateThread(@infos(),1) 
EndIf
EndProcedure

Procedure impjour(obget$)
If  DPIHZ = 600;prend en compte  le DPI imprimante 300 ou 600
 kdpi.l = 1
Else 
 kdpi.l = 2
EndIf  
If StartPrinting(objet$)
 htpagemm =  PrinterPageHeight() 
 margg = 229/kdpi.l
 margd = 229/kdpi.l
 margbas = htpagemm - (1145/kdpi.l)
 intlig = 68/kdpi.l
 deplig = 687/kdpi.l
 If StartDrawing(PrinterOutput())
  DrawingMode(#PB_2DDrawing_Transparent)
  FrontColor($0)
  DrawingFont(FontID(6))
  a$ = GetGadgetText(5) + " " + GetGadgetText(6) + " " + GetGadgetText(7)+ " " + Right(tdate$,4)
  DrawText(280/kdpi.l,229/kdpi.l,a$)
  lig = lig + (intlig*6)
  DrawText(margg ,lig ,"") 
  For z = 152 To 176
   lig = lig + (intlig*3)
   ip$ = GetGadgetText(z) + "   " + GetGadgetText(z + 25)
   DrawText(margg + (40/kdpi.l),lig ,ip$) 
  Next 
  EndIf
  StopDrawing()
  StopPrinting()  
EndIf  
EndProcedure
OpenWindow(1,Xwp(0,1),ywp(0,1),Lw(500,3),Hw(750,5), "Agenda",#PB_Window_BorderLess|#PB_Window_ScreenCentered  )
Forme(1)
StickyWindow(1, 1)
SetWindowColor(1,$CCCCCC)
cal()
tdate$ = FormatDate("%dd%mm%yyyy",Date())
affcal(tdate$)
TextGadget(150,kl(30),kh(157),kl(18),kh(1),"")
SetGadgetColor(150,#PB_Gadget_BackColor,$FF0000)
TextGadget(202,kl(132),kh(157),kl(76),kh(1),"")
SetGadgetColor(202,#PB_Gadget_BackColor,$FF0000)
TextGadget(203,kl(292),kh(157),kl(76),kh(1),"")
SetGadgetColor(203,#PB_Gadget_BackColor,$FF0000)
TextGadget(204,kl(452),kh(157),kl(18),kh(1),"")
SetGadgetColor(204,#PB_Gadget_BackColor,$FF0000)
TextGadget(151,kl(30),kh(702),kl(440),kh(1),"")
SetGadgetColor(151,#PB_Gadget_BackColor,$FF0000)
ButtonGadget(4,kl(210),kh(150),kl(80),kh(15),Chr(60)+ Chr(62))
ButtonGadget(130,kl(370),kh(150),kl(80),kh(15),Chr(62)+ Chr(62))
ButtonGadget(131,kl(50),kh(150),kl(80),kh(15),Chr(60)+ Chr(60))
ButtonGadget(140,kl(450),kh(707),kl(40),kh(40),"Stop")
ButtonGadget(141,kl(390),kh(707),kl(60),kh(40),"Efface la ligne")
ButtonGadget(146,kl(310),kh(707),kl(80),kh(40),"Imprime la journée")
ButtonGadget(142,kl(240),kh(707),kl(70),kh(40),"Efface une année",#PB_Button_Toggle)
TextGadget(143,kl(120),kh(712),kl(80),kh(15),"Efface année")
resizefontecran(143,1)
HideGadget(143,1)
SetGadgetColor(143,#PB_Gadget_BackColor,$CCCCCC)
StringGadget(144,kl(110),kh(728),kl(80),kh(16),"",#PB_String_Numeric|#ES_CENTER|#PB_String_BorderLess)
resizefontecran(144,1)
HideGadget(144,1)
SendMessage_(GadgetID(144), #EM_LIMITTEXT,4, 0) 
SetGadgetColor(144,#PB_Gadget_BackColor,$2C2CEE)
ButtonGadget(145,kl(200),kh(718),kl(20),kh(20),"Ok")
HideGadget(145,1)
TextGadget(206,kl(10),kh(716),kl(100),kh(15),"",#PB_Text_Center)
resizefontecran(206,1)
SetGadgetColor(206,#PB_Gadget_BackColor,$CCCCCC)
hth.w = 155 : 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,kl(90),kh(hth.w),kl(20),kh(18),afh$,#PB_Text_Center)
 SetGadgetColor(z, #PB_Gadget_BackColor,$CCCCCC)
 SetGadgetColor(z, #PB_Gadget_FrontColor,colorh.f)
 StringGadget(z+25,kl(115),kh(hth.w-1),kl(300),kh(14),"",#PB_String_BorderLess)
 SendMessage_(GadgetID(z+25), #EM_LIMITTEXT, 60, 0) 
 SetGadgetColor(z+25, #PB_Gadget_BackColor,$D0D0D0)
 resizefontecran(z,1)
  resizefontecran(z+25,1)
Next
SetActiveGadget(177)
indstrok.B = 1 ;indique que les strings peuvent recevoir du texte
controllect(tdate$)
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)
        GestionCaret(GetActiveGadget()) 
       EndIf 
       If id_touche = 38  And  GetActiveGadget() > 177 And GetActiveGadget() <= 201 ;monte
        SetActiveGadget(GetActiveGadget()-1)
        GestionCaret(GetActiveGadget()) 
       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()
         Select EventType();met la 1er lettre des strings en majuscule 
         Case #PB_EventType_Change
          If Len(GetGadgetText(lignerv.w)) = 1
           SetGadgetText(lignerv.w,UCase(GetGadgetText(lignerv.w)))
           GestionCaret(GetActiveGadget()) 
          EndIf
        EndSelect 
       EndIf
       Select EventGadget() ; Gadgets
        Case 10 To 51 ;Gère les clics sur cal gauche
         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(Mid(GetGadgetText(102),1,Len(GetGadgetText(102))-5))
          an.w = Val(Right(GetGadgetText(102),4))
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
          clickcal(tdate$,EventGadget(),"g")   
         EndIf 
        Case 60 To 101;Gère les clics sur cal droit
         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(Mid(GetGadgetText(128),1,Len(GetGadgetText(128))-5))
          an.w = Val(Right(GetGadgetText(128),4))
          tdate$ = FormatDate("%dd%mm%yyyy",Date(an,mois,jour,0,0,0)) 
          clickcal(tdate$,EventGadget(),"d")
         EndIf 
        Case 4;remet a la date du jour
         controlenr();enr s'il a lieu avant changement de date
         tdate$ = FormatDate("%dd%mm%yyyy",Date()) 
         affcal(tdate$)
        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))
         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$)  
        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))
         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$)
        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 146 ;imprime
         If DefaultPrinter()
         impjour("Agenda")
        Else
         Debug " impréssion impossible"
        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

Peut être avec beaucoup de chance tu compileras???????????????????

PS j'avais bien compris le message de celtic88 sans rien fumer.

Je la trouve très bien l'autre version et je n'ai pas peiné pour trouver 4 icônes sur la toile et je n'oublie pas de te remercier du partage de ton chef-d'œuvre.

@MICOUTE

Merci. Content de te parler de nouveaux. J'ai bien suivit l'évolution de tes programme et je me doit de te féliciter pour les progrès énorme que tu fait dans la programmation avec PB

haaa ! maintenant ça compile chez moi

Effectivement, jolie interface ..

je vois que tu as inclue les heures , c'est pas mal en fait ...

juste un truc, lorsqu'on entre un text, dans une journée , ce serai bien de colorer cette journée
de sorte qu'un coup d'oeil au calendrier permet de savoir qu'il y a un (ou plusieurs) evenements pour tel ou tel jours ....
..

Mais , ça marche

franchement, meme sans icones, je prefere un code qui fonctionne tout de suite ..
Merci pour ce partage

je vais continuer tranquillement le miens faut que j'ajoute les Alarmes
je vais utiliser un system un peu different pour ce qui concerne les heures ..

@ Zorro

Ok Ton idée est bonne. je vais voir.
Bon courage pour ton agenda, Je suis cela avec intérêt.

@Zorro
Bon, bah j'me suis gourré, je te dois de plates excuses

En fait, je suis arrivé et c'était tout séparé, et un peu merdiquement, mon texte modifié et mes compliments supprimés

Alors, je me suis dit le "Dobrard" (tu te rappelles, le "Dobro" et le "Dobrard"

) il nous a encore fait un coup de calcaire, en envoyant paitre le MLD comme quoi il avait trollé son post, etc ...ou un truc "sacome"

Alors que je trouvais l'ambiance bon enfant, chacun présentait son calendrier, comme FALSAM j'avais trouvé ça cool

D'ailleurs sur le US, c'est coutume courante que "quinquin" recouche un code sur un autre, soit parce qu'il est meilleur (ou pas), soit pour le faire connaitre

En fin de compte, je me suis trompé et j'en suis content, car c'est pas cool de virer "quinquin" qui n'a que de bonnes intention de son POST, on est pas des JB13

Enfin c'est mon avis, ça a toujours été comme ça sur les forums PB, et on a dit à maintes reprises que cette liberté était une des choses qui leurs donnaient leurs valeurs
Donc excuse moi de t'avoir jugé trop vite, mais bon....y'a du vécu avec le Dobrard

Maintenant c'est un peu vrai comme le dit MLD, que de demander gentiment....c’était pas trop non plus

Pour le code...alors là..j'y comprend rien.

C'est la première fois que ça marche chez moi et pas chez les autres, c'est d'habitude toujours le contraire...ça fait du bien

Maintenant tout comme MICOUTE, j'ai testé le premier code sur un W10 X64 et le second sur W7 X86 et dans les deux cas aucun problème, j'ai des icônes persos qui remplacent les codes d'essais comme celui ci

En attendant, merci à tous de vos généreux partages

PureBasic

Un autre agenda..

Un autre agenda..

Re: un Agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..

Re: Un autre agenda..