Metaero: la météo des aéroports
Publié : ven. 02/sept./2022 13:41
Bonjour a tous.
Pour mon retour sur ce forum, voici une nouvelle version d'un logiciel d'indications météo émis par les aéroports par les messages METAR.
Tout est dans l'aide.
Pour mon retour sur ce forum, voici une nouvelle version d'un logiciel d'indications météo émis par les aéroports par les messages METAR.
Tout est dans l'aide.
Code : Tout sélectionner
;Metaero la météo des aéroports
;MLD le 1/09/2022: compilation PB6.00LS T(X86)
;¤¤¤¤ Assignation des gadgets ¤¤¤¤
#Fp = 1:#etictitre = 2:#eticlogo = 3
#Eticlist = 10:#listaero = 11:#Eticlist2 = 12:#eticdate = 13:#resultdate = 14:#resultdate2 = 15:#aerop = 16:#aerop2 = 17:#aerop3 = 18
#trans1 = 19:#trans2 = 20:#eticalert = 21:#eticprev = 22:#eticaeroenr = 23:#resultaeroenr = 24
#bt_barre = 101:#bt_stop = 102:#bt_adf = 103:#bt_radf = 104:#bt_aid = 105
#etic_vt1 = 200:#etic_vt2 = 201:#etic_vt3 = 202:#etic_vt4 = 203:#etic_vt5 = 204
#rp_vt1 = 210:#rp_vt2 = 211:#rp_vt3 = 212:#rp_vt4 = 213
#etict_tp1 = 300:#etict_tp2 = 301:#etict_tp3 = 302:#etict_tp4 = 303:#etict_tp5 = 304:#etict_tp6 = 305
#rp_tp1 = 310:#rp_tp2 = 311:#rp_tp3 = 312:#rp_tp4 = 313:#rp_tp5 = 314
#etic_atmo1 = 400:#etic_atmo2 = 401:#etic_atmo3 = 402:#etic_atmo4 = 403:#etic_atmo5 = 404:#etic_atmo6 = 405
#rp_atmo1 = 410:#rp_atmo2 = 411:#rp_atmo3 = 412:#rp_atmo4 = 413:#rp_atmo5 = 414
#rp_prev = 420
#traithz1 = 500:#traithz2 = 501
#traitv1 = 510:#traitv2 = 511
#fADR = 600
;¤¤¤¤¤¤¤¤
Structure GetWebMem
URL.s
EndStructure
Declare GetWebMem(URL.s)
Declare GetWebMemAction(*GetWebMem.GetWebMem)
Global datloc$
Global Dim tabaero.s(2,96);tableau des aéroports
Global Dim tabligmetar.s(0)
Global aeronum;numéro dans la table des aéroport
Global Hdb$ ;minute dans l'heure du bulletin
Global indexapplig.b;index pour appel en cours 0=ok 1= interdit
Global indcx ;indice de connexion 0 = ok 1 = pas de connexion
Global indvent.w;indice pour les vents
Global indtemp.w;indice température
Global afobv$,afpr$ ;condition de visibilité ou précipitation
Global altv1.b,altv2.b,altp.b,altprs.b,altttt.b,altvisi.b
Macro coulf(gad)
SetGadgetColor(gad,#PB_Gadget_BackColor,$A8941D)
EndMacro
Macro coult(gad,ct,ft)
SetGadgetColor(gad,#PB_Gadget_FrontColor,ct):SetGadgetFont(gad,ft)
EndMacro
#Ldef = 1920:#Hdef = 1080
Global typH.b,L.d
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN):Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
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 Hw(Dh.d,typH.b)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
If opt1.l = #PB_Window_BorderLess
OpenWindow(2000,0,0,200,200,"",#PB_Window_BorderLess|#PB_Window_Invisible)
Else
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
EndIf
EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
Case 1 ;fen avec titre et haut max
Hwq.d = definecrht - Httitre.d
Case 2 ;fen avec titre et barre de tache win visible
Hwq.d = definecrht - (htTaskbarwin + Httitre.d + EPframeH)
Case 3 ;fen sans titre et hauteur max
Hwq.d = definecrht
Case 4 ;fen sans titre et barre de tache win visible
Hwq.d = definecrht - htTaskbarwin
Default ;fen quelconque
Hwq.d = Dh * (definecrht /#Hdef)
EndSelect
ProcedureReturn Hwq.d
EndProcedure
Procedure Lw(dL.d)
L.d = dL * (definecrlarg /#Ldef)
ProcedureReturn L.d
EndProcedure
Procedure Ywp(y.d)
ProcedureReturn y.d *(definecrht.d /#Hdef)
EndProcedure
Procedure XWp(lp.d)
ProcedureReturn lp.d * (definecrlarg /#Ldef)
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 typH.b <> 0 : y.d = 0:EndIf
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)
EndProcedure
Procedure X(lg.d)
ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure
Procedure y(h.d)
ProcedureReturn h *(definecrht.d /#Hdef)
EndProcedure
Global FontID0 = LoadFont(0,"Tahoma", X(12))
Global FontID1 = LoadFont(1,"Segoe Print",X(20),#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"Segoe Print",X(14),#PB_Font_HighQuality)
Global FontID3 = LoadFont(3,"Tahoma", X(16),#PB_Font_HighQuality)
Global FontID4 = LoadFont(4,"Tahoma", X(14),#PB_Font_HighQuality)
Global FontID5 = LoadFont(5,"Segoe Print", X(28),#PB_Font_HighQuality)
Global FontID6 = LoadFont(6,"Tahoma", X(28),#PB_Font_HighQuality)
Global FontID7 = LoadFont(7,"Segoe Print", X(36),#PB_Font_HighQuality)
Global FontID8 = LoadFont(8,"Tahoma", X(16),#PB_Font_Bold|#PB_Font_HighQuality)
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_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_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
Procedure MLD_ImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
If img.d = 0
idimg.d = 0
Else
idimg.d = ImageID(img.d)
EndIf
ImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),idimg.d, Opt1|Opt2|Opt3|Opt4)
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 bts(cd); commande des boutons
Static svgnp,Txt$,Fontg,Clt,Clf,image
Select cd
Case 513;bt enfoncé
svgnp = svgn
Select svgnp
Case 101 To 105;bt texte
If svgnp = 101:Txt$ = "Barre":Fontg = FontID8:Clt = $FF0000:Clf = $A8758B :EndIf
If svgnp = 102:Txt$ = "Stop":Fontg = FontID8:Clt = $FF0000:Clf = $008CFF:EndIf
If svgnp = 103:Txt$ = "E A D R":Fontg = FontID8:Clt = $FF0000:Clf = $56B82D:EndIf
If svgnp = 104:Txt$ = "A D R":Fontg = FontID8:Clt = $FF0000:Clf = $8968CD:EndIf
If svgnp = 105:Txt$ = "Aide":Fontg = FontID8:Clt = $FF0000:Clf = $00ADCD: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)
EndSelect
Case 514
Select svgnp
Case 101 To 105;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 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 CDG (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 (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)-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 = 96;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 aide()
Dim L.s(12)
L.s(1) = "INFORMATIONS "+#CRLF$ +#CRLF$
L.s(2) = " Chaque aéroport indique la météo observée du lieu, et une prévision pour les 4 heures a venir. Ceci par l'interdédiaire des messages [METAR] qui sont codés. (Internet obligatoire)"+#CRLF$+#CRLF$
L.s(3) = "UTILISATION"+#CRLF$
L.s(4) = " L'utilisation de ce logiciel est très simple. A l'ouverture les données météo de l'aéroport choisi sont indiquées. "+#CRLF$
L.s(5) = " Une mise à jour de l'observation et des prévisions a lieu toutes les 30 minutes à partir de l'heure pleine, ceci pendant 10 minutes."
L.s(6) = "Pendant ce laps de temps le logiciel appel l'aéroport toutes les minutes jusqu'à la mise à jour. (L'état de la transmission est indiqué.)"+#CRLF$
L.s(7) = " Vous pouvez choisir un aéroport de référence parmi ceux de la liste. Ensuite, pour l'enregistrer cliquez sur le bouton EADR. (Enregistre l'aéroport de référence.)"+#CRLF$
L.s(8) = " Le bouton ADR, (aéroport de référence) vous ramène directement sur celui-ci."+#CRLF$
L.s(9) = " En cas d'événements extrêmes, une alerte vous seras indiqué."+#CRLF$+#CRLF$
L.s(10) = "PREMIERE UTILISATION"+#CRLF$
L.s(11) = " Comme aucun aéroport de référence n'a été enregistré, c'est Paris CDG qui est pris en compte."+#CRLF$+#CRLF$
L.s(12) = "Programation MLD le 01/09/2022. Programmer avec Pure Basic 6,00 LTS(x86)"+#CRLF$+#CRLF$
For X = 1 To 12
LT$ = LT$ + L.s(X)
Next
FreeArray(L.s())
MessageRequester("MLD METAERO: LA METEO DES AEROPORTS",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndProcedure
Procedure apmet(numaero)
indexapplig.b = 1;un appel est en cours
GetWebMem("http://meteocentre.com/cgi-bin/get_sao_stn?STN=" + tabaero.s(2,numaero) + "&DELT=12")
EndProcedure
Procedure$ aeroref()
Padr = ReadFile(600,"ADR")
If Padr = 0
aeronum = 69;global
CreateFile(600,"ADR")
WriteStringN(600,Str(aeronum))
CloseFile(600)
ReadFile(600,"ADR")
While Eof(600) = 0
aeronum = Val(ReadString(600))
Wend
SetGadgetText(17,tabaero.s(1,aeronum)):SetGadgetText(24,tabaero.s(1,aeronum))
SetGadgetState(11,aeronum - 1)
apmet(69)
Else
While Eof(600) = 0
aeronum = Val(ReadString(600))
Wend
SetGadgetText(17,tabaero.s(1,aeronum)):SetGadgetText(24,tabaero.s(1,aeronum))
SetGadgetState(11,aeronum -1)
apmet(aeronum)
EndIf
CloseFile(600)
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$ = "Ce jour "+Jour$ +" " + FormatDate(" %dd ", Date()) + Mois$ + FormatDate(" %yyyy", Date()) + " Heure locale:"
;pour le placement automatique des gadgets date heure locale
StartDrawing(WindowOutput(1))
DrawingMode(#PB_2DDrawing_Transparent)
FrontColor($A8941D):BackColor($A8941D)
DrawingFont(FontID(5))
lrggad =TextWidth(Date$)-19
StopDrawing()
ResizeGadget(13,#PB_Ignore,#PB_Ignore,lrggad +20,#PB_Ignore)
ResizeGadget(14,GadgetY(13)+ lrggad ,#PB_Ignore,#PB_Ignore,#PB_Ignore)
SetGadgetText(13,Date$)
If bissextile(Year(Date())) = 1
totalj.w = 366
Else
totalj.w = 365
EndIf
nbjt.w = DayOfYear(Date())
diffjour.w = totalj - nbjt.w
numS$ = Str(NumSem(Date()))
If Len(numS$)<2:numS$ = "0" + numS$ :EndIf ;num semaine
If diffjour.w < 2:df$ = "jour": Else : df$ = "jours": EndIf
SetGadgetText(15,"Semaine " + numS$ + " Jour " + Str(nbjt.w) + " / " + Str(totalj.w) + " Reste " + Str(diffjour.w)+ " " + df$)
EndProcedure
Procedure TimerProc(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
Select uMsg
Case #WM_TIMER
dt$ = FormatDate("%hh h %ii : %ss", Date())
If Left(dt$,2)= "00" And Mid(dt$,6,2) ="00":calculnbjour():EndIf
SetGadgetText(14,dt$)
EndSelect
EndProcedure
Procedure.s ventdir()
lg1$ = tabligmetar.s(1)
vent$ = StringField(lg1$,indvent.w," ")
dir$ = Left(vent$,3)
If dir$ = "VRB" Or dir$ = "000" Or dir$ = "///"
result$ = "Var"
ProcedureReturn result$
Else
Dv.w = Val(dir$)
Select Dv.w
Case 0 To 23, 336 To 361
Sect$ = "Nord"
Case 24 To 67
Sect$ = "Nord Est"
Case 68 To 112
Sect$ = "Est "
Case 113 To 156
Sect$ = "Sud Est"
Case 157 To 202
Sect$ = "Sud "
Case 203 To 247
Sect$ = "Sud West"
Case 248 To 291
Sect$ = "West "
Case 292 To 335
Sect$ = "Nord West"
EndSelect
result$ = dir$ + Sect$
ProcedureReturn result$
EndIf
EndProcedure
Procedure.s ventvit();vitesse du vent
dpraf = 0
lg1$ = tabligmetar.s(1)
vent$ = StringField(lg1$,indvent.w," ")
maxraf.w = 0:maxvent.w = 0
For zz = 1 To ArraySize(tabligmetar.s())
If FindString(vent$,"G",1) <> 0;il y a eu des rafales
raf.W = Val(Mid(StringField(tabligmetar.s(zz),indvent.w," "),7,2))* 1.852:raf.w = raf.w - (raf*10)/100
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:Vvent.w = Vvent.w - (Vvent.w*10)/100 ;vitesse vent
If Vvent.w > maxvent.w : maxvent.w = Vvent.w:EndIf ;maxi vent
Next
If maxraf.w > maxvent.w : maxvent.w = maxraf.w:dpraf = 1:EndIf
vk.w = Val(Mid(StringField(tabligmetar.s(1),indvent.w," "),4,2))* 1.852:vK.w = vK.w - (vK.w*10)/100
If dpraf = 1
ProcedureReturn Str(vk.w)+"Km/H"+ "¤" + Str(maxvent.w)+"Km/H"
Else
ProcedureReturn Str(vk.w)+"Km/H"+ "_" + Str(maxvent.w)+"Km/H"
EndIf
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:sig$ = "- ":Else: sig$ = "+ ":EndIf
Tpext$ = sig$ + Right(tpe$,2);temp sous abris
If Len(tpr$)= 3:sig2$ = "- ":Else: sig2$ = "+ ":EndIf
Tr$ = sig2$ + Right(tpr$,2);point de rosée
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$ = Left(StrD(tp.d,0),1)+ " "+Right(StrD(tp.d,0),Len(StrD(tp.d,0))-1):EndIf;pour mettre un signe et un espace
If Len(Tmax$)< 4:Tmax$ = Left(Tmax$,2) + "0" + Right(Tmax$,1):EndIf;pour mettre un 0 devant des temp < a 10
If tm.d > 0:Tmin$ = "+ " + StrD(tm.d,0):Else:Tmin$ = Left(StrD(tm.d,0),1)+ " "+Right(StrD(tm.d,0),Len(StrD(tm.d,0))-1):EndIf;pour mettre un signe et un espace
If Len(Tmin$)< 4:Tmin$ = Left(Tmin$,2) + "0" + Right(Tmin$,1):EndIf;pour mettre un 0 devant des temp < a 10
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:caltp$ = "- " + Right(tpe$,2):Else:caltp$ = tpe$:EndIf ;pour le calcul des temps ressenties
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$ = Left(StrD(tpr.d,0),1)+ " "+ Right(StrD(tpr.d,0),Len(StrD(tpr.d,0))-1):EndIf;pour mettre un signe et un espace
If Len(Trs$)< 4:Trs$ = Left(Trs$,2) + "0" + Right(Trs$,1):EndIf;pour mettre un 0 devant des temp < a 10
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$,"=")
If ArraySize(tabligmetar.s())< 4
lg2$ = lg1$
Else
lg2$ = tabligmetar.s(4)
EndIf
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$ ciel()
lg1$ = tabligmetar.s(1)
cl$ = StringField(lg1$,indtemp.w -1," ")
afcl$ = "clair"
If FindString(cl$,"FEW",1) <> 0:afcl$ = "Nuages peu nombreux":EndIf
If FindString(cl$,"SCT",1) <> 0:afcl$ = "Nuages éparts":EndIf
If FindString(cl$,"BKN",1) <> 0:afcl$ = "Nuages Fragmentés":EndIf
If FindString(cl$,"OVC",1) <> 0:afcl$ = "Couvert":EndIf
If FindString(cl$,"NSC",1) <> 0:afcl$ = "Relativement clair":EndIf
If FindString(cl$,"NCD",1) <> 0:afcl$ = "Clair":EndIf
If FindString(cl$,"SKC",1) <> 0:afcl$ = "Clair":EndIf
If FindString(cl$,"VV",1) <> 0:afcl$ = "Couvert avec nuages bas":EndIf
If FindString(cl$,"CB",1) <> 0:afcl$ = "Cumuloninbus (orages)":EndIf
If FindString(cl$,"TCU",1) <> 0:afcl$ = "Cumulus bourgeonnants":EndIf
ProcedureReturn afcl$
EndProcedure
Procedure.s precip()
lg1$ = tabligmetar.s(1)
pr$ = StringField(lg1$,indtemp.w - 2," ")
f$ = Left(pr$,1)
Select f$
Case "-"
af$ = " Faible "
Case "+"
af$ = " Forte "
Default
af$ = ""
EndSelect
afpr$ = "Aucune"
If FindString(pr$,"GS",1) <> 0: afpr$ = "Neige roulée (Grésil)":EndIf
If FindString(pr$,"TS",1) <> 0: afpr$ = "Pluie d'orage":EndIf
If FindString(pr$,"RA",1) <> 0: afpr$ = af$ + "Pluie continue":EndIf
If FindString(pr$,"SN",1) <> 0: afpr$ = af$ + "Neige continue":EndIf
If FindString(pr$,"GR",1) <> 0: afpr$ = "Grèle":EndIf
If FindString(pr$,"DZ",1) <> 0: afpr$ = "Bruine":EndIf
If FindString(pr$,"SQ",1) <> 0: afpr$ = "Grains":EndIf
If FindString(pr$,"SH",1) <> 0:
av$ = "Averse de "
If FindString(pr$,"RA",1) <> 0: afpr$ = af$ + av$ + "pluie":EndIf
If FindString(pr$,"SN",1) <> 0: afpr$ = af$ + av$ + "neige":EndIf
If FindString(pr$,"GR",1) <> 0: afpr$ = af$ + av$ + "grèle":EndIf
EndIf
ProcedureReturn afpr$
EndProcedure
Procedure.s visi()
altvisi.b = 0;alerte visi a zéro (dans global)
lg1$ = tabligmetar.s(1)
fin.w = Len(lg1$);détermine le nombre d'éléments
long.w = 0 ;5
For z = 5 To fin.w
If Mid(lg1$,z,1) <> "Q"
long.w =long.w + 1
Else
Break
EndIf
Next
dpvisi.b = 0:indvisi.w = 0
visi$ = Mid(lg1$,5,long)
If FindString(visi$,"9999",1) <> 0:dpvisi.b = 1: afvisi$ = "+ - 10 Km":EndIf
If FindString(visi$,"NSC",1) <> 0:dpvisi.b = 1: afvisi$ = "+ - 10 Km":EndIf
If FindString(visi$,"CAVOK",1) <> 0:dpvisi.b = 1: afvisi$ = "Supérieur a 10 Km":EndIf
If FindString(StringField(lg1$,indvent.w +1," "),"V",1)<> 0; pour tenir compte de l'option sur la variabilité du vent sur la piste
indvisi.w = indvent.w +2
Else
indvisi.w = indvent.w +1
EndIf
If dpvisi.b = 0
If Trim(Left(StringField(lg1$,indvisi.w," "),5)) = "////"
afvisi$ = "Non mesurable":altvisi.b = 1
Else
visi$ = Trim(Left(StringField(lg1$,indvisi.w," "),5)):afvisi$ = visi$ + " mètres"
EndIf
If Val(visi$) < 2000:altvisi.b = 1:EndIf;alerte visi
EndIf
obv$ = Mid(lg1$,5,long.w)
afobv$ = ""
If FindString(obv$,"BR",1) <> 0: afobv$ = " Brume":EndIf
If FindString(obv$,"FG",1) <> 0: afobv$ = " Brouillard":EndIf
If FindString(obv$,"HZ",1) <> 0: afobv$ = " Brume seiche":EndIf
If FindString(obv$,"SA",1) <> 0: afobv$ = " Sable":EndIf
ProcedureReturn afvisi$ + afobv$
EndProcedure
Procedure.s prev()
indprev = 0:prvTP$ ="":SetGadgetText(420,"")
lg1$ = tabligmetar.s(1)
If FindString(lg1$,"NOSIG",1) <> 0:prvTP$ =" Aucun changement prévus dans les deux heures a venir":EndIf
If FindString(lg1$,"TEMPO",1) <> 0:prvTP$ =" Changement des conditions sous quelques heures":EndIf
If FindString(lg1$,"INTER",1) <> 0:prvTP$ =" Instabilité":EndIf
If FindString(lg1$,"GRADU",1) <> 0:prvTP$ =" Changement progrèssif des conditions" :EndIf
If FindString(lg1$,"RAPID",1) <> 0:prvTP$ =" Changement rapide des conditions":EndIf
If prvTP$ =""
If GetGadgetText(411)= "En hausse": prvTP$ = " Amélioration probable":EndIf
If GetGadgetText(411)= "En baisse": prvTP$ = " Dégradation probable":EndIf
If GetGadgetText(411)= "Stable": prvTP$ = " Peu de changement prévisible":EndIf
EndIf
If GetGadgetText(412) = "Cumulus bourgeonnants"
ProcedureReturn "Vent ou averses possible." + prvTP$
EndIf
If GetGadgetText(412) = "Cumuloninbus (orages)"
ProcedureReturn "Vent fort ou orages possible." + prvTP$
EndIf
If indprev = 0
press = Val(Left(GetGadgetText(410),4))
Select press
Case 1026 To 1045
ProcedureReturn "Temps sec a très sec." + prvTP$
Case 1021 To 1025
ProcedureReturn "Beau temps ensoleillé." + prvTP$
Case 1015 To 1020
If afobv$ <> "" Or afpr$ <>"Aucune"
ProcedureReturn "Temps faiblement perturbé." + prvTP$
Else
ProcedureReturn "Généralement Beau temps." + prvTP$
EndIf
Case 1002 To 1014; voir ici avec les précipitations
If afobv$ <> "" Or afpr$ <>"Aucune"
ProcedureReturn "Temps perturbé." + prvTP$
Else
ProcedureReturn "Temps en principe agréable." + prvTP$
EndIf
Case 991 To 1001
ProcedureReturn "Temps variable pouvant devenir capricieux." + prvTP$
Case 980 To 990
ProcedureReturn "Mauvais temps, pluie vent, voir tempête." + prvTP$
EndSelect
EndIf
EndProcedure
Procedure razresult()
For x = 210 To 213
SetGadgetText(x,"")
Next
For x = 310 To 314
SetGadgetText(x,"")
Next
For x = 410 To 414
SetGadgetText(x,"")
Next
SetGadgetText(420,"")
EndProcedure
Procedure Traitemetar()
dpalt.b = 0:altv1.b = 0:altv2.b = 0:altp.b = 0:altprs.b = 0:altttt.b = 0 ;les alertes a zéro
If ArraySize(tabligmetar.s()) <> 0 ;si la station ne répond pas
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
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);ligne de code jusqu'a la lettre Q
nbspace.w = CountString(ph$," ");nombre d'espace dans la ligne de code
indtemp.w = nbspace.w
indpress.w = indtemp.w +1
indprev.w = indpress.w +1
Hdb$ = Mid(lg1$,10,2);minute de l'heure UTC
SetGadgetText(18,"Bulletin de "+ Mid(lg1$,8,2) + " h " + Hdb$ + " UTC")
;Direction du vent
If Left(ventdir(),3)= "Var"
SetGadgetText(210,"Variable"):SetGadgetText(211,"Non significatif")
Else
SetGadgetText(210,Left(ventdir(),3)+"°"):SetGadgetText(211,Mid(ventdir(),4,Len(ventdir())-3))
EndIf
;Vitesse du vent
If FindString(ventvit(),"¤")<> 0
SetGadgetText(204,"Avec rafales en cours"):SetGadgetText(212,StringField(ventvit(),1,"¤")):SetGadgetText(213,StringField(ventvit(),2,"¤"))
If Val(GetGadgetText(212))>= 40:altv1.b = 1:dpalt.b = 1:EndIf;alerte
If Val(GetGadgetText(213))>= 40:altv2.b = 1:dpalt.b = 1:EndIf;alerte
Else
SetGadgetText(204,"Vitesse maximum /12H"):SetGadgetText(212,StringField(ventvit(),1,"_")):SetGadgetText(213,StringField(ventvit(),2,"_"))
If Val(GetGadgetText(212))>= 40:altv1.b = 1:dpalt.b = 1:EndIf;alerte
EndIf
SetGadgetText(310,StringField(traittemp(indtemp.w),1,"_")+ " °C"):SetGadgetText(311,StringField(traittemp(indtemp.w),5,"_")+ " °C")
SetGadgetText(312,StringField(traittemp(indtemp.w),2,"_")+ " °C"):SetGadgetText(313,StringField(traittemp(indtemp.w),3,"_")+ " °C")
SetGadgetText(314,StringField(traittemp(indtemp.w),4,"_")+ " °C")
sigatp$ = Left(GetGadgetText(310),1)
If sigatp$ <> "-" ;si le signe température n'est pas négatif
atp = Val(Mid(GetGadgetText(310),3,2))
If atp <= 5 Or atp >= 25:altp.b = 1:dpalt.b = 1:EndIf
Else
altp.b = 1:dpalt.b = 1
EndIf
SetGadgetText(410,StringField(traitpress(indpress.w),1,"_")):SetGadgetText(411,StringField(traitpress(indpress.w),2,"_")) ;pression
press = Val(Left(GetGadgetText(410),Len(GetGadgetText(410))-4))
If press <990:altprs.b = 1:dpalt.b = 1:EndIf ;alerte pression
SetGadgetText(412,ciel());ciel
SetGadgetText(413,(precip()));précipitation
tp$ = GetGadgetText(413);alerte pécipitation
If FindString(tp$,"neige",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
If FindString(tp$,"Neige",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
If FindString(tp$,"Pluie d'orage",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
If FindString(tp$,"pluie d'orage",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
If FindString(tp$,"Grèle",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
If FindString(tp$,"grèle",1) <> 0:altttt.b = 1:dpalt = 1:EndIf
SetGadgetText(414,(visi()))
SetGadgetText(420,prev())
If altvisi.b = 1:dpalt = 1:EndIf ;alerte visi
If dpalt.b = 1;déclenche alerte
If indcx = 0:indcx = 1:EndIf
Else
indcx = 0
EndIf
SetGadgetText(20,"En attente"):coult(20,$507FFF,FontID5)
Else
SetGadgetText(20,"H S"):coult(20,$0045FF,FontID5):indcx = 1
ReDim tabligmetar.s(0)
ReDim tabaero.s(2,97)
razresult()
EndIf
indexapplig.b = 0; la ligne est libre
EndProcedure
Procedure GetWebMemAction(*GetWebMem.GetWebMem)
SetGadgetText(20,"En cours"):coult(20,$9AFA00,FontID5)
indcx = 0;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
SetGadgetText(20,"Pas de connexion"):coult(20,$0045FF,FontID5)
Delay(3500)
SetGadgetText(20,"En attente"):coult(20,$507FFF,FontID5)
indcx = 1
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
If indcx = 0:Traitemetar():EndIf;traite les metar
EndProcedure
Procedure GetWebMem(URL.s)
*GetWebMem.GetWebMem = AllocateMemory(SizeOf(GetWebMem))
InitializeStructure(*GetWebMem,GetWebMem)
*GetWebMem\URL.s = URL.s
CreateThread(@GetWebMemAction(),*GetWebMem)
EndProcedure
Procedure TimerProc2(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
If indcx = 1:apmet(aeronum):EndIf ; si la connexion n'a pas réussi on appel toute les minutes
Mhdb = Val(hdb$)
Select Minute(Date())
Case 0 To 10, 30 To 40
If Mhdb <30 And Minute(Date())>29:apmet(aeronum):EndIf
If Mhdb >29 And Minute(Date())<30:apmet(aeronum):EndIf
EndSelect
EndProcedure
Procedure TimerProc3(hwnd.l, uMsg.l, idEvent.l, dwTime.l)
If indcx = 1
If GetWindowLongPtr_(GadgetID(21), #GWL_STYLE) & #WS_VISIBLE ; Si le gadget 1 est visible
HideGadget(21, 1)
Else
HideGadget(21, 0)
EndIf
EndIf
If altv1.b = 1
If GetGadgetColor(212,#PB_Gadget_FrontColor) = $7FFF00
coult(212,$0045FF,FontID1)
Else
coult(212,$7FFF00,FontID1)
EndIf
Else
coult(212,$7FFF00,FontID1)
EndIf
If altv2.b = 1
If GetGadgetColor(213,#PB_Gadget_FrontColor) = $7FFF00
coult(213,$0045FF,FontID1)
Else
coult(213,$7FFF00,FontID1)
EndIf
Else
coult(213,$7FFF00,FontID1)
EndIf
If altp.b = 1
If GetGadgetColor(310,#PB_Gadget_FrontColor) = $7FFF00
coult(310,$0045FF,FontID1)
Else
coult(310,$7FFF00,FontID1)
EndIf
Else
coult(310,$7FFF00,FontID1)
EndIf
If altprs.b = 1
If GetGadgetColor(410,#PB_Gadget_FrontColor) = $7FFF00
coult(410,$0045FF,FontID1)
Else
coult(410,$7FFF00,FontID1)
EndIf
Else
coult(410,$7FFF00,FontID1)
EndIf
If altttt.b = 1
If GetGadgetColor(413,#PB_Gadget_FrontColor) = $7FFF00
coult(413,$0045FF,FontID1)
Else
coult(413,$7FFF00,FontID1)
EndIf
Else
coult(413,$7FFF00,FontID1)
EndIf
If altvisi.b = 1
If GetGadgetColor(414,#PB_Gadget_FrontColor) = $7FFF00
coult(414,$0045FF,FontID1)
Else
coult(414,$7FFF00,FontID1)
EndIf
Else
coult(414,$7FFF00,FontID1)
EndIf
EndProcedure
MLD_openfen(1,0,0,1920,1080,"",#PB_Window_BorderLess,#NUL,#NUL,#NUL,4)
SetWindowCallback(@Callback())
SetWindowColor(1,$A8941D)
StickyWindow(1,1)
HideWindow(1,1)
;Vos gadgets ici
MLD_TextGadget(2,20,30,850,70,"Métaero: La météo des aéroports",0,0,0,0)
coulf(2):coult(2,$8C3AEE,FontID7)
MLD_TextGadget(3,1810,970,150,70,"M L D",0,0,0,0)
coulf(3):coult(3,$0045FF,FontID1)
MLD_TextGadget(10,1370,0,314,40,"Liste des aéroports",#PB_Text_Center,0,0,0)
coulf(10):coult(10,$FFFFFF,FontID1)
MLD_ListViewGadget(11,1400,45,284,283,0,0,0,0)
aero()
For y = 1 To 96
AddGadgetItem(11,-1,tabaero.s(1,y))
Next
SetGadgetColor(11,#PB_Gadget_BackColor,$FF0000)
SetGadgetColor(11,#PB_Gadget_FrontColor,$FFFFFF):SetGadgetFont(11,FontID4)
N$ = " CHOIX"
For x = 1 To Len(N$)
L$ = L$ + Mid(N$,x,1) + Chr(10)
Next
MLD_TextGadget(12,1370,45,30,283,L$,1,0,0,0)
SetGadgetColor(12,#PB_Gadget_BackColor,$00FFFF)
SetGadgetColor(12,#PB_Gadget_FrontColor,$FF0000):SetGadgetFont(12,FontID4)
MLD_TextGadget(13,20,100,870,60,"",0,0,0,0)
coult(13,$FFFFFF,FontID5)
MLD_TextGadget(14,900,110,250,60,"",0,0,0,0)
coult(14,$7FFF00,FontID6)
MLD_TextGadget(15,20,160,1100,62,"",0,0,0,0)
coult(15,$FFFFFF,FontID5)
MLD_TextGadget(16,20,222,360,62,"Aéroport consulté:",0,0,0,0)
coult(16,$FFFFFF,FontID5)
MLD_TextGadget(17,380,222,450,62,"",0,0,0,0)
coult(17,$7FFF00,FontID5)
MLD_TextGadget(18,860,222,510,62,"",0,0,0,0)
coult(18,$7FFF00,FontID5)
MLD_TextGadget(19,20,282,470,62,"Etat de la transmission:",0,0,0,0)
coult(19,$FFFFFF,FontID5)
MLD_TextGadget(20,492,282,470,62,"En attente",0,0,0,0)
coult(20,$507FFF,FontID5)
MLD_TextGadget(21,980,282,300,62,"Alerte",0,0,0,0)
coult(21,$0045FF,FontID5):HideGadget(21, 1)
MLD_TextGadget(22,20,880,210,62,"Prévisions:",0,0,0,0)
coult(22,$FFFFFF,FontID5)
MLD_TextGadget(23,1300,335,230,40,"Aéroport de référence:",0,0,0,0)
coult(23,$FFFFFF,FontID2)
MLD_TextGadget(24,1535,335,230,40,"",0,0,0,0)
coult(24,$FFF500,FontID2)
For x = 13 To 24
coulf(x)
Next
MLD_BtTxt(101,1710,208,190,52,"Barre",FontID8,$FF0000,$A8758B,0)
MLD_BtTxt(102,1710,259,190,52,"Stop",FontID8,$FF0000,$008CFF,0)
MLD_BtTxt(103,1710,50,190,52,"E A D R",FontID8,$FF0000,$56B82D,0)
MLD_BtTxt(104,1710,103,190,52,"A D R",FontID8,$FF0000,$8968CD,0)
MLD_BtTxt(105,1710,156,190,52,"Aide",FontID8,$FF0000,$00ADCD,0)
MLD_TextGadget(200,0,390,633,62,"Informations sur les vents",#PB_Text_Center,0,0,0)
coult(200,$FFFFFF,FontID5)
MLD_TextGadget(201,20,480,150,42,"Direction:",0,0,0,0)
MLD_TextGadget(202,20,550,150,42,"Secteur:",0,0,0,0)
MLD_TextGadget(203,20,625,200,42,"Vitesse:",0,0,0,0)
MLD_TextGadget(204,20,700,330,42,"Vitesse maximum /12H",0,0,0,0)
MLD_TextGadget(210,180,480,250,42,"",0,0,0,0)
MLD_TextGadget(211,180,550,250,42,"",0,0,0,0)
MLD_TextGadget(212,180,625,250,42,"",0,0,0,0)
MLD_TextGadget(213,365,700,250,42,"",0,0,0,0)
MLD_TextGadget(300,635,390,633,62,"Informations sur la température",#PB_Text_Center,0,0,0)
coult(300,$FFFFFF,FontID5)
MLD_TextGadget(301,640,480,150,42,"Sous abris:",0,0,0,0)
MLD_TextGadget(302,640,550,150,42,"Ressentie:",0,0,0,0)
MLD_TextGadget(303,640,625,230,42,"Minimum /12H:",0,0,0,0)
MLD_TextGadget(304,640,700,240,42,"Maximum /12H:",0,0,0,0)
MLD_TextGadget(305,640,775,240,42,"Point de rosée:",0,0,0,0)
MLD_TextGadget(310,805,480,200,42,"",0,0,0,0)
MLD_TextGadget(311,805,550,200,42,"",0,0,0,0)
MLD_TextGadget(312,885,625,200,42,"",0,0,0,0)
MLD_TextGadget(313,885,700,200,42,"",0,0,0,0)
MLD_TextGadget(314,885,775,200,42,"",0,0,0,0)
MLD_TextGadget(400,1268,390,633,62,"Evémements atmosphérique",#PB_Text_Center,0,0,0)
coult(400,$FFFFFF,FontID5)
MLD_TextGadget(401,1273,480,200,42,"Pression:",0,0,0,0)
MLD_TextGadget(402,1273,550,200,42,"variation:",0,0,0,0)
MLD_TextGadget(403,1273,625,280,42,"Observation du ciel:",0,0,0,0)
MLD_TextGadget(404,1273,700,200,42,"Précipitation:",0,0,0,0)
MLD_TextGadget(405,1273,775,140,42,"visibilité:",0,0,0,0)
MLD_TextGadget(410,1415,480,200,42,"",0,0,0,0)
MLD_TextGadget(411,1415,550,200,42,"",0,0,0,0)
MLD_TextGadget(412,1565,625,350,42,"",0,0,0,0)
MLD_TextGadget(413,1480,700,430,42,"",0,0,0,0)
MLD_TextGadget(414,1415,775,480,42,"",0,0,0,0)
MLD_TextGadget(420,240,890,1600,42,"",0,0,0,0)
coulf(420):coult(420,$AED8EE,FontID1)
For x = 200 To 414
ct = $FFFFFF
Select x
Case 200 To 204,210 To 213
If x >= 210: ct = $7FFF00:EndIf
coulf(x):If x > 200:coult(x,ct,FontID1):EndIf
Case 300 To 305,310 To 314
If x >= 310: ct = $7FFF00:EndIf
coulf(x):If x > 300:coult(x,ct,FontID1):EndIf
Case 400 To 405,410 To 414
If x >= 410: ct = $7FFF00:EndIf
coulf(x):If x > 400:coult(x,ct,FontID1):EndIf
EndSelect
Next
HideWindow(1,0)
MLD_TextGadget(500,20,380,1880,2,"",0,0,0,0)
SetGadgetColor(500,#PB_Gadget_BackColor,$FA83FF)
MLD_TextGadget(501,20,870,1880,2,"",0,0,0,0)
SetGadgetColor(501,#PB_Gadget_BackColor,$FA83FF)
MLD_TextGadget(510,633,400,2,450,"",0,0,0,0)
SetGadgetColor(510,#PB_Gadget_BackColor,$FA83FF)
MLD_TextGadget(511,1266,400,2,450,"",0,0,0,0)
SetGadgetColor(511,#PB_Gadget_BackColor,$FA83FF)
calculnbjour()
aeroref()
SetTimer_ (WindowID (1) ,0,100, @TimerProc())
SetTimer_ (Handle1, 2, 60000, @TimerProc2())
SetTimer_ (Handle1, 3, 800, @TimerProc3())
Repeat
Select WindowEvent ()
Case #WM_LBUTTONDOWN
If svgn = 0
SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Else
bts(#WM_LBUTTONDOWN)
EndIf
Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP)
Case #PB_Event_Gadget
Select EventGadget()
Case 11;liste
Select EventType()
Case #PB_EventType_LeftClick
If indexapplig.b = 0
SetGadgetText(18,""):HideGadget(21, 1): Dim tabligmetar.s(0)
aeronum = GetGadgetState(11)+1:SetGadgetText(17,tabaero.s(1,aeronum)):apmet(aeronum)
EndIf
EndSelect
Case 101;barre de tache
ShowWindow_(WindowID(1),#SW_MINIMIZE)
Case 102;bt stop
If EventType ()= #PB_EventType_LeftClick
CloseWindow(1)
Break
EndIf
Case 103;bt EADR
CreateFile(600,"ADR")
WriteStringN(600,Str(aeronum))
CloseFile(600)
SetGadgetText(24,tabaero.s(1,aeronum))
Case 104 ;bt ADR
aeroref()
Case 105 ;aide
aide()
EndSelect
EndSelect
ForEver
End