Sub Metar()
'
' Makro utworzone 15.11.99 przez Krzysztof Plackowski
' Ostatnio poprawiane 19.1199
'
    ' stała zawierająca nr wersji
    Const wer = "1.01 - testowa"
    
' ********************************************************
    ' Kody lotnisk
    
    Const llot = 70 ' liczba wpisanych ICAO-wskich kodów lotnisk
    Dim klot()
    ReDim klot(0 To 1, 1 To llot)
    
    'tabelaICAO-wskich kodów lotnisk
    ' indeks 0 - kod
    ' indeks 1 - nazwa lotniska

    klot(0, 1) = "EPWA"
    klot(1, 1) = "Warszawa - Okęcie"
    
    klot(0, 2) = "EPPO"
    klot(1, 2) = "Poznań - Ławica"
    
    klot(0, 3) = "EPKO"
    klot(1, 3) = "Koszalin"
    
    klot(0, 4) = "EPSS"
    klot(1, 4) = "Słupsk (wojskowe)"
    
    klot(0, 5) = "EPGS"
    klot(1, 5) = "Gdańsk Rębiechowo"
    
    klot(0, 6) = "EPSK"
    klot(1, 6) = "Słupsk (cywilne)"
    
    klot(0, 7) = "EPSC"
    klot(1, 7) = "Szczecin - Goleniów"
    
    klot(0, 8) = "EPBS"
    klot(1, 8) = "Borne Sulinowo"
    
    klot(0, 9) = "EPBY"
    klot(1, 9) = "Bydgoszcz - Szwederowo (cywilne)"
    
    klot(0, 10) = "EPBK"
    klot(1, 10) = "Białystok - Krywlany"
    
    klot(0, 11) = "EPZG"
    klot(1, 11) = "Zielona Góra - Babimost"
    
    klot(0, 12) = "EPMO"
    klot(1, 12) = "Modlin"
    
    klot(0, 13) = "EPBC"
    klot(1, 13) = "Warszawa - Babice"
    
    klot(0, 14) = "EPWB"
    klot(1, 14) = "Warszawa - Okęcie (wojskowe)"
    
    klot(0, 15) = "EPMM"
    klot(1, 15) = "Mińsk Mazowiecki"
    
    klot(0, 16) = "EPWR"
    klot(1, 16) = "Wrocław - Strachowice (cywilne)"
    
    klot(0, 17) = "EPWL"
    klot(1, 17) = "Wrocław - Strachowice (wojskowe)"
    
    klot(0, 18) = "EPLL"
    klot(1, 18) = "Łódź - Lublinek"
    
    klot(0, 19) = "EPSW"
    klot(1, 19) = "Świdnik"
    
    klot(0, 20) = "EPJS"
    klot(1, 20) = "Jeżów Sudecki"
    
    klot(0, 21) = "EPJG"
    klot(1, 21) = "Jelenia Góra"
    
    klot(0, 22) = "EPKM"
    klot(1, 22) = "Katowice - Muchowiec"
    
    klot(0, 23) = "EPKT"
    klot(1, 23) = "Katowice - Pyrzowice"
    
    klot(0, 24) = "EPKF"
    klot(1, 24) = "Kraków - Balice (wojskowe)"
    
    klot(0, 25) = "EPKK"
    klot(1, 25) = "Kraków - Balice (cywilne)"
    
    klot(0, 26) = "EPKP"
    klot(1, 26) = "Kraków - Pobiednik Wlk."
    
    klot(0, 27) = "EPKA"
    klot(1, 27) = "Kielce - Masłów"
    
    klot(0, 28) = "EPPN"
    klot(1, 28) = "Pińczów"
    
    klot(0, 29) = "EPML"
    klot(1, 29) = "Mielec"
    
    klot(0, 30) = "EPRW"
    klot(1, 30) = "Rzeszów - Jasionka (wojskowe)"
    
    klot(0, 31) = "EPRZ"
    klot(1, 31) = "Rzeszów - Jasionka (cywilne)"
    
    klot(0, 32) = "EPBA"
    klot(1, 32) = "Bielsko Biała - Aleksandrowice"
    
    klot(0, 33) = "EPZR"
    klot(1, 33) = "Żar"
    
    klot(0, 34) = "EPNL"
    klot(1, 34) = "Nowy Sącz - Łososina Dolna"
    
    klot(0, 35) = "EPNT"
    klot(1, 35) = "Nowy Targ"
    
    klot(0, 36) = "EPKR"
    klot(1, 36) = "Krosno"
    
    klot(0, 37) = "EPCH"
    klot(1, 37) = "Częstochowa - Rudniki (wojskowe)"
    
    klot(0, 38) = "EPCW"
    klot(1, 38) = "Częstochowa - Rudniki (cywilne)"
    
    klot(0, 39) = "EPWS"
    klot(1, 39) = "Wrocław - Szymanów"
     
    klot(0, 40) = "EPKG"
    klot(1, 40) = "Kołobrzeg"
      
    klot(0, 41) = "EPOK"
    klot(1, 41) = "Oksywie - Babie Doły"
     
    klot(0, 42) = "EPSN"
    klot(1, 42) = "Świdwin"
     
    klot(0, 43) = "EPMI"
    klot(1, 43) = "Mierosławiec"
     
    klot(0, 44) = "EPBY"
    klot(1, 44) = "Bydgoszcz Szwederowo (cywilne)"
     
    klot(0, 45) = "EPGI"
    klot(1, 45) = "Grudziądz Lisie Kąty"
     
    klot(0, 46) = "EPOD"
    klot(1, 46) = "Olsztyn"
     
    klot(0, 47) = "EPSM"
    klot(1, 47) = "Szymany"
     
    klot(0, 48) = "EPPK"
    klot(1, 48) = "Poznań - Kobylnica"
     
    klot(0, 49) = "EPMM"
    klot(1, 49) = "Mińsk Mazowiecki"
     
    klot(0, 50) = "EPZP"
    klot(1, 50) = "Przylep - Zielona Góra"
     
    klot(0, 51) = "EPBO"
    klot(1, 51) = "Bolesławiec"
     
    klot(0, 52) = "EPLS"
    klot(1, 52) = "Leszno - Strzyżewice"
     
    klot(0, 53) = "EPLE"
    klot(1, 53) = "Legnica"
     
    klot(0, 54) = "EPOA"
    klot(1, 54) = "Oleśnica"
     
    klot(0, 55) = "EPPT"
    klot(1, 55) = "Piotrków Trybunalski"
     
    klot(0, 56) = "EPTM"
    klot(1, 56) = "Tomaszów Mazowiecki"
     
    klot(0, 57) = "EPRP"
    klot(1, 57) = "Radom - Pistów (wojskowe)"
     
    klot(0, 58) = "EPOP"
    klot(1, 58) = "Opole - Polska Nowa Wieś"
     
    klot(0, 59) = "EPGL"
    klot(1, 59) = "Gliwice - Trynek"
      
    klot(0, 60) = "EPIW"
    klot(1, 60) = "Iwonicz - Moderówka"
      
    klot(0, 61) = "EPZN"
    klot(1, 61) = "Żagań"
      
    klot(0, 62) = "EPKS"
    klot(1, 62) = "Poznań - Krzesiny"
      
    klot(0, 63) = "EPEL"
    klot(1, 63) = "Elbląg"
      
    klot(0, 64) = "EPPU"
    klot(1, 64) = "Puck"
      
    klot(0, 65) = "EPSR"
    klot(1, 65) = "Słupsk - Krępa"
      
    klot(0, 66) = "EPMB"
    klot(1, 66) = "Malbork (cywline)"
      
    klot(0, 67) = "EPKE"
    klot(1, 67) = "Kętrzyn"
      
    klot(0, 68) = "EPSU"
    klot(1, 68) = "Suwałki"
      
    klot(0, 69) = "EPSD"
    klot(1, 69) = "Szczecin Dąbie"
 
    
' **********************************************

    depesza = WordBasic.[Selection$]()
    
    If Len(depesza) < 5 Then
        ' jeśli nie zaznaczono depeszy uaktywnia się proceduta - słownik kodów lotnisk
        'wyn = szukaj_lot(llot, klot)
        wyn = 0
        If wyn = 0 Then
            MsgBox "Zaznacz treść depeszy", vbExclamation, "Dekodowanie depesz meteo"
            Exit Sub
        Else
            Exit Sub
        End If
    End If
    
    Documents.Add
    Selection.Font.Size = 14
    Selection.Font.Bold = wdToggle
    Selection.TypeText Text:="Raport z interpretacji depeszy meteorologicznej"
    Selection.TypeParagraph
    Selection.Font.Bold = wdToggle
    Selection.Font.Size = 12
    Selection.InsertDateTime DateTimeFormat:="dddd, d MMMM yyyy", _
    InsertAsField:=False
    Selection.TypeText Text:="               wersja " & wer
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Font.Bold = wdToggle
    Selection.TypeText Text:="Depesza:"
    Selection.Font.Bold = wdToggle
    Selection.TypeParagraph
    Selection.TypeText Text:=depesza
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Font.Bold = wdToggle
    Selection.TypeText Text:="Interpretacja:"
    Selection.TypeParagraph
    Selection.Font.Bold = wdToggle
    
    'Usunięcie ostatniego znaku =
    For i = 1 To Len(depesza)
        If Mid(depesza, i, 1) = "=" Then Exit For
    Next
    
    depesza = Left(depesza, i - 1)
    
    'Zliczanie spacji w depeszy
    lspac = 0
    For i = 1 To Len(depesza)
        If Mid(depesza, i, 1) = " " Then lspac = lspac + 1
    Next
    
    'Liczba bloków depeszy
    
    lblok = lspac + 1
    
    'If lblok > 50 Then
    '    MsgBox "Depesza za długa. Więcej niż 50 bloków.", vbExclamation, "Dekodowanie depesz meteo"
    '    Exit Sub
    'End If
    
    'Deklaracja tablicy wyników:
    ' 0 kolumna - wartość parametru
    ' 1 kolumna - zdekodowany opis parametru (jeśli puste blok nierozpoznany)
    
    Dim meteo() As String
    ReDim meteo(1, 1 To lblok) As String
    
    nrbloku = 1
    pomoc = ""
    depesza = depesza + " " ' konieczne dla wczytania ostatniego bloku
    For i = 1 To Len(depesza)
        znak = Mid(depesza, i, 1)
        If znak = " " Then
            meteo(0, nrbloku) = Trim(pomoc)
            pomoc = ""
            nrbloku = nrbloku + 1
        Else
            pomoc = pomoc + znak
        End If
    Next
    
    '************* Rozpoznawanie kolejnych bloków *************
              
    ' typ depeszy
    TAF = "0"
    For i = 1 To lblok
        If meteo(1, i) = "" Then ' aby nie rozpoznawać bloku już rozpoznanego
            meteo(1, i) = typ(meteo(0, i))
            If Right(meteo(1, i), 8) = "prognoza" Then TAF = "1"
        End If
    Next
      
    'lotnisko
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = lotnisko(meteo(0, i), llot, klot)
            ' llot - liczba zapisanych lotnisk
            ' tabela z kodami lotnisk
        End If
    Next

   'ciśnienie
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = Qnh(meteo(0, i))
        End If
    Next

   'grupa czasowa
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = czas(meteo(0, i))
            If meteo(1, i) <> "" Then GoTo dalej
        End If
    Next
dalej:

   'wiatr
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = wiatr(meteo(0, i))
        End If
    Next

   'istotna zmiana kierunku wiartu
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = z_wiatr(meteo(0, i))
        End If
    Next

   'temperatura
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = temp(meteo(0, i))
        End If
    Next

    'CAVOK
    CAVOK = "0"
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            If meteo(0, i) = "CAVOK" Then
                meteo(1, i) = ""
                CAVOK = "1"
            End If
        End If
    Next
    
    'widzialność po raz pierwszy
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = widzial(meteo(0, i))
            If meteo(1, i) <> "" Then GoTo dalej2
        End If
    Next
dalej2:

    'pogoda bieżąca
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = pog(meteo(0, i))
        End If
    Next

    'chmury
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = chmury(meteo(0, i))
        End If
    Next

    'prognoza
    progn = "0"
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = prog(meteo(0, i))
            If meteo(1, i) <> "" Then progn = "1"
        End If
    Next
    
    'grupa czasowa dla prognozy
    If progn = "1" Or TAF = "1" Then
        For i = 1 To lblok
            If meteo(1, i) = "" Then
                meteo(1, i) = czas_p(meteo(0, i))
                If meteo(1, i) <> "" Then GoTo dalej_p
            End If
        Next
dalej_p:
    End If
    
    'widzialność po raz drugi (dla prognozy)
    If progn = "1" Or TAF = "1" Then
        For i = 1 To lblok
            If meteo(1, i) = "" Then
                meteo(1, i) = widzial(meteo(0, i))
            End If
        Next
    End If

    'NOSIG
    NOSIG = "0"
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            If meteo(0, i) = "NOSIG" Then
                meteo(1, i) = ""
                NOSIG = "1"
            End If
        End If
    Next
        
    'prawdopodobieństwo
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = prawd(meteo(0, i))
        End If
    Next
    
    'prognoza temperatury
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            meteo(1, i) = temp_p(meteo(0, i))
        End If
    Next


    ' ******************************************
    ' Wydruk wyników
    prg = "0"  ' flaga, czy zaczęła się już prognoza
    For i = 1 To lblok
        If meteo(1, i) <> "" Then
            If Left(meteo(1, i), 5) = "Wiatr" And CAVOK = "1" Then
                Selection.TypeText Text:=meteo(1, i)
                Selection.TypeParagraph
                Selection.TypeText Text:="CAVOK:" & vbTab & vbTab & "widzialność 10 km i więcej"
                Selection.TypeParagraph
                Selection.TypeText Text:=vbTab & vbTab & vbTab & "brak chmur poniżej 1 500 m i brak Cumulonimbusa"
                Selection.TypeParagraph
                Selection.TypeText Text:=vbTab & vbTab & vbTab & "brak opadów, burz, itp."
                Selection.TypeParagraph
            Else
                If prg = "1" Then Selection.TypeText Text:=vbTab
                Selection.TypeText Text:=meteo(1, i)
                Selection.TypeParagraph
                If Left(meteo(1, i), 7) = "Nastąpi" Then prg = "1"
            End If
        End If
    Next
    If NOSIG = "1" Then
        Selection.TypeText Text:="Nie przewiduje się w najbliższym czasie zmian pogody."
        Selection.TypeParagraph
    End If
    
    Selection.Font.Bold = wdToggle
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Nierozpoznane bloki:"
    Selection.Font.Bold = wdToggle
    Selection.TypeParagraph
    For i = 1 To lblok
        If meteo(1, i) = "" Then
            If Not (meteo(0, i) = "CAVOK" Or meteo(0, i) = "NOSIG") Then
                Selection.TypeText Text:=meteo(0, i)
                Selection.TypeParagraph
            End If
        End If
    Next

    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="-------------------------------------------------"
    Selection.TypeParagraph
    Selection.Font.Size = 10
    Selection.Font.Italic = wdToggle
    Selection.TypeText Text:= _
        "Uwaga! Zawarte tu informacje nie mogą służyć do przygotowywania planów lotu ani innych ważnych celów."
    Selection.TypeParagraph
    Selection.TypeText Text:="Autor nie ponosi odpowiedzialności za skutki użycia niniejszego programu."
    Selection.HomeKey Unit:=wdStory
End Sub


' ***********************************************************
' Funkcje - zwracają zdekodowaną wartość bloku depeszy
' Jeśli nie uda sie rozpoznać danego bloku funkcja zwraca wartość pustą


Private Function typ(x) As String

typ = ""
If x = "METAR" Then typ = "Depesza:" & vbTab & vbTab & "METAR"
If x = "SPECI" Then typ = "Depesza:" & vbTab & vbTab & "SPECI"
If x = "TAF" Then typ = "Depesza:" & vbTab & vbTab & "TAF - prognoza"

End Function

Private Function lotnisko(x, y, tabel) As String

lotnisko = ""
If Len(x) <> 4 Then Exit Function

For i = 1 To y
    If x = tabel(0, i) Then
        lotnisko = "Lotnisko:" & vbTab & vbTab & tabel(1, i)
        Exit Function
    End If
Next
   
End Function

Private Function Qnh(x) As String

Qnh = ""
If Len(x) = 5 And Left(x, 1) = "Q" Then
    Qnh = "Ciśnienie Qnh:" & vbTab & vbTab & Trim(Str(Val(Right(x, 4)))) & " hPa"
End If

End Function

Private Function czas(x) As String

czas = ""
utc = "0" ' uskaźnik czasu UTC
If Right(x, 1) = "Z" Then
    utc = "1"
    pom = Left(x, Len(x) - 1)
    If czy_liczba(pom) = 0 Then Exit Function
Else
    pom = x
    If czy_liczba(pom) = 0 Then Exit Function
End If

If Len(pom) = 4 Then
   If Left(pom, 2) <= 23 And Right(pom, 2) <= 59 Then
        czas = "Czas depeszy:" & vbTab & vbTab & "godzina " & Left(pom, 2) & " min. " & Right(pom, 2)
   End If
   If utc = 1 Then czas = czas & " UTC"
End If

If Len(pom) = 6 Then
    If Left(pom, 2) <= 31 And Mid(pom, 3, 2) <= 23 And Right(pom, 2) <= 59 Then
        czas = "Czas depeszy:" & vbTab & vbTab & "dzień " & Left(pom, 2) & " bieżącego miesiąca godz. " & Mid(pom, 3, 2) & " min. " & Right(pom, 2)
   End If
   If utc = 1 Then czas = czas & " UTC"
End If


End Function

Private Function wiatr(x) As String

wiatr = ""
grw = "0" ' pomocnicza

'szukamy MPS lub KT lub KMH
For i = 1 To Len(x) - 2
    pom = Mid(x, i, 3)
    If pom = "MPS" Then
        grw = "1"
        pom = "m/s"
    End If
Next

If grw = "0" Then
    For i = 1 To Len(x) - 2
        pom = Mid(x, i, 3)
        If pom = "KMH" Then
            grw = "1"
            pom = "km/h"
        End If
    Next
End If

If grw = "0" Then
    For i = 1 To Len(x) - 1
        pom = Mid(x, i, 2)
        If pom = "KT" Then
            grw = "1"
            pom = "kt"
        End If
    Next
End If

If grw = "1" Then ' to jest grupa wiatru
    wiatr = "Wiatr:" & vbTab & vbTab & vbTab
    If Left(x, 3) = "VRB" Then
        wiatr = wiatr & "z kierunków zmiennych"
    Else
        wiatr = wiatr & "z kierunku " & Left(x, 3)
    End If
    wiatr = wiatr & " o sile " & Str(Val(Mid(x, 4, 2))) & " " & pom
    If Len(x) - Len(pom) > 5 Then
        If Mid(x, 6, 1) = "G" Then
            wiatr = wiatr & ", możliwe porywy do " & Str(Val(Mid(x, 7, 2))) & " " & pom
        End If
    End If
End If

End Function

Private Function widzial(x) As String

widzial = ""

If Len(x) = 4 And czy_liczba(x) = "1" Then
    If x = "9999" Then
        widzial = "Widzialność:" & vbTab & vbTab & "ponad 10 km"
    Else
        widzial = "Widzialność:" & vbTab & vbTab & Trim(Str(Val(x))) & " m"
    End If
    Exit Function
End If

'minimalna widzialność w kierunku
If Len(x) = 5 Then
    If Right(x, 1) = "N" Or Right(x, 1) = "S" Or Right(x, 1) = "E" Or Right(x, 1) = "W" Then
        widzial = "Widzialność:" & vbTab & vbTab & "min. " & Str(Val(Left(x, 4))) & " m w kierunku " & Right(x, 1)
    End If
End If

If Len(x) = 6 Then
    If Right(x, 2) = "NE" Or Right(x, 2) = "NW" Or Right(x, 2) = "SE" Or Right(x, 2) = "SW" Then
        widzial = "Widzialność:" & vbTab & vbTab & "min. " & Str(Val(Left(x, 4))) & " m w kierunku " & Right(x, 2)
    End If
End If

End Function

Private Function pog(x) As String

pog = ""
nap = "Zjawiska atmosfer.:" & vbTab

If x = "NSW" Then
    pog = nap & "brak istotnych zjawisk"
    Exit Function
End If

pom = x

licz = 0

Do
licz = licz + 1 ' licznik pozwalający wyjść z nieskończonej pętli

If Left(pom, 1) = "+" Then
    opi = "silne - "
    pom = Right(pom, Len(pom) - 1)
End If
    
If Left(pom, 1) = "-" Then
    opi = "słabe - "
    pom = Right(pom, Len(pom) - 1)
End If

If Left(pom, 2) = "VC" Then
    opi = "w pobliżu - "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "MI" Then
    opi = opi & "niskie - "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "SH" Then
    opi = opi & "opad przelotny - "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "FZ" Then
    opi = opi & "opad marznący - "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "TS" Then
    opi = opi & "burza  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "GR" Then
    opi = opi & "grad  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "DZ" Then
    opi = opi & "mżawka "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "RA" Then
    opi = opi & "deszcz  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "SN" Then
    opi = opi & "śnieg  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "BR" Then
    opi = opi & "zamglenie  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "FG" Then
    opi = opi & "mgła  "
    pom = Right(pom, Len(pom) - 2)
End If

If Left(pom, 2) = "HZ" Then
    opi = opi & "zmętnienie  "
    pom = Right(pom, Len(pom) - 2)
End If

Loop Until pom = "" Or licz > 50 ' pętli Do

If opi <> "" Then pog = nap & opi

End Function

Private Function chmury(x) As String

chmury = ""
If Len(x) >= 3 Then
    If x = "SKC" Then chmury = "Zachmurzenie:" & vbTab & vbTab & " - brak -"
    If x = "NSC" Then chmury = "Zachmurzenie:" & vbTab & vbTab & "brak istotnych chmur"
    If Left(x, 3) = "FEW" Then chmury = "Zachmurzenie:" & vbTab & vbTab & "od 1/8 do 2/8"
    If Left(x, 3) = "SCT" Then chmury = "Zachmurzenie:" & vbTab & vbTab & "od 3/8 do 4/8"
    If Left(x, 3) = "BKN" Then chmury = "Zachmurzenie:" & vbTab & vbTab & "od 5/8 do 7/8"
    If Left(x, 3) = "OVC" Then chmury = "Zachmurzenie:" & vbTab & vbTab & "8/8"
    
    If chmury <> "" Then
        podst = Mid(x, 4, 3)
        If czy_liczba(podst) = "1" Then chmury = chmury & ", podstawa " & Str(30 * Val(podst)) & " m"
    End If
    
    If Right(x, 2) = "CB" Then chmury = chmury & ", uwaga: Cumulonimbus"
    If Right(x, 3) = "TCU" Then chmury = chmury & ", uwaga: Cumulus congestus"
End If
End Function

Private Function temp(x) As String

temp = ""
CR = Chr(10)
If Len(x) = 5 Or Len(x) = 6 Or Len(x) = 7 Then
    poz = 0
    For i = 1 To Len(x)
        If Mid(x, i, 1) = "/" Then poz = i
    Next
    If poz > 0 Then
        T = Left(x, poz - 1)
        Tr = Right(x, Len(x) - poz)
        
        If Left(T, 1) = "M" Then
            zn1 = "-"
            T = Right(T, 2)
        Else
            zn1 = ""
        End If
        
        If Left(Tr, 1) = "M" Then
            zn2 = "-"
            Tr = Right(Tr, 2)
        Else
            zn2 = ""
        End If
        
        If czy_liczba(T) = "1" And czy_liczba(Tr) = "1" Then
            temp = "Temperatura:" & vbTab & vbTab & "powietrza: " & zn1 & Str(Val(T)) & " st. C," & CR & vbTab & vbTab & vbTab & "punktu rosy: " & zn2 & Str(Val(Tr)) & " st. C"
        End If
    End If
End If

End Function

Private Function prog(x) As String

prog = ""
If x = "TEMPO" Then prog = "Nastąpi zmiana pogody trwająca krócej niż 1 godzinę:"
If x = "GRADU" Then prog = "Nastąpią stopniowe zmiany pogody:"
If x = "RAPID" Then prog = "Nastąpi zmiana pogody trwająca krócej niż pół godziny:"
If x = "INTER" Then prog = "Nastąpią częste zmiany pogody:"
If x = "BECMG" Then prog = "Nastąpi zmiana pogody:"
' If x = "NOSIG" Then prog = "Nastąpi zmiana pogody trwająca krócej niż 1 godzinę."
End Function

Private Function prawd(x) As String

prawd = ""
If Left(x, 4) = "PROB" And Len(x) = 6 Then
    If czy_liczba(Right(x, 2)) = "1" Then
        prawd = "Prawdopodobieństwo wystąpienia zmiany pogody wynosi " & Str(Val(Right(x, 2))) & " %"
    End If
End If
End Function

Private Function czas_p(x) As String

czas_p = ""
If Len(x) = 4 Or Len(x) = 5 Then
    If Right(x, 1) = "Z" Then
        jedn = " UTC"
        x = Left(x, Len(x) - 1)
    Else
        jedn = ""
    End If
    If (Left(x, 2) = "FM" Or Left(x, 2) = "TL" Or Left(x, 2) = "AT") And czy_liczba(Mid(x, 3, 2)) = "1" And Val(Mid(x, 3, 2)) <= 23 Then
        czas_p = "Ważność prognozy:" & vbTab
        Select Case Left(x, 2)
            Case "FM"
                czas_p = czas_p & "od godz. " & Trim(Str(Val(Right(x, 2)))) & jedn
            Case "TL"
                czas_p = czas_p & "do godz. " & Trim(Str(Val(Right(x, 2)))) & jedn
            Case "AT"
                czas_p = czas_p & "o godz. " & Trim(Str(Val(Right(x, 2)))) & jedn
        End Select
    Else
        If czy_liczba(x) = "1" Then
            
            If Val(Left(x, 2)) <= 23 And Val(Right(x, 2)) <= 23 Then
                czas_p = "Ważność prognozy:" & vbTab & "od godz. " & Trim(Str(Val(Left(x, 2)))) & " do godz. " & Trim(Str(Val(Right(x, 2)))) & jedn
            End If
        End If
    End If
End If
End Function

Private Function temp_p(x) As String

temp_p = ""
If (Len(x) = 6 Or Len(x) = 7 Or Len(x) = 8) And Left(x, 1) = "T" Then
    pom = Right(x, Len(x) - 1)
    If Left(pom, 1) = "M" Then
        znak = "-"
        pom = Right(pom, Len(pom) - 1)
    Else
        znak = ""
    End If
    If Mid(pom, 3, 1) = "/" Then
        If czy_liczba(Left(pom, 2)) = "1" Then
            If Right(pom, 1) = "Z" Then jedn = " UTC" Else jedn = ""
            temp_p = "Temperatura:" & vbTab & vbTab & znak & Trim(Str(Val(Left(pom, 2)))) & " st. C, o godz. " & Trim(Str(Val(Mid(pom, 4, 2)))) & jedn
        End If
    End If
End If
End Function

Private Function z_wiatr(x) As String

z_wiatr = ""
If Len(x) = 7 And Mid(x, 4, 1) = "V" Then z_wiatr = "Zmiana kier. wiatru:" & vbTab & "od " & Left(x, 3) & " do " & Right(x, 3)
End Function

' *********************************************************
' Funkcje pomocnicze


Private Function czy_liczba(x)
' funkcja zwraca 1 jeśli argument (string) przedstawia liczbę, 0 w przeciwnym wypadku

'dodawanie usuniętych zer
pom = Trim(Str(Val(x)))
ile_zer = Len(x) - Len(pom)
If ile_zer <> 0 Then
    For i = 1 To ile_zer
        pom = "0" & pom
    Next
End If

'testowanie
If pom = x Then czy_liczba = "1" Else czy_liczba = "0"

End Function

Sub Auto_Open() ' uruchamiane przy otwarciu nowego dokumentu
'
'' Makro zapisane 17.11.99 przez Krzysztof Plackowski
'
    CommandBars("Pogoda").Visible = True
    MsgBox "Rozkodowywanie depesz meteo", vbInformation
    
End Sub


Function szukaj_lot(il, tabl)

szukaj_lot = 0 ' wynik poszukiwań

start:
WordBasic.BeginDialog 814, 232, "Kody lotnisk wg ICAO"
    WordBasic.Text 7, 97, 97, 13, "Kod lotniska:"
    WordBasic.TextBox 187, 97, 80, 18, "kod_l$"
    WordBasic.TextBox 187, 119, 285, 18, "nazwa_l$"
    WordBasic.Text 9, 120, 127, 13, "Nazwa lotniska:"
    WordBasic.OKButton 213, 187, 100, 26
    WordBasic.CancelButton 449, 185, 100, 26
WordBasic.EndDialog

Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog

If WordBasic.Dialog.UserDialog(dlg) = 0 Then
    szukaj_lot = 0
    GoTo koniec
End If

If dlg.kod_l$ = "" And dlg.nazwa_l$ = "" Then
    szukaj_lot = 0
    GoTo koniec
End If

If dlg.kod_l$ = "" And dlg.nazwa_l$ <> "" Then
'nie ma kodu
    For i = 1 To il
        If dlg.nazwa_l$ = tabl(1, i) Then
            MsgBox "Kod: " & tabl(0, i) & Chr(10) & "Lotnisko: " & tabl(1, i), vbInformation, "Kody lotnisk"
            szukaj_lot = 1
            Exit Function
        End If
    Next
End If

If dlg.nazwa_l$ = "" And dlg.kod_l$ <> "" Then
'nie ma nazwy
    For i = 1 To il
        If dlg.kod_l$ = tabl(0, i) Then
            MsgBox "Kod: " & tabl(0, i) & Chr(10) & "Lotnisko: " & tabl(1, i), vbInformation, "Kody lotnisk"
            szukaj_lot = 1
            Exit Function
        End If
    Next
End If

MsgBox "Zostaw jedno pole puste", vbExclamation, "Czego mam szukać?"
GoTo start

koniec:
End Function