Public Typy
Public Zmena As Boolean
Public Novy As Boolean
Public Cesta
Public Cesta_Jmeno

Private Sub F_S_Click()
    Setrid
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()
Load Najit
Load Nastav
Load Kodovani
'načtení nastavení
Dim txt
RB.LoadFile App.Path + "\SetData.dat", rtfText
txt = RB.Text: RB.Text = ""
'CheckBoxy
    For i = 1 To 6
        If Mid(txt, i, 1) = "1" Then Nastav.h(i - 1).Value = 1
    Next
'Option
    Nastav.OP(Val(Mid(txt, 7, 1))).Value = True
'Combo
    Nastav.stav.ListIndex = Val(Mid(txt, 8, 1))
txt = Right(txt, Len(txt) - 11)
'Ostatní nastavení
    Dim J
    J = 0
ST:
For i = 1 To Len(txt) - 3
    If Mid(txt, i, 3) = "/#\" Then
        tt = Left(txt, i - 1)
        txt = Right(txt, Len(txt) - i - 2)
            Select Case J
                Case 0: Nastav.zk.FontName = tt
                Case 1: Nastav.zk.FontSize = Val(tt)
                Case 2: Nastav.p(0).Text = Val(tt)
                Case 3: Nastav.p(1).Text = Val(tt)
                Case 4: Nastav.p(2).Text = Val(tt)
                Case 5: Nastav.p(3).Text = Val(tt)
                Case 6: GoTo Pres
            End Select
        J = J + 1
        GoTo ST
    End If
Next
Pres:
txt = Left(txt, Len(txt) - 2)
TYPYS = tt + "/#\" + txt
Nastav.TypySouboru TYPYS

Zmena = False
Novy = True
Cesta = ""
Cesta_Jmeno = "Bez názvu"
DejTitulek
If Command <> "" Then
    Cm = Command
    If Left(Cm, 1) = Chr(34) Then Cm = Mid(Command, 2, Len(Cm) - 2)
    Me.Tag = Cm
    Otevri
    Me.Tag = ""
End If
End Sub

Public Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
    On Error GoTo p
RB.Width = Me.Width - 100
RB.Height = Me.Height - 780
RB2.Width = Me.Width - 100
RB2.Height = Me.Height - 780
pr.Top = Hl.Height - pr.Height - 770
pr.Width = Hl.Width - 70
If pr.Visible = True Then RB.Height = RB.Height - pr.Height + 10: RB2.Height = RB2.Height - pr.Height + 10
p:
    End Sub

Private Sub Form_Unload(Cancel As Integer)
Zmeneno
If Funkce.Stor = True Then Funkce.Stor = False: Cancel = 1
If Cancel <> 1 Then Me.Tag = "L": Nastav.Nacti: Nastav.Uloz_Click: End
End Sub

Private Sub M_F_Click()
If RB.SelText = "" Then M_F_P.Enabled = False Else M_F_P.Enabled = True
If RB.SelText = "" Then M_F_D.Enabled = False Else M_F_D.Enabled = True
If Len(RB.Text) < 2 Then M_F_O_T.Enabled = False Else M_F_O_T.Enabled = True
If Len(RB.Text) < 1 Then M_F_K.Enabled = False Else M_F_K.Enabled = True

F_S.Enabled = False
Dim i As Double
i = InStr(1, RB.Text, Chr(13) + Chr(10), vbTextCompare)
If i <> 0 Then F_S.Enabled = True
    'i = InStr(i + 1, RB.Text, Chr(13) + Chr(10), vbTextCompare)
    'If i <> 0 Then F_S.Enabled = True
'End If
End Sub

Private Sub M_F_D_Click()
    DelkaTextu
End Sub

Private Sub M_F_K_D_Click()
    Kodovani.Label1.Caption = "Zadejte heslo pro dekódování:"
    Kodovani.typ = 1
    Kodovani.Show , Hl
End Sub

Private Sub M_F_K_Z_Click()
    Kodovani.Label1.Caption = "Zadejte heslo pro zakódování:"
    Kodovani.typ = 0
    Kodovani.Show , Hl
End Sub

Private Sub M_F_O_T_Click()
    Odzadu
End Sub

Private Sub m_f_opz_Click()
    Dim s As String: s = RB.Text
    Dim i As Integer: i = 1
    Dim o As Integer
    
    Dim znaky As String
    znaky = "abcdefghijklmnopqrstuvwxyz" & _
            "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
            "ÁÉĚÍÝÓÚŮĎŤŇŠČŘŽ" & _
            "áéěíýóúůďťňščřž" & _
            "0123456789" & _
            ".:,;&|=%@#'-!_?<>()[]{}/\^$+* " + Chr(34) + vbCrLf
        
    Dim z As Boolean
    
    While i <= Len(s)
        z = False
        For o = 1 To Len(znaky)
            If Mid(znaky, o, 1) = Mid(s, i, 1) Then z = True: Exit For
        Next
        If Not z Then
            'odebrání znaku
            s = Left(s, i - 1) & Mid(s, i + 1)
        Else
            i = i + 1
        End If
    Wend
    
    RB.Text = s
End Sub

Private Sub M_F_P_M_Click()
    RB.SelText = LCase(RB.SelText)
End Sub

Private Sub M_F_P_V_Click()
    RB.SelText = UCase(RB.SelText)
End Sub

Private Sub M_F_U_N_Click()
    UTF (0)
End Sub

Private Sub M_F_U_Z_Click()
    UTF (1)
End Sub

Private Sub UTF(X As Byte)
    Dim Te As String, s As String
    Dim s2 As String, z As String
    Dim s3(1 To 28) As String, a  As Boolean
     s3(1) = "&#x11B;"
     s3(2) = "&#x161;"
     s3(3) = "&#x10D;"
     s3(4) = "&#x159;"
     s3(5) = "&#x17E;"
     s3(6) = "&#xFD;"
     s3(7) = "&#xE1;"
     s3(8) = "&#xED;"
     s3(9) = "&#xE9;"
     s3(10) = "&#xFA;"
     s3(11) = "&#x16F;"
     s3(12) = "&#x10F;"
     s3(13) = "&#x165;"
     s3(14) = "&#x148;"
     s3(15) = "&#x11A;"
     s3(16) = "&#x160;"
     s3(17) = "&#x10C;"
     s3(18) = "&#x158;"
     s3(19) = "&#x17D;"
     s3(20) = "&#xDD;"
     s3(21) = "&#xC1;"
     s3(22) = "&#xCD;"
     s3(23) = "&#xC9;"
     s3(24) = "&#xDA;"
     s3(25) = "&#x16E;"
     s3(26) = "&#x10E;"
     s3(27) = "&#x164;"
     s3(28) = "&#x147;"
    Te = ""
    s2 = "ěščřžýáíéúůďťňĚŠČŘŽÝÁÍÉÚŮĎŤŇĚ"
    If Hl.RB.Visible = True Then s = Hl.RB.Text Else s = Hl.RB2.Text
    Dim i As Double, o As Integer
    For i = 1 To Len(s)
        If X = 0 Then
            z = Mid(s, i, 1)
            For o = 1 To Len(s2)
                If z = Mid(s2, o, 1) Then
                    z = s3(o)
                    Exit For
                End If
            Next
            Te = Te & z
        End If
        If X = 1 Then
            For o = 1 To 28
                a = False
                z = Mid(s, i, Len(s3(o)))
                If z = s3(o) Then
                    z = Mid(s2, o, 1)
                    a = True
                    i = i + Len(s3(o)) - 1
                    Exit For
                End If
            Next
            If a = False Then z = Mid(s, i, 1)
            Te = Te & z
        End If
    Next
    If Hl.RB.Visible = True Then Hl.RB.Text = Te Else Hl.RB2.Text = Te
    
    Najit.Naj.Text = " "
    Najit.NajZa.Text = " "
    Najit.NahVse_Click
End Sub

Private Sub M_FO_M_Click()
    Pismo
End Sub

Private Sub M_FO_Z_Click()
    Zalamovani
End Sub

Private Sub M_NA_O_Click()
    OProg.Show
    OProg.Move Hl.Left + Hl.Width - OProg.Width - 400, Hl.Top + 820
    OProg.Hide: OProg.Show 1
End Sub

Private Sub M_NA_Z_Click()
    Nastav.Nacti: Nastav.Show
End Sub

Private Sub M_O_P_Click()
    Dim Te As String, s As String
    If Hl.RB.Visible = True Then s = Hl.RB.Text Else s = Hl.RB2.Text
    s = s & " "
    Dim Ost As String: Ost = "ÁÉÍÓÚŮĚŠČŘŽĎŤŇ"
    Dim z As String * 1, i As Double, o As Integer
    Dim Od As Double: Od = 1
    Dim s0 As String
    Dim Slovo As Boolean: Slovo = False
    For i = 1 To Len(s)
        z = UCase(Mid(s, i, 1))
        If Asc(z) < 65 Or Asc(z) > 90 Then
            For o = 1 To Len(Ost)
                If z = Mid(Ost, o, 1) Then GoTo Pres
            Next
        Else
            GoTo Pres
        End If
        'Kontrola konce slova, případné prohození písmen
        If Slovo = True Then
            Slovo = False
            s0 = Mid(s, Od, i - Od)
            If Len(s0) > 3 Then
                s0 = Vymen(s0)
                s = Left(s, Od - 1) & s0 & Mid(s, i)
            End If
        End If
        GoTo Pres2
Pres:
        'Znak slova
        If Slovo = False Then
            Slovo = True
            Od = i
        End If
Pres2:
    Next
    s = Left(s, Len(s) - 1)
    If Hl.RB.Visible = True Then Hl.RB.Text = s Else Hl.RB2.Text = s
End Sub

Private Function Vymen(T As String) As String
    ReDim Sl(1 To Len(T))
    Dim k As Integer, l As Integer, s1 As String
    Dim Roz As Integer: Roz = Len(T) - 3
    Sl(1) = Left(T, 1): Sl(Len(T)) = Right(T, 1)
    For k = 2 To Len(T) - 1
        Sl(k) = "~"
    Next
    For k = 2 To Len(T) - 1
        Do
            'Do
                l = CInt(Rnd * Roz) + 2
            'Loop Until l = k
        Loop Until Sl(l) = "~"
        Sl(l) = Mid(T, k, 1)
    Next
    s1 = ""
    For k = 1 To Len(T)
        s1 = s1 & Sl(k)
    Next
    Vymen = s1
End Function

Private Sub M_RB_Click()
    If Clipboard.GetText = "" Then M_U_VL.Enabled = False Else M_U_VL.Enabled = True
    If RB.SelText = "" Then M_RB_K.Enabled = False Else M_RB_K.Enabled = True
    If RB.SelText = "" Then M_RB_V.Enabled = False Else M_RB_V.Enabled = True
    If RB.SelText = "" Then M_RB_O.Enabled = False Else M_RB_O.Enabled = True
    M_RB_Z.Enabled = M_U_Z.Enabled
End Sub

Private Sub M_RB_K_Click()
    M_U_K_Click
End Sub

Private Sub M_RB_O_Click()
    M_U_O_Click
End Sub

Private Sub M_RB_V_Click()
    M_U_V_Click
End Sub

Private Sub M_RB_VL_Click()
    M_U_VL_Click
End Sub

Private Sub M_RB_VV_Click()
    M_U_VV_Click
End Sub

Private Sub M_RB_Z_Click()
    'M_U_Z_Click
End Sub

Private Sub M_S_K_Click()
    Unload Me
End Sub

Private Sub M_S_N_Click()
    NovySoubor
End Sub

Private Sub M_S_O_Click()
    Otevri
End Sub

Private Sub M_S_OZ_Click()
    OtevriZnovu
End Sub

Private Sub M_S_T_Click()
    Vytiskni
End Sub

Public Sub M_S_U_Click()
    If Novy = True Then M_S_UJ_Click: Exit Sub
    Uloz
End Sub

Private Sub M_S_UJ_Click()
    UlozJako
End Sub

Private Sub M_U_Click()
    If Clipboard.GetText = "" Then M_U_VL.Enabled = False Else M_U_VL.Enabled = True
    If RB.SelText = "" Then M_U_K.Enabled = False Else M_U_K.Enabled = True
    If RB.SelText = "" Then M_U_V.Enabled = False Else M_U_V.Enabled = True
    If RB.SelText = "" Then M_U_O.Enabled = False Else M_U_O.Enabled = True
End Sub

Private Sub M_U_K_Click()
    Clipboard.SetText RB.SelText
End Sub

Private Sub M_U_N_Click()
    Najit.UkazMe 0
End Sub

Private Sub M_U_ND_Click()
    NajitDalsi
End Sub

Private Sub M_U_NH_Click()
    Najit.UkazMe 1
End Sub

Private Sub M_U_O_Click()
    RB.SelText = ""
End Sub

Private Sub M_U_V_Click()
    Clipboard.SetText RB.SelText
    RB.SelText = ""
End Sub

Private Sub M_U_VL_Click()
    RB.SelText = Clipboard.GetText
End Sub

Private Sub M_U_VV_Click()
    RB.SelStart = 0
    RB.SelLength = Len(RB.Text)
End Sub

Private Sub RB_Change()
    RB2.Tag = "L"
    If RB.Tag = "" Then RB2.Text = RB.Text
    RB2.Tag = ""
    Zmena = True
End Sub

Private Sub RB_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
    If Button = 2 Then PopupMenu M_RB, , X, y
End Sub

Private Sub RB2_Change()
    RB.Tag = "L"
    If RB2.Tag = "" Then RB.Text = RB2.Text
    Zmena = True
    RB.Tag = ""
End Sub

Private Sub RB2_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
    If Button = 2 Then PopupMenu M_RB, , X, y
End Sub

Public Sub Setrid()
    Radky.Clear
    Dim i As Double, s As String: s = RB.Text
    Dim Od As Double: Od = 1
    For i = 1 To Len(s) - 1
        If Mid(s, i, 2) = vbCrLf Then
            Radky.AddItem Mid(s, Od, i - Od)
            Od = i + 2
        End If
    Next
    Radky.AddItem Mid(s, Od)
    '
    Dim Zmena As Boolean
    Dim ss As String
    For Od = 0 To Radky.ListCount - 1
        Zmena = False
        For i = 0 To Radky.ListCount - 2
            If Radky.List(i + 1) < Radky.List(i) Then
                ss = Radky.List(i + 1)
                Radky.RemoveItem i + 1
                Radky.AddItem ss, i
                Zmena = True
            End If
        Next
        If Zmena = False Then Exit For
    Next
    s = ""
    For i = 0 To Radky.ListCount - 1
        s = s & Radky.List(i) & vbCrLf
    Next
    RB.Text = s
End Sub

Public Enum KodujII
    Dekódovat
    Zakódovat
End Enum

Public Function KodovaniIIIGenerace(Text As String, Heslo As String, Mode As KodujII) As String
    Dim i As Double, s As String: s = ""
    Dim k As Integer, l As Integer, l0 As Integer
    Dim a As Integer, o As Integer
    a = 0: k = 0: l0 = 1
    For l = 1 To Len(Heslo)
        o = Asc(Mid(Heslo, l, 1))
        a = a + l * Asc(o) - k
        l0 = -l0
        k = k + l * Asc(o) - a
    Next
    While a > 255: a = a - 256: Wend
    While a < -255: a = a + 256: Wend
    While o > 255: o = o - 256: Wend
    While o < -255: o = o + 256: Wend
    l = 0: l0 = 1
    For i = 1 To Len(Text)
        If Mode = Zakodovat Then o = (((Asc(Mid(Text, i, 1)) + k) Xor a) - l) Xor k Else _
                                 o = (((Asc(Mid(Text, i, 1)) Xor k) + l) Xor a) - k
        While o > 255: o = o - 256: Wend
        While o < 0: o = o + 256: Wend
        s = s & Chr(o)
        k = -k:
        l = l + l0: If l = 100 Or l = 0 Then l0 = -l0
    Next
    l = Len(s)
    KodovaniIIIGenerace = s
End Function

Public Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Public Stor As Boolean
'Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Sub NovySoubor()
    Zmeneno
    If Stor = True Then Stor = False: Exit Sub
Hl.RB.Text = ""
Hl.Zmena = False
Hl.Novy = True
Hl.Cesta = ""
Hl.Cesta_Jmeno = "Bez názvu"
Hl.M_S_OZ.Enabled = False
DejTitulek
End Sub

'Nabídka soubor
Public Sub Otevri()
If Hl.Tag <> "" Then Hl.CD.FileName = Hl.Tag: GoTo Pre
    Zmeneno
    If Stor = True Then Stor = False: Exit Sub
Hl.CD.Flags = cdlOFNFileMustExist
Hl.CD.Filter = Hl.Typy
Hl.CD.ShowOpen

If Hl.CD.FileName = "" Then Exit Sub
Pre:
On Error GoTo p
Hl.RB.Tag = "L": Hl.RB2.Tag = "L"
Hl.RB.LoadFile Hl.CD.FileName, rtfText
Hl.RB2.Text = Hl.RB.Text
Hl.RB.Tag = "": Hl.RB2.Tag = ""
    Hl.Cesta = Hl.CD.FileName
    Hl.Cesta_Jmeno = Hl.CD.FileTitle
    Hl.Novy = False
    Hl.Zmena = False
    Hl.CD.FileName = ""
    Hl.M_S_OZ.Enabled = True
DejTitulek

Exit Sub
p:
MsgBox "Soubor nelze otevřít!", vbCritical
End Sub

Public Sub OtevriZnovu()
    Zmeneno
    If Stor = True Then Stor = False: Exit Sub
Hl.RB.LoadFile Hl.Cesta, rtfText
    Hl.Zmena = False
    Hl.CD.FileName = ""
End Sub

Public Sub Uloz()
On Error GoTo p
Hl.RB.SaveFile Hl.Cesta, rtfText
Hl.Zmena = False
Exit Sub
p:
MsgBox "Soubor nelze uložit!", vbCritical
End Sub

Public Sub UlozJako()
Hl.CD.Filter = "Vše (*.*)|*.*"
Hl.CD.ShowSave
If Hl.CD.FileName = "" Then Exit Sub
    'Když už daný soubor existuje
    If Trim(Dir(Hl.CD.FileName)) <> "" Then
        a = MsgBox("Soubor " + Hl.CD.FileTitle + " již existuje." + Chr(13) + " " + Chr(13) + "Chcete jej přepsat?", vbExclamation + vbYesNo)
        If a = vbNo Then Exit Sub
    End If
On Error GoTo p
Hl.RB.SaveFile Hl.CD.FileName, rtfText
    Hl.Cesta = Hl.CD.FileName
    Hl.Cesta_Jmeno = Hl.CD.FileTitle
    Hl.Novy = False
    Hl.Zmena = False
    Hl.CD.FileName = ""
    Hl.M_S_OZ.Enabled = True
DejTitulek
Exit Sub
p:
MsgBox "Soubor nelze uložit!", vbCritical
End Sub

Public Sub Vytiskni()
    Printer.FontBold = True
    Printer.Print Hl.Cesta
    Printer.FontBold = False
    Printer.Print " "
    Hl.RB.SelPrint (Printer.hDC)
End Sub

'Nabídka Úpravy
Public Sub NajitDalsi()
    If Najit.UzVyhledavano = False Then Najit.UkazMe 0
    Najit.NaDa_Click
End Sub

'Nabidka Formát
Public Sub Pismo()
On Error GoTo p
q = Hl.Zmena
Hl.CD.Flags = cdlCFEffects Or cdlCFBoth
Hl.CD.ShowFont
Hl.RB.Font.Name = Hl.CD.FontName
Hl.RB.Font.Size = Hl.CD.FontSize
Hl.RB2.Font.Name = Hl.CD.FontName
Hl.RB2.Font.Size = Hl.CD.FontSize
    'Hl.RB.sel Hl.CD.Color
    Hl.RB.Font.Bold = Hl.CD.FontBold
    Hl.RB.Font.Italic = Hl.CD.FontItalic
    Hl.RB.Font.Underline = Hl.CD.FontUnderline
    Hl.RB.Font.Strikethrough = Hl.CD.FontStrikethru
    Hl.RB2.Font.Bold = Hl.CD.FontBold
    Hl.RB2.Font.Italic = Hl.CD.FontItalic
    Hl.RB2.Font.Underline = Hl.CD.FontUnderline
    Hl.RB2.Font.Strikethrough = Hl.CD.FontStrikethru
If Hl.RB.Font.Bold = True Then Nastav.h(0).Value = 1 Else Nastav.h(0).Value = 0
If Hl.RB.Font.Italic = True Then Nastav.h(1).Value = 1 Else Nastav.h(1).Value = 0
If Hl.RB.Font.Underline = True Then Nastav.h(2).Value = 1 Else Nastav.h(2).Value = 0
If Hl.RB.Font.Strikethrough = True Then Nastav.h(3).Value = 1 Else Nastav.h(3).Value = 0
Nastav.zk.FontName = Hl.RB.Font.Name
Nastav.zk.FontSize = Hl.RB.Font.Size
p:
Hl.Zmena = q
End Sub

Public Sub Zalamovani()
If Hl.M_FO_Z.Checked = True Then Hl.M_FO_Z.Checked = False Else Hl.M_FO_Z.Checked = True
If Hl.M_FO_Z.Checked = False Then
    Hl.RB.Visible = False: Hl.RB2.Visible = True
End If
If Hl.M_FO_Z.Checked = True Then
    Hl.RB2.Visible = False: Hl.RB.Visible = True
End If
End Sub

'Nabídka Funkce

Public Sub DelkaTextu()
    Dim d As Double
    d = Len(Hl.RB.SelText)
    Dim i As Double, R As Integer: R = 1
    i = InStr(Hl.RB.SelStart + 1, Hl.RB.Text, vbCrLf, vbTextCompare)
    While i <> 0
        If i > Hl.RB.SelStart + Hl.RB.SelLength Then GoTo p
        R = R + 1
        d = d - 2
        i = InStr(i + 1, Hl.RB.Text, vbCrLf, vbTextCompare)
    Wend
p:
    If d = 1 Then k = "znak"
    If d >= 2 And d <= 4 Then k = "znaky"
    If d >= 5 Then k = "znaků"
    MsgBox "Délka označeného textu:" + Str(d) + " " + k & Chr(13) & "Počet řádků: " & R
End Sub

Public Sub Odzadu()
    'Hl.pr.Visible = True
    'Hl.Form_Resize
    Dim s As String: s = Hl.RB.Text
    Dim Znak As String * 1
    For i = Len(s) To 1 Step -1
        'Hl.pr.Value = Int(((Len(s) - i) / Len(s)) * 100)
        Znak = Mid(s, i, 1)
        If Znak = Chr$(10) Then Znak = Chr$(13) + Chr(10): i = i - 1
        te = te & Znak
    Next
    'Hl.pr.Visible = False
    'Hl.Form_Resize
    'If Hl.RB.Visible = True Then Hl.RB.Text = te Else Hl.RB2.Text = te
    Hl.RB.Text = te
End Sub

'Ostatní
Public Sub Zmeneno()
If Hl.Zmena = True Then
    a = MsgBox("Soubor " + Hl.Cesta_Jmeno + " byl změněn." + Chr(13) + " " + Chr(13) + "Chcete změny uložit?", vbExclamation + vbYesNoCancel)
    If a = vbYes Then Hl.M_S_U_Click: Exit Sub
    If a = vbNo Then Exit Sub
    If a = vbCancel Then Stor = True: Exit Sub
End If
End Sub

Public Sub DejTitulek()
    Hl.Caption = "Computer's log: " + Hl.Cesta_Jmeno
End Sub

Public CIS
Public PSouboru

Private Sub b_proved_Click()
a = poradi.Text
If Val(a) > PSouboru + 1 Or Val(a) < 1 Or a = "" Then MsgBox ("Chybné zadání!"): Exit Sub
typ.AddItem celek.Caption, Val(a) - 1
typ.ListIndex = Val(a) - 1
PSouboru = PSouboru + 1
pocet.Caption = PSouboru
End Sub

Private Sub Command3_Click()
On Error GoTo p
Hl.CD.Flags = cdlCFEffects Or cdlCFBoth
Hl.CD.ShowFont
zk.FontName = Hl.CD.FontName
p:
zk.FontSize = Hl.CD.FontSize
zk.ForeColor = Hl.CD.Color
If Hl.CD.FontBold = True Then h(0).Value = 1 Else h(0).Value = 0
If Hl.CD.FontItalic = True Then h(1).Value = 1 Else h(1).Value = 0
If Hl.CD.FontUnderline = True Then h(2).Value = 1 Else h(2).Value = 0
If Hl.CD.FontStrikethru = True Then h(3).Value = 1 Else h(3).Value = 0

End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()
Me.Icon = Hl.Icon
stav.AddItem "Klasické okno"
stav.AddItem "Minimalizované okno"
stav.AddItem "Maximilizované okno"
PSouboru = 0
End Sub

Public Sub Nacti()
stav.ListIndex = Hl.WindowState
If Hl.WindowState = 2 Then Hl.WindowState = 0: stt = 1
p(0).Text = Hl.Left
p(1).Text = Hl.Top
p(2).Text = Hl.Width
p(3).Text = Hl.Height


If stt = 1 Then Hl.WindowState = 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Hl.Tag = "L" Then Exit Sub
Cancel = 1
Me.Hide
End Sub

Private Sub h_Click(Index As Integer)
zk.Visible = True
zk.FontBold = h(0).Value
zk.FontItalic = h(1).Value
zk.FontUnderline = h(2).Value
zk.FontStrikethru = h(3).Value
End Sub

Private Sub odstran_Click()
a = Val(poradi.Text)
If a > PSouboru Or a = "" Or a < 1 Then MsgBox ("Nelze provést!"): Exit Sub
typ.RemoveItem a - 1
PSouboru = PSouboru - 1
pocet.Caption = PSouboru
End Sub

Private Sub popis_Change()
celek.Caption = popis.Text + " (*." + pri.Text + ")"
End Sub

Private Sub pri_Change()
popis_Change
End Sub

Private Sub typ_Click()
a = typ.ListIndex
If a < 0 Then Exit Sub
For i = 1 To Len(typ.Text)
z = Mid(typ.Text, i, 1)
If z = "(" Then popis.Text = Left(typ.Text, i - 2): pri.Text = Right(typ.Text, Len(typ.Text) - i - 2): pri.Text = Left(pri.Text, Len(pri.Text) - 1): Exit For
Next
poradi.Text = a + 1
End Sub

Public Sub Uloz_Click()
Dim Celkove As String
'CheckBoxy
For i = 0 To 5
Cislo h(i).Value
    Celkove = Celkove + CIS
Next
'Optiony
If OP(0).Value = True Then Celkove = Celkove + "0"
If OP(1).Value = True Then Celkove = Celkove + "1"
If OP(2).Value = True Then Celkove = Celkove + "2"
'ComboBoxy
Cislo stav.ListIndex
    Celkove = Celkove + CIS
'Zbytek karty pismo
    Celkove = Celkove + "/#\" + zk.FontName
'Zbytek karty ostatni
    Cislo zk.FontSize
    Celkove = Celkove + "/#\" + CIS
'Zbytek karty vzhled
For i = 0 To 3
    Cislo p(i).Text
    Celkove = Celkove + "/#\" + CIS
Next
'Zbytek karty typy souborů
    Celkove = Celkove + "/#\"
For i = 0 To PSouboru - 1
    typ.ListIndex = i
    Celkove = Celkove + typ.Text + "/#\"
Next

'Uložení do souboru
Open App.Path + "\SetData.dat" For Output As #1
    Print #1, Celkove
Close #1
If Hl.Tag = "" Then TypySouboru ""
Hl.RB.Font.Bold = (h(0).Value = 1)
Hl.RB.Font.Italic = (h(1).Value = 1)
Hl.RB.Font.Underline = (h(2).Value = 1)
Hl.RB.Font.Strikethrough = (h(3).Value = 1)
Hide
End Sub

Private Sub zamen_Click()
odstran_Click
b_proved_Click
End Sub

Public Sub Cislo(X)
CIS = Str(X)
CIS = Right(CIS, Len(CIS) - 1)
End Sub

Public Sub TypySouboru(C)
If C = "" Then GoTo prsc
qw:
For q = 1 To Len(C)
    z = Mid(C, q - J, 3)
    b = Asc(z)
If z = "/#\" Then
m = Left(C, q - 1)
typ.AddItem m
For y = 1 To Len(m)
    zq = Mid(m, y, 1)
    If zq = "(" Then pripo = Right(m, Len(m) - y - 2): pripo = Left(pripo, Len(pripo) - 1): Exit For
Next

If Hl.Typy = "" Then pom = "" Else pom = "|"
Hl.Typy = Hl.Typy + pom + m + "|*." + pripo
C = Right(C, Len(C) - q - 2)
PSouboru = PSouboru + 1
GoTo qw

End If
Next
pocet.Caption = PSouboru
typ.ListIndex = 0

'Přijetí nastavení
prsc:
Hl.Left = Val(p(0).Text)
Hl.Top = Val(p(1).Text)
Hl.Width = Val(p(2).Text)
Hl.Height = Val(p(3).Text)
Hl.WindowState = stav.ListIndex
If h(5).Value = 0 Then Hl.M_FO_Z.Checked = False
If h(4).Value = 1 Then Kodovani.CH.Value = 1
If OP(0).Value = True Then Kodovani.OP(0).Value = True
If OP(1).Value = True Then Kodovani.OP(1).Value = True
If OP(2).Value = True Then Kodovani.OP(2).Value = True
If h(0).Value = 1 Then Hl.RB.Font.Bold = True
If h(0).Value = 1 Then Hl.RB2.Font.Bold = True
If h(1).Value = True Then Hl.RB.Font.Italic = True
If h(1).Value = True Then Hl.RB2.Font.Italic = True
If h(2).Value = 1 Then Hl.RB.Font.Underline = True
If h(2).Value = 1 Then Hl.RB2.Font.Underline = True
If h(3).Value = 1 Then Hl.RB.Font.Strikethrough = True
If h(3).Value = 1 Then Hl.RB2.Font.Strikethrough = True
Hl.RB.Font.Name = zk.FontName
Hl.RB.Font.Size = zk.FontSize
Hl.RB2.Font.Name = zk.FontName
Hl.RB2.Font.Size = zk.FontSize

End Sub

Public Minula As Double
Public UzVyhledavano As Boolean

Public Sub UkazMe(X As Byte)
    Nahrad.Enabled = False
    If X = 0 Then
        Caption = "Najít:"
        Height = a.Height
    Else
        Caption = "Nahradit:"
        Height = a2.Height
    End If
    Show , Hl
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

Private Sub Form_Load()
    Icon = Hl.Icon
    UzVyhledavano = False
    Minula = 1
End Sub

Public Sub NaDa_Click()
    UzVyhledavano = True
    Dim i As Double
p:
    Tag = ""
    i = InStr(Minula, Hl.RB.Text, Naj.Text, vbTextCompare)
    If i = 0 Then
        Minula = 1
        Nahrad.Enabled = False
    Else
        If Roz.Value = 1 Then
            If Mid(Hl.RB.Text, i, Len(Naj.Text)) <> Naj.Text Then
                Minula = i + 1
                GoTo p
            End If
        End If
        Hl.RB.SelStart = i - 1: Hl.RB.SelLength = Len(Naj.Text)
        Hl.SetFocus
        Minula = i + 1
        Nahrad.Enabled = True
        Tag = "Q"
    End If
End Sub

Private Sub Nahrad_Click()
    Hl.RB.SelText = NajZa.Text
    NaDa_Click
End Sub

Public Sub NahVse_Click()
    Minula = 1
    Do
        NaDa_Click
        If Tag <> "" Then Hl.RB.SelText = NajZa.Text
    Loop Until Tag = ""
End Sub

Private Sub Naj_Change()
    If Len(Naj.Text) = 0 Then NaDa.Enabled = False Else NaDa.Enabled = True
    UzVyhledavano = False
    Minula = 1
End Sub

Private Sub Naj_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then Hide
End Sub

Private Sub Sto_Click()
    Hide
End Sub