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
