Informations METEO

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

Informations METEO

Message par MLD »

Bonjour a tous
Il y a environ 3 ans j'ai produit un logiciel d'infos météo a base des "METARS" diffusés par les aéroports.
J'ai beaucoup remanier le code. Le voici.
Il faut activer la gestion des threds dans les options du compilateur.
Un petit PBI accompagne le programme principal.(dans le poste suivant)(Enregistrez le PBI sous SIG_MET.pbi)
Vos remarques serons les bien venues.
Amuser vous Bien.
Michel

Code : Tout sélectionner

;MLD METEO le 18/02/2021
XIncludeFile "SIG_MET.pbi"
;assignation des gadgets
#Fp = 0:#Eticpres = 1:#EticD_1 = 2:#EticD_2 = 3:#EticD_3 = 4:#EticD_4 = 5:#EticD_5 = 6:#EticD_6 = 7:#EticD_7 = 8:#EticD_8 = 9
#EticDR_1 = 11:#EticDR_2 = 12:#EticDR_3 = 13:#EticDR_4 = 14:#EticDR_5 = 15:#framecolor_1 = 16:#voyantcom = 17:#eticcom = 18:#eticalertG = 19  
;lieus 
#EticTchapLP_2 = 21:#EticTchapLP_3 = 22:#EticTchapLP_4 = 23:#EticTchapLP_5 = 24:#EticTchapLP_6 = 25:#EticTchapLP_7 = 26:#EticTchapLP_8 = 27 
#Resultlp1 = 30:#Resultlp2 = 31:#Resultlp3 = 32:#Resultlp4 = 33:#Resultlp5 = 34:#Resultlp6 = 35:#Resultlp7 = 36:#Resultlp8 = 37:#Resultlp9 = 38
#Resultlp10 = 39:#Resultlp11 = 40:#Resultlp12 = 41:#Resultlp13 = 42:#Resultlp14= 43:#Resultlp15 = 44:#Resultlp16 = 45:#Resultlp17 = 46  
#Resultlp18 = 47:#Resultlp19 = 48  
#PEticlp1 = 58:#PEticlp2 = 59:#PEticlp3 = 60:#PEticlp4 = 61:#PEticlp5 = 62:#PEticlp6 = 63:#PEticlp7 = 64:#PEticlp8 = 65:#PEticlp9 = 66  
#PEticlp10 = 67:#PEticlp11 = 68:  
#EticTchapL2_2 = 71:#EticTchapL2_3 = 72:#EticTchapL2_4 = 73:#EticTchapL2_5 = 74:#EticTchapL2_6 = 75:#EticTchapL2_7 = 76:#EticTchapL2_8 = 77
#Resultl2_1 = 80:#Resultl2_2 = 81:#Resultl2_3 = 82:#Resultl2_4 = 88:#Resultl2_5 = 84:#Resultl2_6 = 85:#Resultl2_7 = 86:#Resultl2_8 = 87  
#Resultl2_9 = 88:#Resultl2_10 = 89:#Resultl2_11 = 90:#Resultl2_12 = 91:#Resultl2_13 = 92:#Resultl2_14 = 93:#Resultl2_15 = 94  
#Resultl2_16 = 95:#Resultl2_17= 96:#Resultl2_18 = 97:#Resultl2_19 = 98:#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  
#EticTchapL3_2 = 111:#EticTchapL3_3 = 112:#EticTchapL3_4 = 113:#EticTchapL3_5 = 114:#EticTchapL3_6 = 115:#EticTchapL3_7 = 116:#EticTchapL3_8 = 117  
#Resultl3_1 = 120:#Resultl3_2 = 121:#Resultl3_3 = 122:#Resultl3_4 = 123:#Resultl3_5 = 124:#Resultl3_6 = 125:#Resultl3_7 = 126:#Resultl3_8 = 127
#Resultl3_9 = 128:#Resultl3_10 = 129:#Resultl3_11 = 130:#Resultl3_12 = 131:#Resultl3_13 = 132:#Resultl3_14 = 133:#Resultl3_15 = 134  
#Resultl3_16 = 135:#Resultl3_17 = 136:#Resultl3_18 = 137:#Resultl3_19 = 138:#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  
#EticTchapL4_2 = 151:#EticTchapL4_3 = 152:#EticTchapL4_4 = 153:#EticTchapL4_5 = 154:#EticTchapL4_6 = 155:#EticTchapL4_7 = 156:#EticTchapL4_8 = 157  
#Resultl4_1 = 160:#Resultl4_2 = 161:#Resultl4_3 = 162:#Resultl4_4 = 163:#Resultl4_5 = 164:#Resultl4_6 = 165:#Resultl4_7 = 166:#Resultl4_8 = 167  
#Resultl4_9 = 168:#Resultl4_10 = 169:#Resultl4_11 = 170: #Resultl4_12 = 171:#Resultl4_13 = 172:#Resultl4_14 = 173:#Resultl4_15 = 174 
#Resultl4_16 = 175:#Resultl4_17 = 176:#Resultl4_18 = 177:#Resultl4_19 = 178  
#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:#eticalert2 = 191:#eticalert3 = 192:#eticalert4 = 193  
#bt_lieu1 = 200:#bt_lieu2 = 201:#bt_lieu3 = 202:#bt_lieu4 = 203:#bt_stop = 205  
;fenlist  
#fenlist = 250: #eticvert = 251:#listaero = 252:#btstopaero = 253:#traitfenlist = 254  
;-------------------  
#bt_retconfig = 255:#bt_enrconfig = 256:#bt_aide = 257:#Fconfig = 260  
#trait_1 = 401:#trait_2 = 402:#trait_3 = 403:#trait_4 = 404:#trait_5 = 405:#trait_6 = 406  

Global FontID1 = LoadFont(500,"Tahoma",12,#PB_Font_HighQuality)
Global FontID2 = LoadFont(501,"Tahoma",12,#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 GetWebMem(URL.s)
Declare Traitemetar(W)
Global indvent.w,indvisi.w,maj,svgn
Global tend$;tendance des pressions
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 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

Macro Coult(g,coult)
SetGadgetColor(g,#PB_Gadget_FrontColor,coult) 
EndMacro

Procedure Callback(WindowID, message, wParam, lParam);survol gadgets
  Global svgn 
  Resultat = #PB_ProcessPureBasicEvents
  Select message
   Case #WM_SETCURSOR
     svgn = GetDlgCtrlID_(wParam)
   EndSelect
   ProcedureReturn Resultat
EndProcedure
 
Procedure bts(cd); commande des boutons
  Static svgnp,Txt$,Fontg,Clt,Clf,image
   Select cd
     Case 513;bt enfoncé
       svgnp = svgn
       Select svgn
         Case 205,255,256,257;bt texte
          If svgnp = 205:Txt$ = "STOP":Fontg = FontID2:Clt = $0000FF:Clf = $7B7B7B :EndIf 
          If svgnp = 255:Txt$ = "Affiche les paramètres":Fontg = FontID2:Clt =$0:Clf = $E22B8A :EndIf
          If svgnp = 256:Txt$ = "Enregistre les paramètres":Fontg = FontID2:Clt =$0:Clf = $228B22 :EndIf
          If svgnp = 257:Txt$ = "Aide":Fontg = FontID2:Clt =$0:Clf = $1E69D2 :EndIf
          im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,1))
          SetGadgetAttribute(svgnp,#PB_Button_Image,im) 
         Case 200 To 203;bt texte
           If svgnp = 200:Txt$ = "** Lieu Principal **":EndIf
           If svgnp = 201:Txt$ = "** Lieu N°2 **":EndIf 
           If svgnp = 202:Txt$ = "** Lieu N°3 **":EndIf
           If svgnp = 203:Txt$ = "** Lieu N4 **":EndIf
           Fontg = FontID2:Clt = $00FFFF:Clf = $228B22
           im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,1))
           SetGadgetAttribute(svgnp,#PB_Button_Image,im)
         Case 252,253 ;bt texte
          For b = 200 To 203
           If b = 200:text$ = "** Lieu Principal **":EndIf 
           If b = 201:text$ = "** Lieu N°2 **":EndIf 
           If b = 202:text$ = "** Lieu N°3 **":EndIf
           If b = 203:text$ = "** Lieu N°4 **":EndIf
           Fontg = FontID2:Clt = $FF0000 :Clf = $00D7FF 
           im = ImageID(MLD_BtTxt(b,GadgetX(b),GadgetY(b),GadgetWidth(b),GadgetHeight(b),text$,Fontg,Clt,Clf,2)) 
           SetGadgetAttribute(b,#PB_Button_Image,im)
          Next  
       EndSelect
    Case 514
      svgnp = svgn
       Select svgn  
        Case 205,255,256,257;bt texte
         im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,2))
         SetGadgetAttribute(svgnp,#PB_Button_Image,im)    
      EndSelect
  EndSelect  
EndProcedure 

Procedure TimerProc3(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
 If Alt1.b = 1 
    If GetGadgetColor(37,#PB_Gadget_FrontColor) = $FFF500
     coult(37,$0045FF) 
    Else
     coult(37,$FFF500)
   EndIf
  EndIf
  If Alt2.b = 1 
    If GetGadgetColor(87,#PB_Gadget_FrontColor) = $FFF500
     coult(87,$0045FF) 
    Else
     coult(87,$FFF500)
   EndIf
  EndIf
  If Alt3.b = 1 
    If GetGadgetColor(127,#PB_Gadget_FrontColor) = $FFF500
     coult(127,$0045FF)  
    Else
     coult(127,$FFF500) 
   EndIf
  EndIf
  If Alt4.b = 1 
    If GetGadgetColor(167,#PB_Gadget_FrontColor) = $FFF500
     coult(167,$0045FF)  
    Else
     coult(167,$FFF500)  
   EndIf
  EndIf
;vent  
  If Alv1.b = 1 
    If GetGadgetColor(35,#PB_Gadget_FrontColor) = $FFF500
     coult(35,$0045FF)   
    Else
     coult(35,$FFF500)   
   EndIf
  EndIf 
  If Alv2.b = 1 
    If GetGadgetColor(85,#PB_Gadget_FrontColor) = $FFF500
     coult(85,$0045FF)   
    Else
     coult(85,$FFF500) 
   EndIf
  EndIf 
  If Alv3.b = 1 
    If GetGadgetColor(125,#PB_Gadget_FrontColor) = $FFF500
     coult(125,$0045FF)   
    Else
     coult(125,$FFF500)  
   EndIf
  EndIf
  If Alv4.b = 1 
    If GetGadgetColor(165,#PB_Gadget_FrontColor) = $FFF500
     coult(165,$0045FF)   
    Else
     coult(165,$FFF500) 
   EndIf
  EndIf 
  ;pression
  If Alp1.b = 1 
    If GetGadgetColor(42,#PB_Gadget_FrontColor) = $FFF500
     coult(42,$0045FF) 
    Else
     coult(42,$FFF500) 
   EndIf
  EndIf 
  If Alp2.b = 1 
    If GetGadgetColor(92,#PB_Gadget_FrontColor) = $FFF500
     coult(92,$0045FF) 
    Else
     coult(92,$FFF500) 
    EndIf
  EndIf
  If Alp3.b = 1 
    If GetGadgetColor(132,#PB_Gadget_FrontColor) = $FFF500
     coult(132,$0045FF) 
    Else
     coult(132,$FFF500) 
    EndIf
  EndIf 
  If Alp4.b = 1 
    If GetGadgetColor(172,#PB_Gadget_FrontColor) = $FFF500
     coult(172,$0045FF)    
    Else
     coult(172,$FFF500) 
    EndIf
  EndIf
  ;visi
  If Ali1.b = 1
    If GetGadgetColor(45,#PB_Gadget_FrontColor) = $FFF500
     coult(45,$0045FF) 
    Else
     coult(45,$FFF500)  
   EndIf
 EndIf
 If Ali2.b = 1
    If GetGadgetColor(95,#PB_Gadget_FrontColor) = $FFF500
     coult(95,$0045FF) 
    Else
     coult(95,$FFF500)   
   EndIf
 EndIf
 If Ali3.b = 1
    If GetGadgetColor(135,#PB_Gadget_FrontColor) = $FFF500
     coult(135,$0045FF) 
    Else
     coult(135,$FFF500)   
   EndIf
 EndIf
 If Ali4.b = 1
    If GetGadgetColor(175,#PB_Gadget_FrontColor) = $FFF500
     coult(175,$0045FF) 
    Else
     coult(175,$FFF500)  
   EndIf
 EndIf
EndProcedure

Procedure Alert()
  coulR2(37)
  T1 = ValD(Right(GetGadgetText(37),Len(GetGadgetText(37))-1))
  If GetGadgetText(37)<> "--"
   If T1 <= 3 Or T1 >= 25 Or Left(GetGadgetText(37),1) = "-":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 Or Left(GetGadgetText(87),1) = "-":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 Or Left(GetGadgetText(127),1) = "-":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 Or Left(GetGadgetText(167),1) = "-":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 Right(GetGadgetText(45),2) <> "Km"
    If Right(GetGadgetText(45),2) = "Km" :Ali1.b = 0:EndIf    
    If Val(Left(GetGadgetText(45),Len(GetGadgetText(45))-1))<= 2000:Ali1.b = 1:Else:Ali1.b = 0:EndIf 
   EndIf
 EndIf 
  coulR2(95)
  If GetGadgetText(95) <> "------"
   If Right(GetGadgetText(95),2) = "Km" :Ali2.b = 0:EndIf   
   If Right(GetGadgetText(95),2) <> "Km"
    If Val(Left(GetGadgetText(95),Len(GetGadgetText(95))-1))<= 2000:Ali2.b = 1:Else:Ali2.b = 0:EndIf 
   EndIf
  EndIf
  coulR2(135)
  If GetGadgetText(135) <> "------"
   If Right(GetGadgetText(135),2) = "Km" :Ali3.b = 0:EndIf  
   If Right(GetGadgetText(135),2) <> "Km" 
    If Val(Left(GetGadgetText(135),Len(GetGadgetText(135))-1))<= 2000:Ali3.b = 1:Else:Ali3.b = 0:EndIf 
   EndIf
  EndIf 
 coulR2(175)
 If GetGadgetText(175) <> "------"
  If Right(GetGadgetText(175),2) = "Km" :Ali4.b = 0:EndIf  
  If Right(GetGadgetText(175),2) <> "Km"
   If Val(Left(GetGadgetText(175),Len(GetGadgetText(175))-1))<= 2000:Ali4.b = 1:Else:Ali4.b = 0:EndIf 
  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,"Aucune"):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$)
    Select Dv.w
      Case 0 To 23, 336 To 361
        Sect$ = "N "
      Case 24 To 67
        Sect$ = "NE"
      Case 68 To 112
        Sect$ = "E "
      Case 113 To 156
        Sect$ = "SE"
      Case 157 To 202
        Sect$ = "S "
      Case 203 To 247
        Sect$ = "SW"
      Case 248 To 291
        Sect$ = "W "
      Case 292 To 335 
        Sect$ = "NW"
    EndSelect    
    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 "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$ = "Aucune"
  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
       HideGadget(17,0)  
       HideGadget(18,0)
       maj = ind
       GetWebMem("http://meteocentre.com/cgi-bin/get_sao_stn?STN=" + tabcode.s(ind) + "&DELT=12")
      EndIf 
    Wend 
    CloseFile(260)
  Else
   HideGadget(17,1)
   HideGadget(18,1) 
   Coult(19,$00FFFF)
   SetGadgetText(19,"Il n'y a pas de base météo enregistrée")
   Delay(2500)
   SetGadgetText(19,"")
   couletic2(19) 
  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)
  Coult(19,$00FFFF)
  SetGadgetText(19,"Base météo enregistrée")
  Delay(2500)
  SetGadgetText(19,"")
  couletic2(19)
EndProcedure  

Procedure listaero(E.w,p)
 StickyWindow(0,0)
 MLD_openfen(250,301 + E.w,220,315,700,"",#PB_Window_BorderLess,0,0,0,0)
 SetWindowCallback(@Callback())
 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  
MLD_TextGadget(251,0,0,30,700,L$,1,0,0,0)
SetGadgetFont(251,FontID2)  
SetGadgetColor(251,#PB_Gadget_BackColor,$00FFFF)
SetGadgetColor(251,#PB_Gadget_FrontColor,$FF0000) 
MLD_ListViewGadget(252,31,0,284,618,0,0,0,0)
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 
MLD_BtTxt(253,200,640,100,30,"Stop",FontID2,$0,$1E69D2,0);$FFFFFF,
MLD_TextGadget(254,40,655,150,1,"",0,0,0,0);tr
SetGadgetColor(254,#PB_Gadget_BackColor,$7FFF00)
;  Boucle générale
Repeat
  Select WindowEvent() 
   Case #WM_LBUTTONDOWN:bts(#WM_LBUTTONDOWN)
   Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP)  
   Case #PB_Event_Gadget
    Select EventGadget()
     Case 252 ;liste
       Select EventType()
         Case #PB_EventType_LeftClick
           Dpnl.B = 1 ;drapeau indique nouveau lieu
           nl$ = GetGadgetText(252)
           If  p = 1 :SetGadgetText(30,nl$):EndIf
           If  p = 2 :SetGadgetText(80,nl$):EndIf
           If  p = 3 :SetGadgetText(120,nl$):EndIf
           If  p = 4 :SetGadgetText(160,nl$):EndIf
           For z = 1 To 97
             If p = 1 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(30)):tabcode.s(1) = Trim(tabaero.s(2,z)):EndIf
             If p = 2 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(80)):tabcode.s(2) = Trim(tabaero.s(2,z)):EndIf
             If p = 3 And Trim(tabaero.s(1,z)) = Trim(GetGadgetText(120)):tabcode.s(3) = Trim(tabaero.s(2,z)):EndIf
             If p = 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
  EndSelect
ForEver
If Dpnl.B = 1
  Dpnl.B = 0
  maj = p
  GetWebMem("http://meteocentre.com/cgi-bin/get_sao_stn?STN=" + tabcode.s(p) + "&DELT=12")
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.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(4)    
 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$ = "Non significatif" 
 EndSelect
 ProcedureReturn Afprev$
EndProcedure 
Structure GetWebMem
  URL.s
EndStructure

Procedure GetWebMemAction(*GetWebMem.GetWebMem)
 W = maj;maj global
 InitNetwork()
 Url.s = *GetWebMem\URL.s
 FreeMemory(*GetWebMem)
 *Buffer = ReceiveHTTPMemory(Url.s)
 If *Buffer
    a$ = PeekS(*Buffer,*GetWebMem.GetWebMem , #PB_UTF8)
    PostEvent(#PB_Event_FirstCustomValue,#PB_Ignore,#PB_Ignore,#PB_Ignore,*Buffer)
    FreeMemory(*Buffer)
  Else
    Coult(19,$0045FF)
    SetGadgetText(19,"Problème de transmission")
    Delay(2500)
    SetGadgetText(19,"")
    couletic2(19):HideGadget(17,1):HideGadget(18,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) = Mid(Url.s,48,4) 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(W);traite les metar
EndProcedure    

Procedure GetWebMem(URL.s)
 HideGadget(17,0): HideGadget(18,0)
 SetGadgetText(17,""):SetGadgetText(18,"Transmission")
 *GetWebMem.GetWebMem = AllocateMemory(SizeOf(GetWebMem))
 InitializeStructure(*GetWebMem,GetWebMem)
 *GetWebMem\URL.s  = URL.s
 CreateThread(@GetWebMemAction(),*GetWebMem)
EndProcedure

Procedure Traitemetar(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$);détermine le nombre d'éléments 
 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 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                                                                     ;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                                                                     ;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(17,1)
HideGadget(18,1)
W= 0
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
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()) 
SetGadgetText(2,Date$)  
 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 affDate()
  SetGadgetText(11, FormatDate("%hh H %ii : %ss", Date()))
  h$ = GetGadgetText(11):hz$ = Left(h$,2) + Mid(h$,6,2)+Right(h$,2)
  If hz$ ="000000":calculnbjour():EndIf
EndProcedure

Procedure TimerProc2(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
  Select Minute(Date())
    Case 0 To 10, 30 To 40
     lectconfig()
  EndSelect    
EndProcedure

Procedure aide()
Dim L.s(10)  
L.s(1) = "INFORMATIONS METEO"+#CRLF$ +#CRLF$ 
L.s(2) = "Les informations sont indiquées par les aéroports par les messages [METAR] qui sont codés. (Internet obligatoire)"+#CRLF$
L.s(3) = "UTILISATION"+#CRLF$
L.s(4) = "Pour une première utilisation il faut faire un choix des lieus. Pour cela cliquez sur le bouton jaune ou il y a l'indication lieu."+#CRLF$
L.s(5) = "Faite votre choix parmis la liste des aéroports répertoriés"
L.s(6) = "Une foi les lieu indiqués, cliquez sur le bouton Enregistre les paramètres. Ceci vous permet de retrouver ces lieus,"+#CRLF$
L.s(7) = "lors d'une prochaine utilisation du logiciel par un appuis sur  le bouton Affiche les paramètres."+#CRLF$
L.s(8) = "Il est possible de consulter les informations d'un quelconque aéroport en faisant un choix dans une des listes."+#CRLF$
L.s(9) = "Les informations sont mises a jour toute les demies heure pendant 10 minutes. A ce moment les lieus enregistrés sont de nouveau affichés."+#CRLF$
L.s(10) = "Programation MLD le 18/02/2021.  Programmer avec Pure Basic 5,73 LTS(x86)"+#CRLF$
For X = 1 To 10
   LT$ = LT$ + L.s(X)
 Next
FreeArray(L.s())
MessageRequester("MLD  INFORMATIONS METEO",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)   
EndProcedure

MLD_openfen(0,300,0,1340,1040,"Ma Fenêtre",#PB_Window_BorderLess ,#PB_Window_Invisible ,0,0,0)
SetWindowCallback(@Callback())
SetClassLongPtr_(WindowID(0),#GCL_STYLE,$00020000)
SetWindowColor(0,$454545)
StickyWindow(0,1)
;gadgets
N$ = "          INFORMATIONS   METEO "
 For x = 1 To Len(N$)
   L$ = L$ + Mid(N$,x,1) + Chr(10) 
 Next
MLD_TextGadget(1,0,0,30,1040,L$,1,0,0,0)
SetGadgetFont(1,FontID3)  
SetGadgetColor(1,#PB_Gadget_BackColor,$CDC500)
SetGadgetColor(1,#PB_Gadget_FrontColor,$00FFFF)
;**date
MLD_FrameColor(16,40,30, 1280,90,FontID3,"Date",$FFFFFF,0,$D3D3D3,$454545)
MLD_StringGadget(2,50,70,340,25,"",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(3,395,70,165,25,"Heure locale",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(4,750,70,120,25,"Semaine",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(5,942,70,70,25,"Jour",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(6,1075,70,20,25,"/",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(7,1150,70,80,25,"Reste",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
coulR1(2)
For x = 3 To 7
 couletic(x)
Next  
MLD_StringGadget(11,565,70,160,25,"",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
numS$ = Str(NumSem(Date()))
If Len(numS$)<2:numS$ = "0" + numS$ :EndIf ;num semaine
MLD_StringGadget(12,872,70,50,25,numS$,#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(13,1015,70,55,25,"",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(14,1090,70,55,25,"",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
MLD_StringGadget(15,1235,70,55,25,"",#PB_String_ReadOnly,#PB_String_BorderLess,0,0)
For xx = 11 To 15
 coulR1(xx)
Next
calculnbjour()
;Lieu principal
MLD_TextGadget(21,42,220,317,25,"- Heure du bulletin -",1,0,0,0);1 = 1
MLD_TextGadget(22,42,300,317,25,"- Vent -",1,0,0,0)
MLD_TextGadget(23,42,455,317,25,"- Températures (°c) -",1,0,0,0)
MLD_TextGadget(24,42,605,317,25,"- Préssion atmosphérique -",1,0,0,0)
MLD_TextGadget(25,42,675,317,25,"- Ciel -",1,0,0,0)
MLD_TextGadget(26,42,740,317,25,"- Eléments + -",1,0,0,0)
MLD_TextGadget(27,42,850,317,25,"- Evolutions -",1,0,0,0)
For  x = 21 To 27
 couletic(x)
Next
MLD_TextGadget(190,42,925,317,25,"- Alerte -",1,0,0,0)
HideGadget(190,1)
couleticalert(190)
MLD_TextGadget(30,42,180,317,25,"-------",1,0,0,0)
MLD_TextGadget(31,80,260,120,25,"-------",1,0,0,0)
MLD_TextGadget(32,208,260,130,25,"U T C",1,0,0,0)
MLD_TextGadget(33,130,335,50,25,"----",1,0,0,0)
MLD_TextGadget(34,300,335,50,25,"----",1,0,0,0)
MLD_TextGadget(35,130,375,120,25,"--------",1,0,0,0)
MLD_TextGadget(36,235,415,120,25,"--------",1,0,0,0)
MLD_TextGadget(37,130,490,70,25,"--",0,0,0,0)
MLD_TextGadget(38,300,490,60,25,"--",0,0,0,0)
MLD_TextGadget(39,130,530,70,25,"--",0,0,0,0)
MLD_TextGadget(40,300,530,60,25,"--",0,0,0,0)
MLD_TextGadget(41,290,570,70,25,"--",0,0,0,0)
MLD_TextGadget(42,52,640,120,25,"----",1,0,0,0)
MLD_TextGadget(43,220,640,120,25,"----",1,0,0,0)
MLD_TextGadget(44,42,705,317,25,"------",1,0,0,0)
MLD_TextGadget(45,115,775,130,25,"------",1,0,0,0)
MLD_TextGadget(46,235,775,120,25,"",1,0,0,0)
MLD_TextGadget(47,190,810,160,25,"Aucune",1,0,0,0)
MLD_TextGadget(48,42,885,317,25,"Non significatif",1,0,0,0)
For  x = 30 To 48
 coulR2(x)
Next
MLD_TextGadget(58,42,340,80,20,"Direction",0,0,0,0)
MLD_TextGadget(59,220,340,80,20,"Secteur",0,0,0,0)
MLD_TextGadget(60,42,380,80,20,"Vitesse",0,0,0,0)
MLD_TextGadget(61,42,420,180,20,"Vitesse Max / 6.H",0,0,0,0)
MLD_TextGadget(62,42,495,90,20,"Extérieur",0,0,0,0)
MLD_TextGadget(63,205,495,90,20,"Ressentie",0,0,0,0)
MLD_TextGadget(64,42,535,80,20,"Min/ 6.H",0,0,0,0)
MLD_TextGadget(65,205,535,90,20,"Max/ 6.H",0,0,0,0)
MLD_TextGadget(66,42,575,200,20,"Température de rosée",0,0,0,0)
MLD_TextGadget(67,42,780,70,20,"Visibilité",0,0,0,0)
MLD_TextGadget(68,42,815,120,20,"Précipitations",0,0,0,0)
For  x = 58 To 68
 couletic2(x) 
Next
;** lieu 2
MLD_TextGadget(71,362,220,317,25,"- Heure du bulletin -",1,0,0,0)
MLD_TextGadget(72,362,300,317,25,"- Vent -",1,0,0,0)
MLD_TextGadget(73,362,455,317,25,"- Températures (°c) -",1,0,0,0)
MLD_TextGadget(74,362,605,317,25,"- Préssion atmosphérique -",1,0,0,0)
MLD_TextGadget(75,362,675,317,25,"- Ciel -",1,0,0,0)
MLD_TextGadget(76,362,740,317,25,"- Eléments + -",1,0,0,0)
MLD_TextGadget(77,362,850,317,25,"- Evolutions -",1,0,0,0)
For  x = 71 To 77
 couletic(x)
Next
MLD_TextGadget(191,362,925,317,25,"- Alerte -",1,0,0,0)
HideGadget(191,1)
couleticalert(191)
MLD_TextGadget(80,362,180,317,25,"-------",1,0,0,0)
MLD_TextGadget(81,400,260,120,25,"-------",1,0,0,0)
MLD_TextGadget(82,516,260,130,25,"U T C",1,0,0,0)
MLD_TextGadget(83,450,335,50,25,"----",1,0,0,0)
MLD_TextGadget(84,620,335,50,25,"----",1,0,0,0)
MLD_TextGadget(85,450,375,120,25,"--------",1,0,0,0)
MLD_TextGadget(86,555,415,120,25,"--------",1,0,0,0)
MLD_TextGadget(87,450,490,70,25,"--",0,0,0,0)
MLD_TextGadget(88,620,490,60,25,"--",0,0,0,0)
MLD_TextGadget(89,450,530,70,25,"--",0,0,0,0)
MLD_TextGadget(90,620,530,60,25,"--",0,0,0,0)
MLD_TextGadget(91,610,570,70,25,"--",0,0,0,0)
MLD_TextGadget(92,372,640,120,25,"----",1,0,0,0)
MLD_TextGadget(93,540,640,120,25,"----",1,0,0,0)
MLD_TextGadget(94,362,705,317,25,"------",1,0,0,0)
MLD_TextGadget(95,435,775,130,25,"------",1,0,0,0)
MLD_TextGadget(96,555,775,120,25,"",1,0,0,0)
MLD_TextGadget(97,510,810,160,25,"Aucune",1,0,0,0)
MLD_TextGadget(98,362,885,317,25,"Non significatif",1,0,0,0)
For  x = 80 To 98
 coulR2(x)
Next
MLD_TextGadget(99,362,340,80,20,"Direction",0,0,0,0)
MLD_TextGadget(100,540,340,80,20,"Secteur",0,0,0,0)
MLD_TextGadget(101,362,380,80,20,"Vitesse",0,0,0,0)
MLD_TextGadget(102,362,420,180,20,"Vitesse Max / 6.H",0,0,0,0)
MLD_TextGadget(103,362,495,90,20,"Extérieur",0,0,0,0)
MLD_TextGadget(104,525,495,90,20,"Ressentie",0,0,0,0)
MLD_TextGadget(105,362,535,80,20,"Min/ 6.H",0,0,0,0)
MLD_TextGadget(106,525,535,90,20,"Max/ 6.H",0,0,0,0)
MLD_TextGadget(107,362,575,200,20,"Température de rosée",0,0,0,0)
MLD_TextGadget(108,362,780,70,20,"Visibilité",0,0,0,0)
MLD_TextGadget(109,362,815,120,20,"Précipitations",0,0,0,0)
For  x = 99 To 109
 couletic2(x) 
Next
;** lieu 3
MLD_TextGadget(111,682,220,317,25,"- Heure du bulletin -",1,0,0,0)
MLD_TextGadget(112,682,300,317,25,"- Vent -",1,0,0,0)
MLD_TextGadget(113,682,455,317,25,"- Températures (°c) -",1,0,0,0)
MLD_TextGadget(114,682,605,317,25,"- Préssion atmosphérique -",1,0,0,0)
MLD_TextGadget(115,682,675,317,25,"- Ciel -",1,0,0,0)
MLD_TextGadget(116,682,740,317,25,"- Eléments + -",1,0,0,0)
MLD_TextGadget(117,682,850,317,25,"- Evolutions -",1,0,0,0)
For  x = 111 To 117
 couletic(x)
Next
MLD_TextGadget(192,682,925,317,25,"- Alerte -",1,0,0,0)
HideGadget(192,1)
couleticalert(192)
MLD_TextGadget(120,682,180,317,25,"-------",1,0,0,0)
MLD_TextGadget(121,720,260,120,25,"-------",1,0,0,0)
MLD_TextGadget(122,836,260,130,25,"U T C",1,0,0,0)
MLD_TextGadget(123,770,335,50,25,"----",1,0,0,0)
MLD_TextGadget(124,940,335,50,25,"----",1,0,0,0)
MLD_TextGadget(125,770,375,120,25,"--------",1,0,0,0)
MLD_TextGadget(126,875,415,120,25,"--------",1,0,0,0)
MLD_TextGadget(127,770,490,70,25,"--",0,0,0,0)
MLD_TextGadget(128,940,490,60,25,"--",0,0,0,0)
MLD_TextGadget(129,770,530,70,25,"--",0,0,0,0)
MLD_TextGadget(130,940,530,60,25,"--",0,0,0,0)
MLD_TextGadget(131,930,570,70,25,"--",0,0,0,0)
MLD_TextGadget(132,692,640,120,25,"----",1,0,0,0)
MLD_TextGadget(133,860,640,120,25,"----",1,0,0,0)
MLD_TextGadget(134,682,705,317,25,"------",1,0,0,0)
MLD_TextGadget(135,755,775,130,25,"------",1,0,0,0)
MLD_TextGadget(136,875,775,120,25,"",1,0,0,0)
MLD_TextGadget(137,830,810,160,25,"Aucune",1,0,0,0)
MLD_TextGadget(138,682,885,317,25,"Non significatif",1,0,0,0)
For  x = 120 To 138
 coulR2(x)
Next
MLD_TextGadget(139,682,340,80,20,"Direction",0,0,0,0)
MLD_TextGadget(140,860,340,80,20,"Secteur",0,0,0,0)
MLD_TextGadget(141,682,380,80,20,"Vitesse",0,0,0,0)
MLD_TextGadget(142,682,420,180,20,"Vitesse Max / 6.H",0,0,0,0)
MLD_TextGadget(143,682,495,90,20,"Extérieur",0,0,0,0)
MLD_TextGadget(144,845,495,90,20,"Ressentie",0,0,0,0)
MLD_TextGadget(145,682,535,80,20,"Min/ 6.H",0,0,0,0)
MLD_TextGadget(146,845,535,90,20,"Max/ 6.H",0,0,0,0)
MLD_TextGadget(147,682,575,200,20,"Température de rosée",0,0,0,0)
MLD_TextGadget(148,682,780,70,20,"Visibilité",0,0,0,0)
MLD_TextGadget(149,682,815,120,20,"Précipitations",0,0,0,0)
For  x = 139 To 149
 couletic2(x) 
Next
;lieu 4
MLD_TextGadget(151,1002,220,317,25,"- Heure du bulletin -",1,0,0,0)
MLD_TextGadget(152,1002,300,317,25,"- Vent -",1,0,0,0)
MLD_TextGadget(153,1002,455,317,25,"- Températures (°c) -",1,0,0,0)
MLD_TextGadget(154,1002,605,317,25,"- Préssion atmosphérique -",1,0,0,0)
MLD_TextGadget(155,1002,675,317,25,"- Ciel -",1,0,0,0)
MLD_TextGadget(156,1002,740,317,25,"- Eléments + -",1,0,0,0)
MLD_TextGadget(157,1002,850,317,25,"- Evolutions -",1,0,0,0)
For  x = 151 To 157
 couletic(x)
Next
MLD_TextGadget(193,1002,925,317,25,"- Alerte -",1,0,0,0)
HideGadget(193,1)
couleticalert(193)
MLD_TextGadget(160,1002,180,317,25,"-------",1,0,0,0)
MLD_TextGadget(161,1040,260,120,25,"-------",1,0,0,0)
MLD_TextGadget(162,1156,260,130,25,"U T C",1,0,0,0)
MLD_TextGadget(163,1090,335,50,25,"----",1,0,0,0)
MLD_TextGadget(164,1260,335,50,25,"----",1,0,0,0)
MLD_TextGadget(165,1090,375,120,25,"------",1,0,0,0)
MLD_TextGadget(166,1195,415,120,25,"------",1,0,0,0)
MLD_TextGadget(167,1090,490,70,25,"--",0,0,0,0)
MLD_TextGadget(168,1260,490,55,25,"--",0,0,0,0)
MLD_TextGadget(169,1085,530,70,25,"--",0,0,0,0)
MLD_TextGadget(170,1260,530,55,25,"--",0,0,0,0)
MLD_TextGadget(171,1250,570,60,25,"--",0,0,0,0)
MLD_TextGadget(172,1012,640,120,25,"----",1,0,0,0)
MLD_TextGadget(173,1180,640,120,25,"----",1,0,0,0)
MLD_TextGadget(174,1002,705,317,25,"------",1,0,0,0)
MLD_TextGadget(175,1075,775,130,25,"------",1,0,0,0)
MLD_TextGadget(176,1195,775,120,25,"",1,0,0,0)
MLD_TextGadget(177,1150,810,160,25,"Aucune",1,0,0,0)
MLD_TextGadget(178,1002,885,317,25,"Non significatif",1,0,0,0)
For  x = 160 To 178
 coulR2(x)
Next
MLD_TextGadget(179,1002,340,80,20,"Direction",0,0,0,0)
MLD_TextGadget(180,1180,340,80,20,"Secteur",0,0,0,0)
MLD_TextGadget(181,1002,380,80,20,"Vitesse",0,0,0,0)
MLD_TextGadget(182,1002,420,180,20,"Vitesse Max / 6.H",0,0,0,0)
MLD_TextGadget(183,1002,495,90,20,"Extérieur",0,0,0,0)
MLD_TextGadget(184,1165,495,90,20,"Ressentie",0,0,0,0)
MLD_TextGadget(185,1002,535,80,20,"Min/ 6.H",0,0,0,0)
MLD_TextGadget(186,1165,535,90,20,"Max/ 6.H",0,0,0,0)
MLD_TextGadget(187,1002,575,200,20,"Température de rosée",0,0,0,0)
MLD_TextGadget(188,1002,780,70,20,"Visibilité",0,0,0,0)
MLD_TextGadget(189,1002,815,120,20,"Précipitations",0,0,0,0)
For  x = 179 To 189
 couletic2(x) 
Next
MLD_TextGadget(401,40,120,1,940,"",0,0,0,0);tr
MLD_TextGadget(402,1319,120,1,940,"",0,0,0,0);tr
MLD_TextGadget(403,40,960,1280,1,"",0,0,0,0);tr
MLD_TextGadget(404,360,120,1,840,"",0,0,0,0);tr
MLD_TextGadget(405,680,120,1,840,"",0,0,0,0);tr
MLD_TextGadget(406,1000,120,1,840,"",0,0,0,0);tr
For  x = 401 To 406
  coultrait(x)
Next
MLD_BtTxt(200,55,135,290,27,"** Lieu Principal **",FontID2,$FF0000,$00D7FF,0);bt Lp
MLD_BtTxt(201,375,135,290,27,"** Lieu N° 2 **",FontID2,$FF0000,$00D7FF,0);bt L2 
MLD_BtTxt(202,695,135,290,27,"** Lieu N° 3 **",FontID2,$FF0000,$00D7FF,0);bt L3) 
MLD_BtTxt(203,1015,135,290,27,"** Lieu N° 4**",FontID2,$FF0000,$00D7FF,0);bt L4 
MLD_BtTxt(205,1230,980,80,50,"STOP",FontID2,$0000FF,$7B7B7B,0)
MLD_TextGadget(17,50,990,20,20,"",0,0,0,0)
SetGadgetColor(17,#PB_Gadget_BackColor,$7FFF00)
HideGadget(17,1)
MLD_TextGadget(18,75,988,160,25,"",0,0,0,0)
coulR1(18)
HideGadget(18,1)
MLD_TextGadget(19,240,992,370,20,"",0,0,0,0)
couletic2(19)
MLD_BtTxt(257,1090,980,140,50,"Aide",FontID2,$0,$1E69D2,0)
MLD_BtTxt(256,860,980,230,50,"Enregistre les paramètres",FontID2,$0,$228B22,0)
MLD_BtTxt(255,640,980,220,50,"Affiche les paramètres",FontID2,$0,$E22B8A,0);bt L4 
HideWindow(0,0)
AddWindowTimer(0, 1, 1000):BindEvent(#PB_Event_Timer,@affDate(), 0)
SetTimer_ (Handle1, 3, 800, @TimerProc3()) 
SetTimer_ (Handle1, 2, 60000, @TimerProc2())
aero()
;  Boucle générale
Repeat
 Select WindowEvent() 
  Case #WM_LBUTTONDOWN:bts(#WM_LBUTTONDOWN)
  Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP) 
  Case #PB_Event_Gadget 
   Select EventGadget()
     Case 200
       listaero(y(42),1)
     Case 201
       listaero(y(362),2)
     Case 202
       listaero(y(682),3)
     Case 203
       listaero(y(1002),4)
     Case 255
       lectconfig()
     Case 256
       enrconfig()
     Case 257
       aide()
     Case 205;btstop 
       FreeArray(tabaero.s())
       FreeArray(tabcode.s())
       FreeArray(tabligmetar.s())
       CloseWindow(0)
     Break 
 EndSelect
 EndSelect
ForEver
Dernière modification par MLD le sam. 20/févr./2021 9:57, modifié 1 fois.
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Informations METEO

Message par Micoute »

Bien remanié, en effet.
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
TazNormand
Messages : 1294
Inscription : ven. 27/oct./2006 12:19
Localisation : Calvados (14)

Re: Informations METEO

Message par TazNormand »

Copie du PBI de MLD dans ce topic

Code : Tout sélectionner

;**********************
;MLD le 18/02/2021
;PB 5.73 LTS X86
;Standard Interface Graphique
;**********************

#Ldef = 1920:#Hdef = 1080 :#Corf = 12

Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Global typH.b
Global St
Global L.d,Hwq.d
hdc = GetDC_(GetDesktopWindow_())
If hdc : dpiX.d = GetDeviceCaps_(hdc, #LOGPIXELSX) :EndIf
If hdc : Global dpiY.d = GetDeviceCaps_(hdc, #LOGPIXELSY) : ReleaseDC_(GetDesktopWindow_(), hdc) : EndIf
Global mmx.d = (dpiX / 2.54)/10
Global mmy.d = (dpiY / 2.54)/10
  If definecrht.d = #Hdef And dpiY.d = 96
    dft.w = #Corf
    Global FontID0 = LoadFont(0, "Arial",dft.w,#PB_Font_HighQuality)
  Else
    dft.W = (#Corf / (#Hdef/definecrht.d)-1)
    If dft.W < 7 : dft.W = 7:EndIf
    Global FontID0 = LoadFont(0, "Microsoft Sans Serif",dft.w,#PB_Font_HighQuality)
  EndIf 
  SetGadgetFont(#PB_Default, FontID(0))

#LVM_GETHEADER = #LVM_FIRST + 31 ;Hauteur du header des listIcon
Global oldproc.l, newheight.l
Procedure.l WinProc(hWnd.l, Msg.l, wParam.l, lParam.l)
    result.l = 0
    If Msg = #HDM_LAYOUT
        result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
        *hdlayout.HD_LAYOUT = lParam
        If *hdlayout\prc <> 0
            *rect.RECT = *hdlayout\prc
            *rect\top = newheight
        EndIf
        If *hdlayout\pwpos <> 0
            *windowpos.WINDOWPOS = *hdlayout\pwpos
            *windowpos\cy = newheight
        EndIf
    Else
        result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
    EndIf
    ProcedureReturn result
  EndProcedure
 
Procedure Ywp(y.d)
Select y.d
  Case 0
   ProcedureReturn 0 ;en haut de l'écran
Default
  If definecrht.d = #Hdef
   ProcedureReturn y.d
  Else
   ProcedureReturn y.d * (definecrht /#Hdef)
  EndIf
EndSelect   
EndProcedure

Procedure Hw(Dh.d,typH.b)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
If OSVersion() = #PB_OS_Windows_XP
EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
EPframeH.d = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate) 
EndIf 
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
Case 1 ;fen avec titre et haut max
  If St = 0 
   Hwq.d = definecrht - (Httitre.d + EPframeH)
   ProcedureReturn Hwq.d
  Else ; fen sans titre et hauteur max
   Hwq.d = definecrht
   ProcedureReturn Hwq.d
  EndIf
Case 2 ;fen avec titre et barre de tache win visible
  If St = 0   
   Hwq.d = definecrht - (htTaskbarwin  + Httitre.d  + EPframeH)+5
   ProcedureReturn hwq.d
  Else  ; fen sans titre et barre de tache win visible
   Hwq.d = definecrht - htTaskbarwin
   ProcedureReturn Hwq.d
  EndIf
Default ;fen quelconque
  If Dh = 0:Dh = 1:EndIf
  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)
Select lp.d
Case 0
  ProcedureReturn 1 ;a gauche
Default
  If definecrlarg <> #Ldef
   ProcedureReturn lp.d * (definecrlarg /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf
EndSelect
EndProcedure

Procedure Lw(dL.d)
Select dL.d
Case 0
   If St = 0 ;largeur max avec bordure
    L.d = definecrlarg - 10
    ProcedureReturn L.d
   Else ;largeur max sans bordure
    L.d = definecrlarg
    ProcedureReturn L.d
   EndIf
Default
  If definecrlarg <> #Ldef
    L.d = dL * (definecrlarg /#Ldef)
    ProcedureReturn L.d
   Else
     L.d = dL
     ProcedureReturn L.d
   EndIf
EndSelect
EndProcedure

Procedure MLD_openfen(ng.d,x.d,y.d,Lf.d,H.d,titre$,opt1.l,opt2.l,opt3.l,opt4.l,typH.b)
  If y.d <> 0 :typH.b = 0:EndIf
  Select #PB_Window_BorderLess
   Case opt1.l,opt2.l,opt3.l,opt4.l
    Global St = 1
   Default
     Global St = 0
     If L.d < 300 And L.d > 0:L.d = 300:EndIf
  EndSelect
  Select #PB_Window_ScreenCentered
   Case opt1.l,opt2.l,opt3.l,opt4.l
     typH.b =0
EndSelect
If opt1.l = 0 And opt2.l = 0 And opt3.l = 0 And opt4.l = 0; les options ne supporte pas les 0(pas de bouton)
    OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$)
Else 
   OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$,opt1.l|opt2.l|opt3.l|opt4.l)
   a.d = Xwp(x.d)
EndIf
EndProcedure   

Procedure X(lg.d)
  ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure

Procedure y(h.d)
  ProcedureReturn h *(definecrht.d /#Hdef)
EndProcedure

Procedure MLD_ButtonGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  ButtonGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$, Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_ButtonImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  If img.d = 0
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),0, Opt1|Opt2|Opt3|Opt4)
  Else 
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),ImageID(img.d), Opt1|Opt2|Opt3|Opt4)
  EndIf
EndProcedure

Procedure MLD_GetEntoureBt(Gad);1 le bouton est entouré 0 = pas d'entourage
  ProcedureReturn Val(Right(Hex(GetWindowLong_(GadgetID(Gad), #GWL_STYLE)),1))
EndProcedure

Procedure Cibt(num,larg,haut,coulfond,pos);utile pour boutons Cibt = change image bouton
CreateImage(num, X(larg),Y(haut))                                                           
StartDrawing(ImageOutput(num))
DrawingMode(#PB_2DDrawing_Gradient) ;Dessine le fond de l'image
  If pos = 1
   BackColor($FFFFFF):FrontColor(coulfond)
  Else 
   BackColor(coulfond):FrontColor($FFFFFF)
  EndIf
  LinearGradient(0,Y(haut) *1.5,0,0)
  Box(0,0,X(larg),Y(haut)) 
EndProcedure 

Procedure MLD_BtTxt(Gad,x.D,y.D,larg.D,haut.D,txt$,font,coultext,coulfond,pos) ;le num de gadget ne doit jamais être 0
  Cibt(Gad,larg,haut,coulfond,pos)
  ; Position du texte
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(font)
  hautxt = TextHeight(txt$)
  largtxt = TextWidth(txt$)
  ctrtxt = (X(larg) - largtxt)/2 ; centre le text en largeur
  ctxt=(Y(haut) - hautxt)/2  ; centre le text en hauteur
  DrawText(ctrtxt,ctxt,txt$,coultext)
  StopDrawing ()
  If pos = 0
    MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
  Else
    ProcedureReturn Gad
  EndIf 
EndProcedure

Procedure MLD_CanvasGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  CanvasGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure

Procedure MLD_FrameGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   FrameGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$, Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_FrameColor(ID, x, y, Larg, Haut,Font,Texte$,CouleurTexte,Form,CouleurBordure,CouleurFond)
  ;Création du Gadget
  MLD_CanvasGadget(ID,x,y,Larg,Haut,0,0,0,0)
  ;Dessin
  StartDrawing(CanvasOutput(ID))
  ;Dim du texte
  DrawingMode(#PB_2DDrawing_Default)
  Box(0, 0, X(Larg),Y(Haut),CouleurFond);
  If Font = 0;font txt
      DrawingFont(#PB_Default)
    Else 
      DrawingFont(Font)
   EndIf
  W=TextWidth(Texte$)
  H=TextHeight("MgWy")
  ;Cadre
  DrawingMode(#PB_2DDrawing_Outlined )
  Select Form ;0 = coin carré. 1 = coins arrondis
    Case 0 ;Standard 
      Box(0, Y(H/2+1),X(Larg),Y(Haut-H/2-1),CouleurBordure)
      DecalageGauche = Y(10)
    Case 1;arrondi
      RoundBox(0,Y(H/2+1),X(Larg),Y(Haut-H/2-1), 20, 20, CouleurBordure)
      DecalageGauche = y(25)
    Default
      Box(0, Y(H/2+1),X(Larg),Y(Haut-H/2-1),CouleurBordure)
      DecalageGauche = y(10)
    EndSelect
    ;Texte
    If Texte$ = ""
     DrawText(DecalageGauche, 0,"", CouleurTexte, CouleurFond)
    Else 
      DrawText(DecalageGauche, 0," "+ Texte$ + " ", CouleurTexte, CouleurFond)
    EndIf 
   StopDrawing()
   DisableGadget(ID,1)
EndProcedure

Procedure MLD_ListViewGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
   ListViewGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_StringGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  StringGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure

Procedure MLD_TextGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  TextGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure
Image
Image
Avatar de l’utilisateur
MLD
Messages : 1103
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Re: Informations METEO

Message par MLD »

Merci a Taz et Ar-S
Étourderie de ma part
Bonne soirée
Michel
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Informations METEO

Message par Micoute »

C'est vrai, on ne devrait jamais séparer les familles.
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
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Informations METEO

Message par Kwai chang caine »

Merci pour le partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre