Récré Météo

Programmation d'applications complexes
Avatar de l’utilisateur
MLD
Messages : 1103
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Récré Météo

Message par MLD »

Bonjour a tous
Une petit code extrait d'un projet plus vaste, sympa a diffuser.
Le principe repose sur la diffusion des bulletins météo d'aéroports toute les 1/2 heure.
Sivous voulez savoir le temps qu'il fait chez votre Grand mère de Nice, ou la Tata Alsacienne, ceci est fait pour vous.
Choisissez l'aéroport le plus proche par un click sur un des boutons ou il y a un petit avion et faite votre choix dans la liste. Idem pour les alentours.
Vous pouvez enregistrer la base météo choisie,et la récupérée.
Toute les demie heure une mise a jour sera faite si vous avez internet disponible.
Attention pour un bon fonctionnement il faut compiler en EXE a cause de While WindowEvent() : Wend qui ne fonctionne pas avec le débogueur ???
Amusez vous bien et modifiés ce code a loisir.
Merçi a Micoute a qui j'ai pompé quelque lignes de code.
Michel

Code : Tout sélectionner

;MLD  le 1/03/2017
;Meteocool. droits libres
;Compilation PB5.51
Enumeration
  #Ma_fen = 0
  #Eticpres = 1
  #eticD_1 = 2
  #eticD_2 = 3
  #eticD_3 = 4
  #eticD_4 = 5
  #eticD_5 = 6
  #eticD_6 = 7
  #EticDR_1 = 11
  #EticDR_2 = 12
  #EticDR_3 = 13
  #EticDR_4 = 14
  #EticDR_5 = 15
  #voyantcom = 16
  #eticcom = 17
  #eticalertG = 18
  ;lieu principal
  #EticTchapLP_1 = 20
  #EticTchapLP_2 = 21
  #EticTchapLP_3 = 22
  #EticTchapLP_4 = 23
  #EticTchapLP_5 = 24
  #EticTchapLP_6 = 25
  #EticTchapLP_7 = 26
  #EticTchapLP_8 = 27
  #EticTchapLP_9 = 28
  
  #Resultlp1 = 30;lieu P
  #Resultlp2 = 31;heure bull
  #Resultlp3 = 32;type d'heure
  #Resultlp4 = 33;dir vent
  #Resultlp5 = 34;sect vent
  #Resultlp6 = 35;vitesse vent
  #Resultlp7 = 36;rafale
  #Resultlp8 = 37;Temp ext
  #Resultlp9 = 38;temp ressent
  #Resultlp10 = 39;Temp min
  #Resultlp11 = 40;temp max
  #Resultlp12 = 41;temp rosée
  #Resultlp13 = 42;Préssion
  #Resultlp14 = 43;Préssion hausse baisse
  #Resultlp15 = 44;état du ciel
  #Resultlp16 = 45;visi
  #Resultlp17 = 46;phéno visi
  #Resultlp18 = 47;précipitations
  #Resultlp20 = 48;évolutions
    
  #PEticlp1 = 58
  #PEticlp2 = 59
  #PEticlp3 = 60
  #PEticlp4 = 61
  #PEticlp5 = 62
  #PEticlp6 = 63
  #PEticlp7 = 64
  #PEticlp8 = 65
  #PEticlp9 = 66
  #PEticlp10 = 67
  #PEticlp11 = 68
  
  ;lieu 2
  #EticTchapL2_1 = 70
  #EticTchapL2_2 = 71
  #EticTchapL2_3 = 72
  #EticTchapL2_4 = 73
  #EticTchapL2_5 = 74
  #EticTchapL2_6 = 75
  #EticTchapL2_7 = 76
  #EticTchapL2_8 = 77
  
  #Resultl2_1 = 80;lieu 2
  #Resultl2_2 = 81;heure bull
  #Resultl2_3 = 82;type d'heure
  #Resultl2_4 = 88;dir vent
  #Resultl2_5 = 84;sect vent
  #Resultl2_6 = 85;vitesse vent
  #Resultl2_7 = 86;rafale
  #Resultl2_8 = 87;Temp ext
  #Resultl2_9 = 88;temp ressent
  #Resultl2_10 = 89;Temp min
  #Resultl2_11 = 90;temp max
  #Resultl2_12 = 91;temp rosée
  #Resultl2_13 = 92;préssion
  #Resultl2_14 = 93;préssion hausse baisse
  #Resultl2_15 = 94;état du ciel
  #Resultl2_16 = 95;visi
  #Resultl2_17= 96;phéno visi
  #Resultl2_18 = 97;précipitations
  #Resultl2_19 = 98;évolutions
  
  #Eticl2_1 = 99
  #Eticl2_2 = 100
  #Eticl2_3 = 101
  #Eticl2_4 = 102
  #Eticl2_5 = 103
  #Eticl2_6 = 104
  #Eticl2_7 = 105
  #Eticl2_8 = 106
  #Eticl2_9 = 107
  #Eticl2_10 = 108
  #Eticl2_11 = 109
  ;lieu 3
  #EticTchapL3_1 = 110
  #EticTchapL3_2 = 111
  #EticTchapL3_3 = 112
  #EticTchapL3_4 = 113
  #EticTchapL3_5 = 114
  #EticTchapL3_6 = 115
  #EticTchapL3_7 = 116
  #EticTchapL3_8 = 117
  
  #Resultl3_1 = 120;lieu 3
  #Resultl3_2 = 121;heure bull
  #Resultl3_3 = 122;type d'heure
  #Resultl3_4 = 123;dir vent
  #Resultl3_5 = 124;sect vent
  #Resultl3_6 = 125;vitesse vent
  #Resultl3_7 = 126;rafale
  #Resultl3_8 = 127;Temp ext
  #Resultl3_9 = 128;temp ressent
  #Resultl3_10 = 129;Temp min
  #Resultl3_11 = 130;temp max
  #Resultl3_12 = 131;temp rosée
  #Resultl3_13 = 132;préssion
  #Resultl3_14 = 133;préssion hausse baisse
  #Resultl3_15 = 134;état du ciel
  #Resultl3_16 = 135;visi
  #Resultl3_17 = 136;phéno visi
  #Resultl3_18 = 137;précipitations
  #Resultl3_19 = 138;évolutions
  
  #Eticl3_1 = 139
  #Eticl3_2 = 140
  #Eticl3_3 = 141
  #Eticl3_4 = 142
  #Eticl3_5 = 143
  #Eticl3_6 = 144
  #Eticl3_7 = 145
  #Eticl3_8 = 146
  #Eticl3_9 = 147
  #Eticl3_10 = 148
  #Eticl3_11 = 149
  ;lieu 4
  #EticTchapL4_1 = 150
  #EticTchapL4_2 = 151
  #EticTchapL4_3 = 152
  #EticTchapL4_4 = 153
  #EticTchapL4_5 = 154
  #EticTchapL4_6 = 155
  #EticTchapL4_7 = 156
  #EticTchapL4_8 = 157
  
  #Resultl4_1 = 160;lieu 4
  #Resultl4_2 = 161;heure bull
  #Resultl4_3 = 162;type d'heure
  #Resultl4_4 = 163;dir vent
  #Resultl4_5 = 164;sect vent
  #Resultl4_6 = 165;vitesse vent
  #Resultl4_7 = 166;rafale
  #Resultl4_8 = 167;Temp ext
  #Resultl4_9 = 168;temp ressent
  #Resultl4_10 = 169;Temp min
  #Resultl4_11 = 170;temp max
  #Resultl4_12 = 171;temp rosée
  #Resultl4_13 = 172;préssion
  #Resultl4_14 = 173;préssion hausse baisse
  #Resultl4_15 = 174;état du ciel
  #Resultl4_16 = 175;visi
  #Resultl4_17 = 176;phéno visi
  #Resultl4_18 = 177;précipitations
  #Resultl4_19 = 178;évolutions 
  
  #Eticl4_1 = 179
  #Eticl4_2 = 180
  #Eticl4_3 = 181
  #Eticl4_4 = 182
  #Eticl4_5 = 183
  #Eticl4_6 = 184
  #Eticl4_7 = 185
  #Eticl4_8 = 186
  #Eticl4_9 = 187
  #Eticl4_10 = 188
  #Eticl4_11 = 189
  #eticalert1 = 190;etic alerte
  #eticalert2 = 191;etic alerte
  #eticalert3 = 192;etic alerte
  #eticalert4 = 193;etic alerte
  #bt_lieu1 = 200
  #bt_lieu2 = 201
  #bt_lieu3 = 202
  #bt_lieu4 = 203
  ;fenlist
  #fenlist = 250
  #eticvert = 251
  #listaero = 252
  #btstopaero = 253
  #traitfenlist = 254
  #bt_retconfig = 255
  #bt_enrconfig = 256
  
  #tr1_D = 400
  #tr2_D = 401
  #tr3_D = 402
  #tr1 = 403
  #tr2 = 404
  #tr3 = 405
  #tr4 = 406
  #tr5 = 407
  #tr8 = 408
  #bt_stop 
EndEnumeration
Global FontID1 = LoadFont(500,"Tahoma",12,#PB_Font_HighQuality)
Global FontID2 = LoadFont(501,"Tahoma",14,#PB_Font_HighQuality|#PB_Font_Bold)
Global FontID3 = LoadFont(502,"Verdana",16,#PB_Font_HighQuality|#PB_Font_Bold)
Global FontID4 = LoadFont(503,"Verdana",14,#PB_Font_HighQuality|#PB_Font_Bold)
Global FontID5 = LoadFont(504,"Verdana",12,#PB_Font_HighQuality|#PB_Font_Bold)
Global FontID6 = LoadFont(505,"Verdana",20,#PB_Font_HighQuality|#PB_Font_Bold)

Global Dim tabaero.s(2,97);tableau des aéroports
Global Dim tabcode.s(4)
Global Dim tabligmetar.s(0)

Declare Apelmetar(codemetar$,L.w)
Declare Traitemetar(L.w)
Global indvent.w,indvisi.w
Global Alt1.b = 0,Alt2.b = 0,Alt3.b = 0,Alt4.b = 0
Global Alv1.b = 0,Alv2.b = 0,Alv3.b = 0,Alv4.b = 0
Global Alp1.b = 0,Alp2.b = 0,Alp3.b = 0,Alp4.b = 0
Global Ali1.b = 0,Ali2.b = 0,Ali3.b = 0,Ali4.b = 0

Macro coultrait(gad)
SetGadgetColor(gad,#PB_Gadget_BackColor,$BEBEBE)  
EndMacro 

Macro couletic(gad)
  SetGadgetFont(gad,FontID3) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$FFFFFF)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro

Macro couletic2(gad)
  SetGadgetFont(gad,FontID5) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$FFFFFF)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro

Macro couleinfos(gad)
  SetGadgetFont(gad,FontID4) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$FFFFFF)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro

Macro couleticalert(gad)
  SetGadgetFont(gad,FontID3) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$0000FF)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro

Macro coulR1(gad)
  SetGadgetFont(gad,FontID3) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$9AFA00)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro

Macro coulR2(gad)
  SetGadgetFont(gad,FontID3) 
  SetGadgetColor(gad,#PB_Gadget_FrontColor,$FFF500)
  SetGadgetColor(gad,#PB_Gadget_BackColor,$454545)
EndMacro
Procedure TimerProc3(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
  If Alv1.b = 1 
    If GetGadgetColor(35,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(35,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(35,#PB_Gadget_FrontColor, $FFF500) 
   EndIf
  EndIf 
  If Alv2.b = 1 
    If GetGadgetColor(85,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(85,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(85,#PB_Gadget_FrontColor, $FFF500) 
   EndIf
  EndIf 
  If Alv3.b = 1 
    If GetGadgetColor(125,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(125,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(125,#PB_Gadget_FrontColor, $FFF500) 
   EndIf
  EndIf
  If Alv4.b = 1 
    If GetGadgetColor(165,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(165,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(165,#PB_Gadget_FrontColor, $FFF500) 
   EndIf
  EndIf 
  ;pression
  If Alp1.b = 1 
    If GetGadgetColor(42,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(42,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(42,#PB_Gadget_FrontColor, $FFF500) 
   EndIf
  EndIf 
  If Alp2.b = 1 
    If GetGadgetColor(92,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(92,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(92,#PB_Gadget_FrontColor, $FFF500) 
    EndIf
  EndIf
  If Alp3.b = 1 
    If GetGadgetColor(132,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(132,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(132,#PB_Gadget_FrontColor, $FFF500) 
    EndIf
  EndIf 
  If Alp4.b = 1 
    If GetGadgetColor(172,#PB_Gadget_FrontColor) = $FFF500
     SetGadgetColor(172,#PB_Gadget_FrontColor,$0045FF)
    Else
     SetGadgetColor(172,#PB_Gadget_FrontColor, $FFF500) 
    EndIf
  EndIf 
EndProcedure

Procedure Alert()
  coulR2(37)
  T1 = Val(Right(GetGadgetText(37),Len(GetGadgetText(37))-1))
  If GetGadgetText(37)<> "--"
    If T1 <= 3 Or T1 >= 25:Alt1.b = 1:Else:Alt1.b = 0:EndIf
  EndIf
  coulR2(87)
  T2 = Val(Right(GetGadgetText(87),Len(GetGadgetText(87))-1))
  If GetGadgetText(87)<> "--"
    If T2 <= 3 Or T2 >= 25:Alt2.b = 1:Else:Alt2.b = 0:EndIf
  EndIf
  coulR2(127)
  T3 = Val(Right(GetGadgetText(127),Len(GetGadgetText(127))-1))
  If GetGadgetText(127)<> "--"
    If T3 <= 3 Or T3 >= 25:Alt3.b = 1:Else:Alt3.b = 0:EndIf
  EndIf
  coulR2(167)
  T4 = Val(Right(GetGadgetText(167),Len(GetGadgetText(167))-1))
  If GetGadgetText(167)<> "--" 
    If T4 <= 3 Or T4 >= 25:Alt4.b = 1:Else:Alt4.b = 0:EndIf
  EndIf
  ;vitesse du vent
  coulR2(35)
  V1 = Val(Left(GetGadgetText(35),Len(GetGadgetText(35))-4)) 
  If V1 >= 40:Alv1.b = 1:Else:Alv1.b = 0:EndIf
  coulR2(85)
  V2 = Val(Left(GetGadgetText(85),Len(GetGadgetText(85))-4)) 
  If V2 >= 40:Alv2.b = 1:Else:Alv2.b = 0:EndIf
  coulR2(125)
  V3 = Val(Left(GetGadgetText(125),Len(GetGadgetText(125))-4)) 
  If V3 >= 40:Alv3.b = 1:Else:Alv3.b = 0:EndIf
  coulR2(165)
  V4 = Val(Left(GetGadgetText(165),Len(GetGadgetText(165))-4)) 
  If V4 >= 40:Alv4.b = 1:Else:Alv4.b = 0:EndIf
  ;pression
  coulR2(42)
  P1 = Val(Left(GetGadgetText(42),Len(GetGadgetText(42))-3))
  If GetGadgetText(42)<> "----"
    If P1 <= 1000:Alp1.b = 1:Else:Alp1.b = 0:EndIf
  EndIf
  coulR2(92)
  P2 = Val(Left(GetGadgetText(92),Len(GetGadgetText(92))-3))
  If GetGadgetText(92)<> "----"
    If P2 <= 1000:Alp2.b = 1:Else:Alp2.b = 0:EndIf
  EndIf 
  coulR2(132)
  P3 = Val(Left(GetGadgetText(132),Len(GetGadgetText(132))-3))
  If GetGadgetText(132)<> "----"
    If P3 <= 1000:Alp3.b = 1:Else:Alp3.b = 0:EndIf
  EndIf
  coulR2(172)
  P4 = Val(Left(GetGadgetText(172),Len(GetGadgetText(172))-3))
  If GetGadgetText(172)<> "----"
    If P4 <= 1000:Alp4.b = 1:Else:Alp4.b = 0:EndIf
  EndIf  
  ;visi
  coulR2(45)
  If GetGadgetText(45) <> "------" 
    If indaltvisi.b = 1:Ali1.b = 1:Else:Ali1.b = 0:EndIf
  EndIf
  coulR2(95)
  If GetGadgetText(95) <> "------" 
    If indaltvisi.b = 1:Ali2.b = 1:Else:Ali2.b = 0:EndIf
  EndIf
  coulR2(135)
  If GetGadgetText(135) <> "------" 
    If indaltvisi.b = 1:Ali3.b = 1:Else:Ali3.b = 0:EndIf
  EndIf
  coulR2(175)
  If GetGadgetText(175) <> "------" 
    If indaltvisi.b = 1:Ali4.b = 1:Else:Ali4.b = 0:EndIf
  EndIf

  HideGadget(190, 1)
  If Alt1.b = 1 Or Alv1.b = 1 Or Alp1.b = 1 Or Ali1.b = 1
   HideGadget(190, 0)
  EndIf 
  HideGadget(191, 1)
  If Alt2.b = 1 Or Alv2.b = 1 Or Alp2.b = 1 Or Ali2.b = 1
   HideGadget(191, 0)
  EndIf
  HideGadget(192, 1)
  If Alt3.b = 1 Or Alv3.b = 1 Or Alp3.b = 1 Or Ali3.b = 1
   HideGadget(192, 0)
  EndIf
  HideGadget(193, 1)  
  If Alt4.b = 1 Or Alv4.b = 1 Or Alp4.b = 1 Or Ali4.b = 1
   HideGadget(193, 0)
  EndIf  
EndProcedure  

Procedure razelem(n1.w,n2.w,n3.w)
 SetGadgetText(n1,""):SetGadgetText(n2,"ns"):SetGadgetText(n3,"Clair") 
EndProcedure 

Procedure.s ventdir()
  lg1$ = tabligmetar.s(1)
  vent$ = StringField(lg1$,indvent.w," ")
  dir$ = Left(vent$,3)
  If dir$ = "VRB" Or dir$ = "000"
    result$ = "VRBns"
    ProcedureReturn result$
  Else
    Dv.w = Val(dir$)
    If Dv.w >0 And Dv.w <24 :Sect$ = "N ":EndIf
    If Dv.w >23 And Dv.w <68 :Sect$ = "NE":EndIf
    If Dv.w >67 And Dv.w <113 :Sect$ = "E ":EndIf
    If Dv.w >112 And Dv.w <157 :Sect$ = "SE":EndIf
    If Dv.w >156 And Dv.w <203 :Sect$ = "S ":EndIf
    If Dv.w >202 And Dv.w <248 :Sect$ = "SW":EndIf
    If Dv.w >247 And Dv.w <292 :Sect$ = "W ":EndIf
    If Dv.w >291 And Dv.w <336 :Sect$ = "NW":EndIf
    If Dv.w >335 And Dv.w <361:Sect$ = "N ":EndIf
    result$ = dir$ + Sect$
    ProcedureReturn result$ 
  EndIf  
EndProcedure

Procedure.s ventvit();vitesse du vent
  lg1$ = tabligmetar.s(1)
  vent$ = StringField(lg1$,indvent.w," ")
  maxraf.w = 0:maxvent.w = 0
  For zz = 1 To ArraySize(tabligmetar.s())
   If Len(StringField(tabligmetar.s(zz),indvent.w," ")) > 7 ;il y a eu des rafales
    raf.W = Val(Mid(StringField(tabligmetar.s(zz),indvent.w," "),7,2))* 1.852
    If raf.w > maxraf.w : maxraf.w = raf.w:EndIf;maxi rafale
   EndIf
   Vvent.w = Val(Mid(StringField(tabligmetar.s(zz),indvent.w," "),4,2))* 1.852;vitesse vent
   If Vvent.w > maxvent.w : maxvent.w = Vvent.w:EndIf                   ;maxi vent
  Next
  If  maxraf.w > maxvent.w : maxvent.w = maxraf.w:EndIf
  vk.w = Val(Mid(StringField(tabligmetar.s(1),indvent.w," "),4,2))* 1.852
  ProcedureReturn Str(vk.w)+"Km/H"+ "_" + Str(maxvent.w)+"Km/H"
EndProcedure

Procedure.s visi()
 lg1$ = tabligmetar.s(1)
 visi$ = Trim(Left(StringField(lg1$,indvisi.w," "),4))  
 Select visi$
  Case "0000"
    afvisi$ = "< 50 m"
  Case "9999","NSC"
    afvisi$ = "10 Km"
  Case "CAVO"
    afvisi$ = "> 10 Km"
  Case "////"
   afvisi$ = "Indéfinie" 
  Default
    afvisi$ = visi$ + " m" 
 EndSelect  
 ProcedureReturn afvisi$
EndProcedure 

Procedure.s elem1(elem$)
  afelem1$ = ""
  If FindString(elem$,"BR",1) <>  0: afelem1$ = "Brume":EndIf
  If FindString(elem$,"FG",1) <>  0: afelem1$ = "Brouillard":EndIf 
  If FindString(elem$,"HZ",1) <>  0: afelem1$ = "Brume sèche":EndIf
  If FindString(elem$,"SA",1) <>  0: afelem1$ = "Sable":EndIf
  If FindString(elem$,"DZ",1) <>  0: afelem1$ = "Bruine":EndIf 
  ProcedureReturn afelem1$
EndProcedure

Procedure.s elem2(elem$)
 f$ = Left(elem$,1)
 Select f$
  Case "-"
   af$  = " faible"
  Case "+"
   af$  = " Ft"
 EndSelect  
 afelem2$ = "ns"
  If FindString(elem$,"SH",1) <>  0: afelem2$ = "Averse":EndIf
  If FindString(elem$,"TS",1) <>  0: afelem2$ = "Orage":EndIf 
  If FindString(elem$,"RA",1) <>  0: afelem2$ = "Pluie":EndIf
  If FindString(elem$,"SN",1) <>  0: afelem2$ = "Neige":EndIf 
  If FindString(elem$,"GR",1) <>  0: afelem2$ = "Gréle":EndIf
  If FindString(elem$,"DZ",1) <>  0: afelem2$ = "Bruine":EndIf 
  If FindString(elem$,"SQ",1) <>  0: afelem2$ = "Grains":EndIf 
 ProcedureReturn afelem2$ + af$
EndProcedure

Procedure.s elem3(elem$)
 afelem2$ = "clair" 
 If FindString(elem$,"FEW",1) <>  0: afelem3$ = "Nuages peu nombreux":EndIf
 If FindString(elem$,"SCT",1) <>  0: afelem3$ = "Nuages éparts":EndIf
 If FindString(elem$,"BKN",1) <>  0: afelem3$ = "Nuages Fragmentés":EndIf
 If FindString(elem$,"OVC",1) <>  0: afelem3$ = "Couvert":EndIf
 If FindString(elem$,"NSC",1) <>  0: afelem3$ = "Relativement clair":EndIf
 If FindString(elem$,"NCD",1) <>  0: afelem3$ = "Clair":EndIf
 If FindString(elem$,"SKC",1) <>  0: afelem3$ = "Clair":EndIf
 If FindString(elem$,"VV",1) <>  0: afelem3$ = "Couvert avec nuages bas":EndIf
 ProcedureReturn afelem3$
EndProcedure

Procedure typelem(elem$)
 If FindString(elem$,"BR",1) <>  0:typ.w = 1:EndIf
 If FindString(elem$,"FG",1) <>  0:typ.w = 1:EndIf 
 If FindString(elem$,"HZ",1) <>  0:typ.w = 1:EndIf
 If FindString(elem$,"SA",1) <>  0:typ.w = 1:EndIf   
 If FindString(elem$,"DZ",1) <>  0:typ.w = 1:EndIf 
 If FindString(elem$,"SH",1) <>  0:typ.w = 2:EndIf
 If FindString(elem$,"TS",1) <>  0:typ.w = 2:EndIf
 If FindString(elem$,"RA",1) <>  0:typ.w = 2:EndIf 
 If FindString(elem$,"SN",1) <>  0:typ.w = 2:EndIf
 If FindString(elem$,"GR",1) <>  0:typ.w = 2:EndIf
 If FindString(elem$,"DZ",1) <>  0:typ.w = 2:EndIf
 If FindString(elem$,"SQ",1) <>  0:typ.w = 2:EndIf 
 If FindString(elem$,"FEW",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"SCT",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"BKN",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"OVC",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"NSC",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"NCD",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"SKC",1) <>  0:typ.w = 3:EndIf
 If FindString(elem$,"VV",1) <>  0:typ.w = 3:EndIf
  ProcedureReturn typ.w
EndProcedure

Procedure aero()
Ap1$ = "Le Touquet (62)-LFAT*Lille (59)-LFQQ*Beauvais(60)-LFOB*Rouen (76)-LFOP*Evreux (27)-LFOE*Le Havre (76)-LFOH*Deauville (14)-LFRG*Caen (14)-LFRK*" 
Ap2$ = "Cherbourg(50)-LFRC*Dinard (35)-LFRD*Le Bourget (93)-LFPB*Pontoise (95)-LFPT*Paris CGD (95)-LFPG*Toussus le noble (78)-LFPN*Paris Orly(91)-LFPO*Melun (77)-LFPM*"
Ap3$ = "Reims (51)-LFQA*Nancy/Metz (57)-LFJL*Saint Brieuc (22)-LFRT*Lannion (22)-LFRO*Morlaix (29)-LFRU*Landivisiau (29)-LFRJ*Brest (29)-LFRB*Lanvéoc (29)-LFRL*" 
Ap4$ = "Quimper (29)-LFRQ*Lorient (56)-LFRH*Vannes (56)-LFRV*Saint Nazaire (44)-LFRZ*Nantes (44)-LFRS*Rennes (35)-LFRN*Laval (53)-LFOV*Angers (49)-LFJR*"
Ap5$ = "Le Mans (72)-LFRM*Tours (37)-LFOT*Châteaudun (28)-LFOC*Orléans (45)-LFOJ*Troyes (10)-LFQB*Châlons en Champ (51)-LFOK*Saint Dizier (52)-LFSI*Nancy (54)-LFSO*"
Ap6$ = "Strasbourg (67)-LFST*Epinal (88)-LFSG*Colmar (68)-LFGA*Luxeuil les Bains (70)-LFSX*Dole (39)-LFGJ*Dijon (21)-LFSD*Nevers (58)-LFQG*Avord (18)-LFOA*"
Ap7$ = "Romorantin(41)-LFYR*Châteauroux (36)-LFLX*Poitiers (86)-LFBI*La Roche sur Yon (85)-LFRI*La Rochelle (17)-LFBH*Cognac (16)-LFBG*Angoulême (16)-LFBU*Limoges (87)-LFBL*"
Ap8$ = "Clermont Ferrand (63)-LFLC*Saint Yan (71)-LFLN*Saint Étienne (42)-LFMH*Lyon (69)-LFLL*Grenoble (38)-LFLS*Valence (26)-LFLU*Chambéry (73)-LFLB*Annecy (74)-LFLP*"
Ap9$ = "Bordeaux(33)-LFBD*Cazeaux(33)-LFBC*Bergerac(24)-LFBE*Brive la Gaillarde (19)-LFSL*Aurillac (15)-LFLW*Rodez (12)-LFCR*Agen(47)-LFBA*Mont de Marsan (40)-LFBM*"
Ap10$ = "Dax (40)-LFBY*Biarritz (64)-LFBZ*Pau (64)-LFBP*Tarbes (65)-LFBT*Toulouse (31)-LFBO*Castres (81)-LFCK*Carcassonne (11)-LFMK*Perpignan (66)-LFMP*"
Ap11$ = "Béziers (34)-LFMU*Montpellier (34)-LFMT*Nîmes (30)-LFTW*Orange (84)-LFMO*Avignon (84)-LFMV*Istres (13)-LFMI*Salon de Provence (13)-LFMY*Marseille (13)-LFML*"
Ap12$ = "Toulon (83)-LFTH*Le Luc (83)-LFMC*Cannes (06)-LFMD*Nice (06)-LFMN*Bastia (20)-LFKB*Calvi (20)-LFKC*Ajaccio (20)-LFKJ*Solenzara (20)-LFKS*Figari (20)-LFKF*"    
ApT$ = Ap1$ + Ap2$ + Ap3$ + Ap4$ + Ap5$ + Ap6$ + Ap7$ + Ap8$ + Ap9$ + Ap10$ + Ap11$ + Ap12$
nbap = CountString(ApT$,"*")
For x = 1 To nbap
  a$ =  StringField(ApT$,x,"*")
  tabaero.s(1,x) = StringField(a$,1,"-")
  tabaero.s(2,x) = StringField(a$,2,"-")
Next
maxtab = 97;tri
I = maxtab  / 2
While I > 0
t = maxtab  - I
Repeat
p = 0
  For n = 1 To t
   tr1.s = tabaero.s(1,n)
   tr2.s = tabaero.s(1,(n +I))
   If tr1.s > tr2.s 
    swp1.s = tabaero.s(1, n)
    tabaero.s(1, n) = tabaero.s(1,(n) + I )
    tabaero.s(1,(n) + I) = swp1.s
    swp2.s = tabaero.s(2, n)
    tabaero.s(2,n) = tabaero.s(2,(n) + I)
    tabaero.s(2,(n) + I) = swp2.s
    p = n
   EndIf
  Next 
t = p - I 
Until  p = 0
I = I / 2
Wend 
EndProcedure

Procedure lectconfig()
  ind = 0
  If ReadFile(260,"Meteoconfig.mld")
    While Eof(260) = 0
      ind =ind + 1
      lig$ = ReadString(260)
      If StringField(lig$,2,"_")<> "------"
       tabcode.s(ind) = StringField(lig$,1,"_")
       If ind = 1:SetGadgetText(30,StringField(lig$,2,"_")):EndIf
       If ind = 2:SetGadgetText(80,StringField(lig$,2,"_")):EndIf  
       If ind = 3:SetGadgetText(120,StringField(lig$,2,"_")):EndIf
       If ind = 4:SetGadgetText(160,StringField(lig$,2,"_")):EndIf  
       Apelmetar(tabcode.s(ind),ind);appel le metar du lieu
      EndIf 
    Wend 
    CloseFile(260)
  Else
     HideGadget(17,1)
     HideGadget(18,1) 
     SetGadgetColor(18,#PB_Gadget_FrontColor,$00FFFF)
     SetGadgetText(18,"Il n'y a pas de base météo enregistré")
     Delay(2500)
     SetGadgetText(18,"")
     couletic2(18) 
  EndIf 
EndProcedure  

Procedure enrconfig()
 CreateFile(260,"Meteoconfig.mld") 
  For z = 1 To ArraySize(tabcode.s()) 
    If z = 1:a$ = Trim(GetGadgetText(30)):EndIf
    If z = 2:a$ = Trim(GetGadgetText(80)):EndIf
    If z = 3:a$ = Trim(GetGadgetText(120)):EndIf
    If z = 4:a$ = Trim(GetGadgetText(160)):EndIf
    WriteStringN(260,tabcode.s(z)+ "_" + a$)
  Next
  CloseFile(260)
  SetGadgetColor(18,#PB_Gadget_FrontColor,$00FFFF)
  SetGadgetText(18,"Base météo enregistré")
  Delay(2500)
  SetGadgetText(18,"")
  couletic2(18)
EndProcedure

Procedure listaero(E.w,L.w)
 StickyWindow(0,0)
 OpenWindow(250,301 + E.w,220,315,700,"",#PB_Window_BorderLess)
 EnableWindow_(hWinForeGround, #False)
 SetWindowColor(250,$CDA66C)
 StickyWindow(250,1)
 ; Ici vos gadgets
 N$ = "      CHOIX DU LIEU "
 For x = 1 To Len(N$)
   L$ = L$ + Mid(N$,x,1) + Chr(10) 
 Next  
TextGadget(251,0,0,30,700,L$,#PB_Text_Center)
SetGadgetFont(251,FontID2)  
SetGadgetColor(251,#PB_Gadget_BackColor,$00FFFF)
SetGadgetColor(251,#PB_Gadget_FrontColor,$FF0000) 
ListViewGadget(252,31,0,284,618)
SetGadgetFont(252,FontID5)
SetGadgetColor(252,#PB_Gadget_BackColor,$FF0000)
SetGadgetColor(252,#PB_Gadget_FrontColor,$FFFFFF)
For y = 1 To 97
  AddGadgetItem(252,-1,tabaero.s(1,y))
Next 
ButtonGadget(253,255,640,50,50,"Stop")
SetGadgetFont(253,FontID5)
TextGadget(254,40,655,180,1,"");tr
SetGadgetColor(254,#PB_Gadget_BackColor,$7FFF00)
;  Boucle générale
Repeat
Event = WaitWindowEvent()
 If Event = #PB_Event_Gadget
   Select EventGadget()
     Case 252 ;liste
       Select EventType()
         Case #PB_EventType_LeftClick
           Dpnl.B = 1 ;drapeau indique nouveau lieu
           If  L.w = 1 :SetGadgetText(30,GetGadgetText(252)):EndIf
           If  L.w = 2 :SetGadgetText(80,GetGadgetText(252)):EndIf
           If  L.w = 3 :SetGadgetText(120,GetGadgetText(252)):EndIf
           If  L.w = 4 :SetGadgetText(160,GetGadgetText(252)):EndIf
           For z = 1 To 97
             If L.w = 1 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(30)):tabcode.s(1) = Trim(tabaero.s(2,z)):EndIf
             If L.w = 2 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(80)):tabcode.s(2) = Trim(tabaero.s(2,z)):EndIf
             If L.w = 3 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(120)):tabcode.s(3) = Trim(tabaero.s(2,z)):EndIf
             If L.w = 4 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(160)):tabcode.s(4) = Trim(tabaero.s(2,z)):EndIf
           Next
           EnableWindow_(hWinForeGround,#True)   
           CloseWindow(#fenlist)
           StickyWindow(0,1)
           Break 
       EndSelect    
     Case 253
      EnableWindow_(hWinForeGround,#True)   
      CloseWindow(#fenlist)
      StickyWindow(0,1)
     Break  
 EndSelect
 EndIf
ForEver
If Dpnl.B = 1
  Dpnl.B = 0
  Apelmetar(tabcode.s(L.w),L.w);appel le metar du lieu
EndIf  
EndProcedure

Procedure Traitelem(lg1$,indvisi.w,nbspace.w,n1.w,n2.w,n3.w)
For x = indvisi.w +1 To (nbspace.w-1)
     elem$ =StringField(lg1$,x ," ")
     Select typelem(elem$)
       Case 1   
        SetGadgetText(n1,(elem1(elem$)));elem1 obstacle a la vue
       Case 2
        SetGadgetText(n2,(elem2(elem$)));elem2 Précipitation
       Case 3
        SetGadgetText(n3,(elem3(elem$)));ciel
      EndSelect 
    Next
EndProcedure  
  
Procedure Apelmetar(codemetar$ ,L.w)
 HideGadget(16,0)  
 HideGadget(17,0)
 While WindowEvent() : Wend   
 InitNetwork()
 SetGadgetColor(16,#PB_Gadget_BackColor,$7FFF00)
  While WindowEvent() : Wend  
 *Buffer = ReceiveHTTPMemory("http://meteocentre.com/cgi-bin/get_sao_stn?STN=" + codemetar$ + "&DELT=12")
 If *Buffer
    Taille = MemorySize(*Buffer)
    a$ = PeekS(*Buffer, Taille, #PB_UTF8)
    FreeMemory(*Buffer)
  Else
    SetGadgetColor(18,#PB_Gadget_FrontColor,$0045FF)
    SetGadgetText(18,"Problème de transmission")
    Delay(2500)
    SetGadgetText(18,"")
    couletic2(18)
    HideGadget(16,1)
    HideGadget(17,1)
   ProcedureReturn 
 EndIf
 nb.w = CountString(a$, Chr(10))
 nblig.w = 0
 For x = 1 To nb.w
 B$ = StringField(a$,x, Chr(10))
 If Left(B$ ,4) = codemetar$ And Mid(B$,6,1)> Chr(47) And Mid(B$,6,1) < Chr(58) 
   nblig = nblig +1
   ReDim tabligmetar.s(nblig):tabligmetar.s(nblig) = B$
 EndIf 
Next 
Traitemetar(L.w);traite les metar
EndProcedure  

Procedure.s traittemp(indtemp.w)    
lg1$ = tabligmetar.s(1)
Tp$ = StringField(lg1$,indtemp.w," ")
tpe$ = StringField(Tp$,1,"/")
tpr$ = StringField(Tp$,2,"/")
If Len(tpe$)= 3
  Tpext$ = "- " + Right(tpe$,2)
Else
  Tpext$ = "+ " + Str(Val(tpe$)) 
EndIf 
If Len(tpr$)= 3
  Tr$ = "- " + Right(tpr$,2)
Else
  Tr$ = "+ " + Str(Val(tpr$)) 
EndIf 
tp.d = 0: tm.d = 100 ;cherche les min et les max
For zz = 1 To ArraySize(tabligmetar.s())
  lg$ = tabligmetar.s(zz)
  fin.w = Len(lg$);détermine le nombre d'éléments 
  long.w = 5
 For z = 5 To fin.w
   If Mid(lg$,z,1) <> "Q"
    long.w =long.w + 1  
   Else
     Break
   EndIf 
 Next
 ph$ = Left(lg$,long.w)
 nbspace.w = CountString(ph$," ")
 Tp2$ = StringField(ph$,nbspace.w," ") 
 tpe2$ = StringField(Tp2$,1,"/")
 If Len(Trim(tpe2$)) = 3:tpe2$ = "-" + Right(tpe2$,2):EndIf
   Tchif.D = ValD(tpe2$)
   If Tchif.D > tp.d :tp.d = Tchif.D:EndIf
   If Tchif.D < tm.d :tm.d = Tchif.D:EndIf
Next
If tp.d > 0
 Tmax$ = "+ " + StrD(tp.d,0)
Else
 Tmax$ = StrD(tp.d,0)
EndIf 
If tm.d > 0
 Tmin$ = "+ " + StrD(tm.d,0)
Else
 Tmin$ = StrD(tm.d,0)
EndIf
vk.w = Val(Mid(StringField(tabligmetar.s(1),indvent.w," "),4,2))* 1.852;vitesse du vent
If vk.w < 3:vk.w = 3:EndIf
If Len(tpe$)= 3 ;pour le calcul des temps ressenties
  caltp$ = "- " + Right(tpe$,2)
Else
  caltp$ = tpe$ 
EndIf  
tpr.d = 13.12+(0.6215*ValD(caltp$))+((0.3965*ValD(caltp$))-11.37)*Pow(vk.w,0.16);pour -10 et 30km env - 19°c
If tpr.d > 0
 Trs$ = "+ " + StrD(tpr.d,0)
Else
 Trs$ = StrD(tpr.d,0)
EndIf
ProcedureReturn Tpext$ +"_" + Tmin$+"_" +  Tmax$ + "_" + Tr$ + "_" + Trs$
EndProcedure

Procedure.s traitpress(indpress.w)
 lg1$ = tabligmetar.s(1) 
 pressp1$ = RemoveString(StringField(lg1$,indpress.w," "),"Q")
 press1$ = RemoveString(pressp1$,"=")
 lg2$ = tabligmetar.s(5)    
 nbspace2.w = CountString(lg2$," ")
 If Right(lg2$,1)= "=":nbspace2.w = nbspace2.w +1:EndIf ;pour un éventuel fin de message    
 For zz = 1 To nbspace2.w
   If Left(StringField(lg2$,zz," "),1) ="Q"
     pressp2$ = RemoveString(StringField(lg2$,zz," "),"Q")
     press2$ = RemoveString(pressp2$,"=")
     Break
   EndIf  
 Next
 If Val(press1$)> Val(press2$)
   tend$ = "En hausse"
 ElseIf Val(press1$)< Val(press2$)
   tend$ = "En baisse"
 ElseIf Val(press1$)= Val(press2$)
   tend$ = "Stable" 
 EndIf    
 ProcedureReturn press1$ + " hPa" + "_" + tend$ 
EndProcedure

Procedure.s prev(indprev.w)
 lg1$ = tabligmetar.s(1)
 Aprev$ = Left(RemoveString(StringField(lg1$,indprev.w," "),"="),5)
 Select Aprev$
   Case "TEMPO","INTER"
     Afprev$ = "Instabilité" 
   Case "NOSIG"
     Afprev$ = "Aucun changement"
   Case "BECMG","GRADU"
     If tend$ = "Stable":Afprev$ = "Petit changement":EndIf
     If tend$ = "En hausse":Afprev$ = "Amélioration probable":EndIf
     If tend$ = "En baisse":Afprev$ = "Dégradation possible":EndIf
   Case "RAPID"
     If tend$ = "Stable":Afprev$ = "Changement imminent":EndIf
     If tend$ = "En hausse":Afprev$ = "Amélioration rapide":EndIf
     If tend$ = "En baisse":Afprev$ = "Dégradation rapide":EndIf
   Default
     Afprev$ = "ns" 
 EndSelect
 ProcedureReturn Afprev$
EndProcedure  

Procedure Traitemetar(L.w)
 lg1$ = tabligmetar.s(1)
 indvent.w = 4
 If StringField(lg1$,3 ," ") <> "AUTO" :indvent.w = indvent.w - 1:EndIf ;s'il ny a pas de mesure automatique
 indvisi.w = indvent.w +1 
 If StringField(lg1$,indvisi.w ," ") <> "CAVOK";pour ne pas tenir compte de la variabilité des vents sur piste
   If FindString(StringField(lg1$,indvisi.w," "),"V",1) <> 0 And Mid(StringField(lg1$,indvisi.w," "),2,1) <> "V"
     indvisi.w = indvisi.w + 1;attention avec VV
   EndIf  
 EndIf 
 fin.w = Len(lg1$) 
 long.w = 5
 For z = 5 To fin.w
   If Mid(lg1$,z,1) <> "Q"
    long.w =long.w + 1  
   Else
     Break
   EndIf 
 Next
 ph$ = Left(lg1$,long.w) 
 nbspace.w = CountString(ph$," ")
 indtemp.w = nbspace.w
 indpress.w = indtemp.w +1
 indprev.w = indpress.w +1
 Select L.w;typelem.w
   Case 1
    razelem(46,47,44) 
    SetGadgetText(31,Mid(lg1$,8,2) + " H " + Mid(lg1$,10,2));Heure
    SetGadgetText(33,Left(ventdir(),3)) : SetGadgetText(34,Right(ventdir(),2));direction du vent
    SetGadgetText(35,StringField(ventvit(),1,"_")):SetGadgetText(36,StringField(ventvit(),2,"_"));Vitesse du vent
    SetGadgetText(45,visi());visi
    Traitelem(lg1$,indvisi.w,nbspace.w,46,47,44)
    SetGadgetText(37,StringField(traittemp(indtemp.w),1,"_")):SetGadgetText(38,StringField(traittemp(indtemp.w),5,"_"))
    SetGadgetText(39,StringField(traittemp(indtemp.w),2,"_")):SetGadgetText(40,StringField(traittemp(indtemp.w),3,"_"))
    SetGadgetText(41,StringField(traittemp(indtemp.w),4,"_"))
    SetGadgetText(42,StringField(traitpress(indpress.w),1,"_")):SetGadgetText(43,StringField(traitpress(indpress.w),2,"_"))
    SetGadgetText(48,prev(indprev.w))
  Case 2
    razelem(96,97,94) 
    SetGadgetText(81,Mid(lg1$,8,2) + " H " + Mid(lg1$,10,2));Heure
    SetGadgetText(83,Left(ventdir(),3)) : SetGadgetText(84,Right(ventdir(),2));direction du vent
    SetGadgetText(85,StringField(ventvit(),1,"_")):SetGadgetText(86,StringField(ventvit(),2,"_"));Vitesse du vent
    SetGadgetText(95,visi())                                                                     ;visi
    Traitelem(lg1$,indvisi.w,nbspace.w,96,97,94)
    SetGadgetText(87,StringField(traittemp(indtemp.w),1,"_")):SetGadgetText(88,StringField(traittemp(indtemp.w),5,"_"))
    SetGadgetText(89,StringField(traittemp(indtemp.w),2,"_")):SetGadgetText(90,StringField(traittemp(indtemp.w),3,"_"))
    SetGadgetText(91,StringField(traittemp(indtemp.w),4,"_"))
    SetGadgetText(92,StringField(traitpress(indpress.w),1,"_")):SetGadgetText(93,StringField(traitpress(indpress.w),2,"_"))
    SetGadgetText(98,prev(indprev.w))
  Case 3
    razelem(136,137,134)
    SetGadgetText(121,Mid(lg1$,8,2) + " H " + Mid(lg1$,10,2));Heure
    SetGadgetText(123,Left(ventdir(),3)) : SetGadgetText(124,Right(ventdir(),2));direction du vent
    SetGadgetText(125,StringField(ventvit(),1,"_")):SetGadgetText(126,StringField(ventvit(),2,"_"));Vitesse du vent
    SetGadgetText(135,visi())                                                                      ;visi
    Traitelem(lg1$,indvisi.w,nbspace.w,136,137,134)
    SetGadgetText(127,StringField(traittemp(indtemp.w),1,"_")):SetGadgetText(128,StringField(traittemp(indtemp.w),5,"_"))
    SetGadgetText(129,StringField(traittemp(indtemp.w),2,"_")):SetGadgetText(130,StringField(traittemp(indtemp.w),3,"_"))
    SetGadgetText(131,StringField(traittemp(indtemp.w),4,"_"))
    SetGadgetText(132,StringField(traitpress(indpress.w),1,"_")):SetGadgetText(133,StringField(traitpress(indpress.w),2,"_"))
    SetGadgetText(138,prev(indprev.w))
  Case 4
    razelem(176,177,174)
    SetGadgetText(161,Mid(lg1$,8,2) + " H " + Mid(lg1$,10,2));Heure
    SetGadgetText(163,Left(ventdir(),3)) : SetGadgetText(164,Right(ventdir(),2));direction du vent
    SetGadgetText(165,StringField(ventvit(),1,"_")):SetGadgetText(166,StringField(ventvit(),2,"_"));Vitesse du vent
    SetGadgetText(175,visi())                                                                      ;visi
    Traitelem(lg1$,indvisi.w,nbspace.w,176,177,174)
    SetGadgetText(167,StringField(traittemp(indtemp.w),1,"_")):SetGadgetText(168,StringField(traittemp(indtemp.w),5,"_"))
    SetGadgetText(169,StringField(traittemp(indtemp.w),2,"_")):SetGadgetText(170,StringField(traittemp(indtemp.w),3,"_"))
    SetGadgetText(171,StringField(traittemp(indtemp.w),4,"_"))
    SetGadgetText(172,StringField(traitpress(indpress.w),1,"_")):SetGadgetText(173,StringField(traitpress(indpress.w),2,"_"))
    SetGadgetText(178,prev(indprev.w))
 EndSelect    
 HideGadget(16,1)
 HideGadget(17,1)
 Alert()
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.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.i NumSem(date.i);donne le num de semaine selon norme iso
  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
    ProcedureReturn Round((jda-DjanP)/7, #PB_Round_Up)
  Else ;si non c'est dans la 1ere semaine
   ProcedureReturn 1
  EndIf
EndProcedure

Procedure calculnbjour();calcul le nombre de jour écoulé a la date indiqué et ce qui reste
 If bissextile(Year(Date())) = 1
  totalj.w = 366
 Else
  totalj.w = 365
 EndIf
nbjt.w = DayOfYear(Date())
diffjour.w = totalj - nbjt.w  
SetGadgetText(13,Str(nbjt.w))
SetGadgetText(14,Str(totalj.w))
SetGadgetText(15,Str(diffjour.w))
EndProcedure

Procedure TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l) 
Jour$ = "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" 
Jour$= StringField (Jour$, DayOfWeek ( Date ())+1, "," )    
Mois$="Janvier,Février,Mars,Avril,Mai,Juin,Juillet,Août,Septembre,Octobre,Novembre,Décembre"
Mois$ = StringField(Mois$,Month(Date()),",")
Date$ = Jour$ +" " + FormatDate(" %dd ", Date()) + Mois$ + FormatDate("  %yyyy", Date())+"  Heure locale"
HL$ = FormatDate("%hh h %ii : %ss", Date())                     
SetGadgetText(3,Date$):SetGadgetText(11,HL$)
EndProcedure

Procedure TimerProc2(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
  Select Minute(Date())
    Case 0 To 7
      For z.w = 1 To 4
        Apelmetar(tabcode.s(z.w),z.w);appel le metar du lieu
      Next  
    Case 30 To 37
      For z.w = 1 To 4
        Apelmetar(tabcode.s(z.w),z.w);appel le metar du lieu
      Next 
  EndSelect    
EndProcedure  
OpenWindow(0,300,0,1340,1040,"Ma Fenêtre",#PB_Window_BorderLess | #PB_Window_Invisible)
SetClassLongPtr_(WindowID(0),#GCL_STYLE,$00020000)
SetWindowColor(0,$454545)
StickyWindow(0,1)
Handle0 = WindowID(0)
; Ici vos gadgets
N$ = "              METEO   COOL"
 For x = 1 To Len(N$)
   L$ = L$ + Mid(N$,x,1) + Chr(10) 
 Next
TextGadget(1,0,0,30,1040,L$,#PB_Text_Center) 
SetGadgetFont(1,FontID2) 
SetGadgetColor(1,#PB_Gadget_BackColor,$CD0000)
SetGadgetColor(1,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(2,118,25,65,25,"Date")
couletic(2)
;***date
TextGadget(3,80,65,440,25,"");date
TextGadget(4,730,65,120,25,"Semaine")
TextGadget(5,930,65,70,25,"Jour")
TextGadget(6,1060,65,20,25,"/")
TextGadget(7,1160,65,80,25,"Reste")
For x = 3 To 7
  couleinfos(x)
Next  
TextGadget(11,525,65,160,25,"");heure
numS$ = Str(NumSem(Date()))
If Len(numS$)<2:numS$ = "0" + numS$ :EndIf ;num semaine
TextGadget(12,845,65,40,25,numS$)
TextGadget(13,1000,65,50,25,"")
TextGadget(14,1090,65,50,25,"")
TextGadget(15,1240,65,50,25,"")
For xx =11 To 15
  coulR1(xx)
Next  
calculnbjour()
;** lieu principal
TextGadget(20,42,140,210,25,"- Lieu principal -")
TextGadget(21,42,220,317,25,"- Heure du bulletin -",#PB_Text_Center)
TextGadget(22,42,300,317,25,"- Vent -",#PB_Text_Center)
TextGadget(23,42,455,317,25,"- Températures (°c) -",#PB_Text_Center)
TextGadget(24,42,605,317,25,"- Préssion atmosphérique -",#PB_Text_Center)
TextGadget(25,42,675,317,25,"- Ciel -",#PB_Text_Center)
TextGadget(26,42,740,317,25,"- Eléments + -",#PB_Text_Center)
TextGadget(27,42,850,317,25,"- Evolutions -",#PB_Text_Center)
For  x = 20 To 27
 couletic(x)
Next
TextGadget(190,42,925,317,25,"- Alerte -",#PB_Text_Center)
HideGadget(190,1)
couleticalert(190)
TextGadget(30,42,180,317,25,"------",#PB_Text_Center)
TextGadget(31,80,260,120,25,"-----",#PB_Text_Center)
TextGadget(32,208,260,130,25,"U T C",#PB_Text_Center)
TextGadget(33,130,335,50,25,"----",#PB_Text_Center)
TextGadget(34,300,335,50,25,"----",#PB_Text_Center)
TextGadget(35,130,375,120,25,"------",#PB_Text_Center)
TextGadget(36,235,415,120,25,"------",#PB_Text_Center)
TextGadget(37,130,490,70,25,"--")
TextGadget(38,300,490,60,25,"--")
TextGadget(39,130,530,70,25,"--")
TextGadget(40,300,530,60,25,"--")
TextGadget(41,290,570,70,25,"--")
TextGadget(42,52,640,120,25,"----",#PB_Text_Center)
TextGadget(43,220,640,120,25,"----",#PB_Text_Center)
TextGadget(44,42,705,317,25,"------",#PB_Text_Center)
TextGadget(45,115,775,100,25,"------",#PB_Text_Center)
TextGadget(46,235,775,120,25,"",#PB_Text_Center)
TextGadget(47,190,810,160,25,"ns",#PB_Text_Center)
TextGadget(48,42,885,317,25,"ns",#PB_Text_Center)
For  x = 30 To 48
 coulR2(x)
Next
TextGadget(58,42,340,80,20,"Direction")
TextGadget(59,220,340,80,20,"Secteur")
TextGadget(60,42,380,80,20,"Vitesse")
TextGadget(61,42,420,180,20,"Vitesse Max / 6.H")
TextGadget(62,42,495,90,20,"Extérieur")
TextGadget(63,205,495,90,20,"Ressentie")
TextGadget(64,42,535,80,20,"Min/ 6.H")
TextGadget(65,205,535,90,20,"Max/ 6.H")
TextGadget(66,42,575,200,20,"Température de rosée")
TextGadget(67,42,780,70,20,"Visibilité")
TextGadget(68,42,815,120,20,"Précipitations")
For  x = 58 To 68
 couletic2(x) 
Next
;** lieu 2
TextGadget(70,362,140,210,25,"- Lieu N°2 -")
TextGadget(71,362,220,317,25,"- Heure du bulletin -",#PB_Text_Center)
TextGadget(72,362,300,317,25,"- Vent -",#PB_Text_Center)
TextGadget(73,362,455,317,25,"- Températures (°c) -",#PB_Text_Center)
TextGadget(74,362,605,317,25,"- Préssion atmosphérique -",#PB_Text_Center)
TextGadget(75,362,675,317,25,"- Ciel -",#PB_Text_Center)
TextGadget(76,362,740,317,25,"- Eléments + -",#PB_Text_Center)
TextGadget(77,362,850,317,25,"- Evolutions -",#PB_Text_Center)
For  x = 70 To 77
 couletic(x)
Next
TextGadget(191,362,925,317,25,"- Alerte -",#PB_Text_Center)
HideGadget(191,1)
couleticalert(191)
TextGadget(80,362,180,317,25,"------",#PB_Text_Center)
TextGadget(81,400,260,120,25,"------",#PB_Text_Center)
TextGadget(82,516,260,130,25,"U T C",#PB_Text_Center)
TextGadget(83,450,335,50,25,"----",#PB_Text_Center)
TextGadget(84,620,335,50,25,"----",#PB_Text_Center)
TextGadget(85,450,375,120,25,"------",#PB_Text_Center)
TextGadget(86,555,415,120,25,"------",#PB_Text_Center)
TextGadget(87,450,490,70,25,"--")
TextGadget(88,620,490,60,25,"--")
TextGadget(89,450,530,70,25,"--")
TextGadget(90,620,530,60,25,"--")
TextGadget(91,610,570,70,25,"--")
TextGadget(92,372,640,120,25,"----",#PB_Text_Center)
TextGadget(93,540,640,120,25,"----",#PB_Text_Center)
TextGadget(94,362,705,317,25,"------",#PB_Text_Center)
TextGadget(95,435,775,100,25,"------",#PB_Text_Center)
TextGadget(96,555,775,120,25,"",#PB_Text_Center)
TextGadget(97,510,810,160,25,"------",#PB_Text_Center)
TextGadget(98,362,885,317,25,"ns",#PB_Text_Center)
For  x = 80 To 98
 coulR2(x)
Next
TextGadget(99,362,340,80,20,"Direction")
TextGadget(100,540,340,80,20,"Secteur")
TextGadget(101,362,380,80,20,"Vitesse")
TextGadget(102,362,420,180,20,"Vitesse Max / 6.H")
TextGadget(103,362,495,90,20,"Extérieur")
TextGadget(104,525,495,90,20,"Ressentie")
TextGadget(105,362,535,80,20,"Min/ 6.H")
TextGadget(106,525,535,90,20,"Max/ 6.H")
TextGadget(107,362,575,200,20,"Température de rosée")
TextGadget(108,362,780,70,20,"Visibilité")
TextGadget(109,362,815,120,20,"Précipitations")
For  x = 99 To 109
 couletic2(x) 
Next
;** lieu 3
TextGadget(110,682,140,210,25,"- Lieu N°3 -")
TextGadget(111,682,220,317,25,"- Heure du bulletin -",#PB_Text_Center)
TextGadget(112,682,300,317,25,"- Vent -",#PB_Text_Center)
TextGadget(113,682,455,317,25,"- Températures (°c) -",#PB_Text_Center)
TextGadget(114,682,605,317,25,"- Préssion atmosphérique -",#PB_Text_Center)
TextGadget(115,682,675,317,25,"- Ciel -",#PB_Text_Center)
TextGadget(116,682,740,317,25,"- Eléments + -",#PB_Text_Center)
TextGadget(117,682,850,317,25,"- Evolutions -",#PB_Text_Center)
For  x = 110 To 117
 couletic(x)
Next
TextGadget(192,682,925,317,25,"- Alerte -",#PB_Text_Center)
HideGadget(192,1)
couleticalert(192)
TextGadget(120,682,180,317,25,"------",#PB_Text_Center)
TextGadget(121,720,260,120,25,"------",#PB_Text_Center)
TextGadget(122,836,260,130,25,"U T C",#PB_Text_Center)
TextGadget(123,770,335,50,25,"----",#PB_Text_Center)
TextGadget(124,940,335,50,25,"----",#PB_Text_Center)
TextGadget(125,770,375,120,25,"------",#PB_Text_Center)
TextGadget(126,875,415,120,25,"------",#PB_Text_Center)
TextGadget(127,770,490,70,25,"--")
TextGadget(128,940,490,60,25,"--")
TextGadget(129,770,530,70,25,"--")
TextGadget(130,940,530,60,25,"--")
TextGadget(131,930,570,70,25,"--")
TextGadget(132,692,640,120,25,"----",#PB_Text_Center)
TextGadget(133,860,640,120,25,"----",#PB_Text_Center)
TextGadget(134,682,705,317,25,"------",#PB_Text_Center)
TextGadget(135,755,775,100,25,"------",#PB_Text_Center)
TextGadget(136,875,775,120,25,"",#PB_Text_Center)
TextGadget(137,830,810,160,25,"------",#PB_Text_Center)
TextGadget(138,682,885,317,25,"ns",#PB_Text_Center)
For  x = 120 To 138
 coulR2(x)
Next
TextGadget(139,682,340,80,20,"Direction")
TextGadget(140,860,340,80,20,"Secteur")
TextGadget(141,682,380,80,20,"Vitesse")
TextGadget(142,682,420,180,20,"Vitesse Max / 6.H")
TextGadget(143,682,495,90,20,"Extérieur")
TextGadget(144,845,495,90,20,"Ressentie")
TextGadget(145,682,535,80,20,"Min/ 6.H")
TextGadget(146,845,535,90,20,"Max/ 6.H")
TextGadget(147,682,575,200,20,"Température de rosée")
TextGadget(148,682,780,70,20,"Visibilité")
TextGadget(149,682,815,120,20,"Précipitations")
For  x = 139 To 149
 couletic2(x) 
Next
;lieu 4
TextGadget(150,1002,140,210,25,"- Lieu N°4 -")
TextGadget(151,1002,220,317,25,"- Heure du bulletin -",#PB_Text_Center)
TextGadget(152,1002,300,317,25,"- Vent -",#PB_Text_Center)
TextGadget(153,1002,455,317,25,"- Températures (°c) -",#PB_Text_Center)
TextGadget(154,1002,605,317,25,"- Préssion atmosphérique -",#PB_Text_Center)
TextGadget(155,1002,675,317,25,"- Ciel -",#PB_Text_Center)
TextGadget(156,1002,740,317,25,"- Eléments + -",#PB_Text_Center)
TextGadget(157,1002,850,317,25,"- Evolutions -",#PB_Text_Center)
For  x = 150 To 157
 couletic(x)
Next
TextGadget(193,1002,925,317,25,"- Alerte -",#PB_Text_Center)
HideGadget(193,1)
couleticalert(193)
TextGadget(160,1002,180,317,25,"------",#PB_Text_Center)
TextGadget(161,1040,260,120,25,"------",#PB_Text_Center)
TextGadget(162,1156,260,130,25,"U T C",#PB_Text_Center)
TextGadget(163,1090,335,50,25,"----",#PB_Text_Center)
TextGadget(164,1260,335,50,25,"----",#PB_Text_Center)
TextGadget(165,1090,375,120,25,"------",#PB_Text_Center)
TextGadget(166,1195,415,120,25,"------",#PB_Text_Center)
TextGadget(167,1090,490,70,25,"--")
TextGadget(168,1260,490,55,25,"--")
TextGadget(169,1085,530,70,25,"--")
TextGadget(170,1260,530,55,25,"--")
TextGadget(171,1250,570,60,25,"--")
TextGadget(172,1012,640,120,25,"----",#PB_Text_Center)
TextGadget(173,1180,640,120,25,"----",#PB_Text_Center)
TextGadget(174,1002,705,317,25,"------",#PB_Text_Center)
TextGadget(175,1075,775,100,25,"------",#PB_Text_Center)
TextGadget(176,1195,775,120,25,"",#PB_Text_Center)
TextGadget(177,1150,810,160,25,"------",#PB_Text_Center)
TextGadget(178,1002,885,317,25,"ns",#PB_Text_Center)
For  x = 160 To 178
 coulR2(x)
Next
TextGadget(179,1002,340,80,20,"Direction")
TextGadget(180,1180,340,80,20,"Secteur")
TextGadget(181,1002,380,80,20,"Vitesse")
TextGadget(182,1002,420,180,20,"Vitesse Max / 6.H")
TextGadget(183,1002,495,90,20,"Extérieur")
TextGadget(184,1165,495,90,20,"Ressentie")
TextGadget(185,1002,535,80,20,"Min/ 6.H")
TextGadget(186,1165,535,90,20,"Max/ 6.H")
TextGadget(187,1002,575,200,20,"Température de rosée")
TextGadget(188,1002,780,70,20,"Visibilité")
TextGadget(189,1002,815,120,20,"Précipitations")
For  x = 179 To 189
 couletic2(x) 
Next
TextGadget(400,31,37,80,1,"")
TextGadget(401,184,37,1156,1,"")
TextGadget(402,30,105,1310,1,"")
TextGadget(403,40,105,1,940,"");tr
TextGadget(404,1319,105,1,940,"");tr
TextGadget(405,40,960,1280,1,"");tr
TextGadget(406,360,105,1,855,"");tr
TextGadget(407,680,105,1,855,"");tr
TextGadget(408,1000,105,1,855,"");tr
For  x = 400 To 408
  coultrait(x)
Next
ButtonGadget(200,255,135,100,35,Chr(9992))
SetGadgetFont(200,FontID6) 
ButtonGadget(201,575,135,100,35,Chr(9992))
SetGadgetFont(201,FontID6)
ButtonGadget(202,895,135,100,35,Chr(9992))
SetGadgetFont(202,FontID6)
ButtonGadget(203,1215,135,100,35,Chr(9992))
SetGadgetFont(203,FontID6)
ButtonGadget(#bt_stop ,1190,980,100,50,"Stop")
SetGadgetFont(#bt_stop,FontID2)
HideWindow(0,0)
TextGadget(16,50,990,20,20,"")
SetGadgetColor(16,#PB_Gadget_BackColor,$7FFF00)
HideGadget(16,1)
TextGadget(17,75,988,160,25,"Transmission")
coulR1(17)
HideGadget(17,1)
TextGadget(18,240,992,500,20,"")
couletic2(18)
ButtonGadget(255,980,980,210,50,"Enregistre la base")
SetGadgetFont(255,FontID2)
ButtonGadget(256,770,980,210,50,"Affiche la base")
SetGadgetFont(256,FontID2)
SetTimer_ (Handle0, 1, 500, @TimerProc())
SetTimer_ (Handle1, 1, 60000, @TimerProc2())
SetTimer_ (Handle1, 1, 800, @TimerProc3())
aero()
;  Boucle générale
Repeat
Event = WaitWindowEvent()
 If Event = #WM_LBUTTONDOWN
  SendMessage_(WindowID(#Ma_fen), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
 EndIf
 If Event = #PB_Event_Gadget
   Select EventGadget()
    Case 200
       listaero (42,1)
    Case 201
       listaero(362,2)
    Case 202
       listaero(682,3)
    Case 203
      listaero(1002,4)
    Case 255
      enrconfig() 
    Case 256
      lectconfig()  
    Case #bt_stop 
     CloseWindow(0)
     Break 
 EndSelect
 EndIf
ForEver
End
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Récré Météo

Message par Micoute »

Très bon travail, merci pour ce partage.
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 !
Avatar de l’utilisateur
Ar-S
Messages : 9476
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Récré Météo

Message par Ar-S »

C'est sympa merci.
Mais pensez aux affichages windows > 100% dans vos gadgets graphiques !
En 125% ça rend pas bien.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Répondre