Un autre agenda..
Un autre agenda..
Code annuler par MLD
Dernière modification par MLD le sam. 26/août/2017 15:49, modifié 1 fois.
Re: un Agenda..
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 a compiler sous SGcal.pbi
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 : 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
- Kwai chang caine
- Messages : 6962
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Re: Un autre agenda..
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 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
Re: Un autre agenda..
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
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
#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
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
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Un autre agenda..
@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
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
Re: Un autre agenda..
bon , on aurai pu le croire a en juger par la teneur des propos de Kcc ...MLD a écrit :
1° Je n'est eu aucun message privé avec KCC.
Normal, j'utilise tres peu les icones, le text je trouve ça plus parlant2° 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.
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....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.
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)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
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 ...
ben disons que dans ce cas => "chaque constantes a une valeur" : les mots Enumeration et Endenumeration, ne servent a rien ! ...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.
heu... si tu utilise les enumeration-EndEnumeration ,sans preciser leur valeurs les contantes se suivent, donc l'emploi des boucles est possible aussi ....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é.
exemple :
Code : Tout sélectionner
Enumeration 1
Riri
Fifi
Loulou
EndEnumeration
For i=1 to 3 :debug i :Next i
si tu utilises :
Code : Tout sélectionner
Enumeration 100
Riri
Fifi
Loulou
EndEnumeration
For i=100 to 103 :debug i :Next i
CQFD !
oui c'est clairMais chacun code a sa manière.
pour cette dernière remarque,j’hésite a répondre ... bon tant pis on verra comment tu va le prendre6° Avant la manipulation de Falsam, J'aurai apprécié une demande de votre part (Falsam et toi). Simple correction
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 ?
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Un autre agenda..
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 ,
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 ,
.....i Love Pb
Re: Un autre agenda..
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Un autre agenda..
@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.....
Peut être avec beaucoup de chance tu compileras???????????????????
PS j'avais bien compris le message de celtic88 sans rien fumer.
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.
Re: Un autre agenda..
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.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Un autre agenda..
@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
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
Re: Un autre agenda..
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 ..
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 ..
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Re: Un autre agenda..
@ Zorro
Ok Ton idée est bonne. je vais voir.
Bon courage pour ton agenda, Je suis cela avec intérêt.
Ok Ton idée est bonne. je vais voir.
Bon courage pour ton agenda, Je suis cela avec intérêt.
- Kwai chang caine
- Messages : 6962
- Inscription : sam. 23/sept./2006 18:32
- Localisation : Isere
Re: Un autre agenda..
@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
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