PureBasic

Code : Tout sélectionner

;============== MLD =================
;== 20/1/2014- modif le 31/08/2017 ==
;=========== PB 5.60 ================
;==============
;***constantes***
; calendrier  journalier
#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
;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
;boutons des mois
#btmp1 = 130:#btmm1 = 131
;commades générales
#btstop = 140:#bteffrv = 141:#bteffan = 142:#textefan = 143:#stringefan = 144:#btokefan = 145:#btimp = 146
;pour les autres boutons et gadgets
#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
;fichier
#Fag = 500
;images
#Image0 = 900:#Image1 = 901:#Image2 = 902:#Image3 = 903:#Image4 = 904
;ecran
#Ldef = 1280 :#Hdef = 800
;***fin constantes***

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$)
Declare detectext()

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 FontID7 = LoadFont(7,"MS san serif",12 ,#PB_Font_Bold|#PB_Font_Italic|#PB_Font_HighQuality)
Global EPframeH.d,EPframeL.d 

Macro coulfond(gad)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$CCCCCC)
EndMacro

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)
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)
If definecrht <> #Hdef
 hwq.d =  Dh * (definecrht /#Hdef)
 ProcedureReturn Hwq.d
Else
 Hwq.d =  Dh
 ProcedureReturn Hwq.d 
EndIf  
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

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)
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)
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)
 coulfond(x);coulfond gad
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)
 coulfond(y+110);coulfond gad
 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)
 coulfond(x);coulfond gad
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)
 coulfond(y+120);coulfond gad 
 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)
coulfond(8);coulfond gad
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,couleurs,font
 SetGadgetColor(x,#PB_Gadget_FrontColor,$0):resizefontecran(x,1)
Next
For xa = 16 To 51 Step 7
 SetGadgetColor(xa,#PB_Gadget_FrontColor,$0000FF):resizefontecran(xa,1)
Next
For xx = 60 To 101
  SetGadgetText(xx,"")
  SetGadgetColor(xx,#PB_Gadget_FrontColor,$707070):resizefontecran(xx,1) 
Next
For xb = 66 To 101 Step 7
  SetGadgetColor(xb,#PB_Gadget_FrontColor,$0000FF):resizefontecran(xb,1)
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))
coulfond(102);coulfond gad
;=== 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)
coulfond(5);coulfond gad
resizefontecran(5,2)
TextGadget(6,kl(167),kh(45),kl(163),kh(40),Str(jour),#PB_Text_Center)
coulfond(6);coulfond gad
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)
coulfond(7);coulfond gad
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,$FAFAFF) ;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))
 coulfond(128);coulfond gad
If indstrok.B = 1;permet d'afficher dans les strings
 controllect(tdate$)
EndIf
detectext();*************
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, "")
  Case 3
    SetGadgetColor(206,#PB_Gadget_FrontColor,$0000FF)
    SetGadgetText(206, "Impréssion impossible")
    Sleep_(3500)
    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()
If  DPIHZ = 600;prend en compte  le DPI imprimante 300 ou 600
 kdpi.l = 1
Else 
 kdpi.l = 2
EndIf 
If StartPrinting("agenda")
 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

Procedure detectext()
 anencours.w = Val(Right(tdate$,4))
 moisencours.w = Val(Mid(tdate$,3,2))
 anmoisencours$ = Right(tdate$,4) + Str(moisencours.w)
 anmoisencoursp1$ = Right(tdate$,4) + Str(moisencours.w+1)
 If ReadFile(#Fag, "Agd.mld")
    While Eof(#Fag) = 0   
      ligjour$ = ReadString(#Fag)
      Lectdat$ = Trim(StringField(ligjour$,2,Chr(191)))
      anmois$ = Left(Lectdat$,Len(Lectdat$)-2)
      If anmoisencours$ = anmois$
        jourenr$ = Right(Lectdat$,2)
        For x =10 To 51
         If Len(GetGadgetText(x))< 2 :ad$ = "0" + GetGadgetText(x):Else:ad$ = GetGadgetText(x):EndIf
         If ad$ = jourenr$
          SetGadgetFont(x, FontID(7))
          Break
         EndIf  
        Next  
      EndIf
      If anmoisencoursp1$ = anmois$
       jourenr$ = Right(Lectdat$,2)
       For xx =60 To 101
         If Len(GetGadgetText(xx))< 2 :ad2$ = "0" + GetGadgetText(xx):Else:ad2$ = GetGadgetText(xx):EndIf
         If ad2$ = jourenr$
          SetGadgetFont(xx, FontID(7))
          Break
         EndIf  
        Next  
      EndIf 
    Wend
    CloseFile(#Fag)
EndIf
EndProcedure  

OpenWindow(1,Xwp(0,1),ywp(0,1),Lw(500,3),Hw(750), "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)
coulfond(143);coulfond gad
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)
coulfond(206);coulfond gad
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)
 coulfond(z);coulfond gad
 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()
         Case #PB_EventType_Change;met la 1er lettre des strings en majuscule 
          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()
        Else
         CreateThread(@infos(),3) 
        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