Private Akutni As Integer
Private Tit() As Boolean
Private Jaky As Integer
Private Barva(1 To 4) As OLE_COLOR
Private Informace() As String * 5
Private Pole() As String * 5
Private Zdroj(1 To 4) As Integer
Private RX As Byte, RY As Byte
Private StCi As Byte
Private UzNe As Boolean
Private HraBezi As Boolean

Public Sub VytvorPole(X As Integer, Y As Integer, C As Integer)
    RX = X: RY = Y
    Dim i As Integer, o As Integer
    For i = 0 To Y - 1
        For o = 0 To X - 1
            If Not (i = 0 And o = 0) Then Load Im(Im.Count)
            With Im(Im.Count - 1)
                .Move o * C, i * C, C, C
                .Visible = True
                .Picture = Pozadi.Picture
            End With
        Next
    Next
    f.Width = X * C: f.Height = Y * C
    f2.Height = f.Height
    ReDim Pole(0 To X * Y - 1)
    ReDim Informace(0 To Pct.Count - 1)
    '
    Informace(0) = "A0110"
    Informace(1) = "B1001"
    Informace(2) = "C1100"
    Informace(3) = "D1010"
    Informace(4) = "E0011"
    Informace(5) = "F0101"
    Informace(6) = "GZDR1"
    Informace(7) = "GZDR2"
    Informace(8) = "GZDR3"
    Informace(9) = "GZDR4"
    Informace(10) = "H2332"
    Informace(11) = "IZNIC"
    Informace(12) = "J2233"
    Informace(13) = "K2323"
    Informace(14) = "L1110"
    Informace(15) = "M1011"
    Informace(16) = "N0111"
    Informace(17) = "O1101"
    Informace(18) = "PZDR4"
    Informace(19) = "PZDR3"
    Informace(20) = "PZDR2"
    Informace(21) = "PZDR1"
End Sub


Private Sub Form_Load()
    Barva(4) = RGB(0, 147, 217)
    Barva(3) = RGB(255, 255, 36)
    Barva(2) = RGB(255, 72, 72)
    Barva(1) = RGB(70, 217, 0)
    VytvorPole 18, 18, Screen.TwipsPerPixelX * 32
    Dim i As Integer
    ReDim Tit(0 To Lb.Count - 1)
    For i = 0 To Lb.Count - 1: Tit(i) = True: Next
    Jaky = 0
    Lb_MouseMove -1, 0, 0, 0, 0
End Sub

Private Sub Form_Resize()
    f2.Left = Width - f2.Width - f2.Top
    Info.Move (Width - Info.Width) / 2, (Height - Info.Height) / 2
End Sub

Private Sub Im_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If HraBezi = True Then
        If Shift = 1 Then
            Dim i As Byte, z As String * 1
            z = Left(Pole(Index), 1)
            If z = "G" Or z = "P" Then Exit Sub
            i = Val(Poct(Akutni).Caption)
            If i = 0 Then Exit Sub
            i = i - 1: Poct(Akutni).Caption = i
            Design Index, Button, 0
            If i = 0 Then Poct(Akutni).Visible = False
        End If
        If Shift = 0 Then Hra Index
    Else
        Design Index, Button, Shift
    End If
End Sub

Private Sub Novy_Click()
    Zdroj(1) = -1: Zdroj(2) = -1: Zdroj(3) = -1: Zdroj(4) = -1
    Dim i As Integer
    For i = 0 To Im.Count - 1
        Pole(i) = "00000"
        Im(i).Tag = ""
        Im(i).Picture = Pozadi.Picture
    Next
    For i = 0 To Poct.Count - 1: Poct(i).Caption = 0: Next
    Pct_MouseDown 0, 0, 0, 0, 0
    VynulujOznacene
End Sub

Private Sub Otev_Click()
    cd.Filter = "Soubory map|*.map"
    cd.FileName = App.Path & "\MAPS\*.map"
    cd.flags = cdlOFNFileMustExist
    cd.ShowOpen
    If cd.FileName = "" Or cd.FileTitle = "" Then Exit Sub
    RB.LoadFile cd.FileName, rtfText
    NactiMapu RB.Text
End Sub

Private Sub Design(Index As Integer, Button As Integer, Shift As Integer)
    If Shift = 0 Then
    If Button = 1 Then
        If Left(Pole(Index), 1) = "G" Then Exit Sub
        Im(Index).Picture = Akt.Picture
        Pole(Index) = Akt.Tag
        If Left(Akt.Tag, 1) = "G" Then Zdroj(Val(Right(Akt.Tag, 1))) = Index: TestStartu
    End If
    If Button = 2 Then
        Im(Index).Picture = Pozadi.Picture
        If Left(Pole(Index), 1) = "G" Then
            Dim i As Byte
            For i = 1 To 4
                If Zdroj(i) = Index Then Zdroj(i) = -1
            Next
        End If
        Pole(Index) = "00000"
    End If
    Hra -Index
    End If
    If Shift = 1 Then Hra Index
End Sub

Private Sub Hra(Index As Integer)
    'Otočení
    If Index < 0 Then Index = Abs(Index): GoTo p
    Dim s As String * 1: s = Left(Pole(Index), 1)
    Dim o As Byte, i As Integer
    Select Case s
        Case "A": i = 1
        Case "B": i = 0
        Case "C": i = 3
        Case "D": i = 4
        Case "E": i = 5
        Case "F": i = 2
        Case "J": i = 13
        Case "K": i = 12
        Case "L": i = 15
        Case "M": i = 16
        Case "N": i = 17
        Case "O": i = 14
        Case Else: i = -1
    End Select
    If i <> -1 Then
        Im(Index).Picture = Pct(i).Picture
        Pole(Index) = Informace(i)
    End If
p:
    VynulujOznacene
    l.Clear: UzNe = False
    'Test
    StCi = 0
    For o = 1 To 4
        If Zdroj(o) <> -1 And UzNe = False Then
            StCi = StCi + 1
            Test Zdroj(o) + 1, 2, o, Zdroj(o)
        End If
    Next
    If StCi = 0 And UzNe = False Then Vytez
End Sub

Private Sub Test(Policko As Integer, ZPole As Integer, CZdroj As Byte, Minuly As Integer)
    If UzNe = True Then Exit Sub
    Dim i As Byte
    Dim i2 As Integer
    'Kompatibilita
    If Policko > Im.Count - 1 Or Policko < 0 Then Exit Sub
    Dim z As String * 1: z = Left(Pole(Policko), 1)
    If z <> "G" And Mid(Pole(Policko), ZPole + 1, 1) = "0" Then Exit Sub
    If z = "P" And ZPole = 2 Then 'Cíl
        If CZdroj = Val(Right(Pole(Policko), 1)) Then StCi = StCi - 1 Else Konec
        Exit Sub
    End If
    If Pole(Policko) = "IZNIC" Then Konec: Exit Sub
    If z <> "H" And z <> "J" And z <> "K" Then
        If Im(Policko).Tag = Chr(CZdroj + 64) Then
            Exit Sub
        Else
            If Im(Policko).Tag <> "" Then
                Konec
                Exit Sub
            End If
        End If
    End If
    ' Vybarvení políčka
    l.AddItem Policko
    If z = "H" Then
        If ZPole = 1 Or ZPole = 4 Then Im(Policko).BackColor = Barva(CZdroj)
    ElseIf z = "J" Then
        If ZPole = 1 Or ZPole = 2 Then Im(Policko).BackColor = Barva(CZdroj)
    ElseIf z = "K" Then
        If ZPole = 1 Or ZPole = 3 Then Im(Policko).BackColor = Barva(CZdroj)
    Else
        Im(Policko).BackColor = Barva(CZdroj)
    End If
    Im(Policko).Tag = Chr(CZdroj + 64)
    Dim St As String: St = "1"
    Select Case z ' určení křižovatekpolíček
        Case "H": If ZPole = 1 Or ZPole = 4 Then St = "2" Else St = "3"
        Case "J": If ZPole = 1 Or ZPole = 2 Then St = "2" Else St = "3"
        Case "K": If ZPole = 1 Or ZPole = 3 Then St = "2" Else St = "3"
    End Select
    'Test ostatních - rekurze
    For i = 2 To 5
        If Mid(Pole(Policko), i, 1) = St Then
            If i = 2 And ZPole <> 1 Then Test Policko - RX, 4, CZdroj, Policko
            If i = 5 And ZPole <> 4 Then Test Policko + RX, 1, CZdroj, Policko
            If i = 3 And ZPole <> 2 And Policko Mod RX <> 0 Then Test Policko - 1, 3, CZdroj, Policko
            If i = 4 And ZPole <> 3 And Policko Mod RX <> RX - 1 Then Test Policko + 1, 2, CZdroj, Policko
        End If
    Next
End Sub

Public Sub Konec()
    If HraBezi = False Then Exit Sub
    UzNe = True
    JakyInfo.Caption = "V obovodu došlo ke skratu!"
    RESET.Tag = "R"
    RESET.Enabled = True
    Info.Visible = True
End Sub

Private Sub TestStartu()
    Dim i As Byte
    For i = 1 To 4
        If Zdroj(i) <> -1 Then
            If Left(Pole(Zdroj(i)), 1) <> "G" Then Zdroj(i) = -1
        End If
    Next
End Sub

Private Sub Vytez()
    If HraBezi = False Then Exit Sub
    JakyInfo.Caption = "Vyhrál jsi!" & Chr(13) & "Přesměrováno"
    Info.Visible = True
    RESET.Tag = "V"
    RESET.Enabled = True
End Sub

Private Sub Pct_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Akutni = Index
    If Shift = 0 Then
        Akt.Picture = Pct(Index).Picture
        Akt.Tag = Informace(Index)
    End If
    If Shift = 1 Then
        If HraBezi = True Then Exit Sub
        Dim i As Integer
        i = Val(Poct(Index).Caption)
        If Button = 2 Then i = i - 1
        If Button = 1 Then i = i + 1
        If i = -1 Then i = 0: If i = 10 Then i = 9
        Poct(Index).Caption = i
    End If
End Sub

Private Sub Poct_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Pct_MouseDown Index, Button, Shift, X, Y
End Sub

Private Sub RESET_Timer()
    If Info.Visible = False Then
        RESET.Enabled = False
        If RESET.Tag = "R" Then RestMapy Else Lb_Click 5
        Exit Sub
    End If
    Info.Visible = False
End Sub

Private Sub Uloz_Click()
    Dim s As String, i As Integer: s = ""
    For i = 0 To Im.Count - 1
        s = s & Pole(i)
    Next
    For i = 0 To 17
        s = s & Poct(i).Caption
    Next
    cd.Filter = "Soubory map|*.map"
    cd.FileName = App.Path & "\MAPS\*.map"
    cd.flags = Empty
    cd.DialogTitle = "Uložit"
p:
    cd.ShowSave
    If cd.FileName = "" Or cd.FileTitle = "" Then Exit Sub
    If Trim(Dir(cd.FileName)) <> "" Then
        a = MsgBox("Tento soubor již existuje." & Chr(13) & "Chcete jej přepsat?", vbQuestion + vbYesNoCancel)
        If a = vbNo Then Exit Sub
        If a = vbCancel Then GoTo p
    End If
    RB.Text = s
    RB.SaveFile cd.FileName, rtfText
End Sub

Private Sub VynulujOznacene()
    Dim i As Integer
    For i = 0 To l.ListCount - 1
        With Im(Val(l.List(i)))
            .Tag = ""
            .BackColor = f.BackColor
        End With
    Next
End Sub

Public Sub EditMode()
    Info.Visible = False
    Novy_Click
    HraBezi = False
    Dim i As Byte
    For i = 6 To 9: Pct(i).Visible = True: Next
    Pct(11).Visible = True
    For i = 18 To 21: Pct(i).Visible = True: Next
    Frame1.Visible = True: Frame2.Visible = False
    Form2.Hide
    For i = 0 To Poct.Count - 1: Poct(i).Visible = True: Next
    Visible = True
End Sub

Private Sub Lb_Click(Index As Integer)
    Select Case Index
        Case 0: Novy_Click
        Case 1: Otev_Click
        Case 2: Uloz_Click
        Case 3: GoTo p
        Case 4: Form2.NactiSoubory: Hide: Form2.Show
        Case 5: Form2.NactiSoubory: Hide: Form2.Show
        Case 6: RestMapy
    End Select
    Exit Sub
p:
    MsgBox Ovld.Caption, vbInformation
End Sub

Private Sub Lb_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Jaky = Index Then Exit Sub
    Jaky = Index
    Dim i As Byte
    For i = 0 To Lb.Count - 1
        If Tit(i) = True Then Lb(i).ForeColor = &H161616: Tit(i) = False
    Next
    If Index >= 0 Then Lb(Index).ForeColor = &H626262: Tit(Index) = True
End Sub

Private Sub NactiMapu(Text As String)
    Dim s As String: s = Text
    Dim i As Integer, o As Integer: o = 0
    Dim q As Integer, z As String * 1
    For i = 1 To Len(s) Step 5
        Pole(o) = Mid(s, i, 5)
        Im(o).Tag = ""
        z = Mid(s, i, 1)
        Select Case z
            Case "A" To "F": q = Asc(z) - 65
            Case "G": q = Val(Mid(s, i + 4, 1)) + 5
                      Zdroj(q - 5) = o
            Case "H" To "O": q = Asc(z) - 62
            Case "P": q = 22 - Val(Mid(s, i + 4, 1))
            Case Else: q = -1
        End Select
        If q = -1 Then Im(o).Picture = Pozadi.Picture Else Im(o).Picture = Pct(q).Picture
        o = o + 1
        If o = Im.Count Then i = i + 5: Exit For
    Next
    Dim i2 As Byte: i2 = 0
    For o = i To Len(s)
        Poct(i2).Caption = Mid(s, o, 1)
        i2 = i2 + 1
    Next
    TestStartu
    VynulujOznacene
    Hra -1
End Sub

Public Sub HraMode(Mapa As String)
    Frame1.Visible = False
    Frame2.Visible = True
    Info.Visible = False
    HraBezi = True
    Pct_MouseDown 0, 0, 0, 0, 0
    Dim i As Byte
    For i = 6 To 9: Pct(i).Visible = False: Next
    Pct(11).Visible = False
    For i = 18 To 21: Pct(i).Visible = False: Next
    RB.LoadFile Mapa
    NactiMapu RB.Text
    For i = 0 To Poct.Count - 1
        If Poct(i).Caption <> "0" Then Poct(i).Visible = True Else Poct(i).Visible = False
    Next
    Form2.Hide
    Show
End Sub

Public Sub HraMode0()
    Info.Visible = False
    Frame2.Visible = True
    HraBezi = True
    Pct_MouseDown 0, 0, 0, 0, 0
    Dim i As Byte
    For i = 6 To 9: Pct(i).Visible = False: Next
    Pct(11).Visible = False
    For i = 18 To 21: Pct(i).Visible = False: Next
    NactiMapu RB.Text
    For i = 0 To Poct.Count - 1
        If Poct(i).Caption <> "0" Then Poct(i).Visible = True Else Poct(i).Visible = False
    Next
    Form2.Hide
    Show
End Sub

Private Sub RestMapy()
    NactiMapu RB.Text
    For i = 0 To Poct.Count - 1
        If Poct(i).Caption <> "0" Then Poct(i).Visible = True Else Poct(i).Visible = False
    Next
End Sub

Private Dir7 As New DirectX7
Private Dir7Draw As DirectDraw7
Private ZobrazenoOd As Integer
Private Tit() As Boolean
Private Tit2() As Boolean
Private Jaky As Integer, Jaky2 As Integer

Private Sub Form_Load()
    Show
    Dim i As Integer
    ReDim Tit(0 To Lb.Count - 1)
    ReDim Tit2(0 To Soubor.Count - 1)
    For i = 0 To Lb.Count - 1: Tit(i) = True: Next
    For i = 0 To Soubor.Count - 1: Tit2(i) = True: Next
    Jaky = 0: Jmeno.Text = "": Jaky2 = 0
    Lb_MouseMove -1, 0, 0, 0, 0
    Soubor_MouseMove -1, 0, 0, 0, 0
    MAPY.LoadFile App.Path & "\Data\Toky.sys"
    Dim s1 As String
    Open App.Path & "\Data\Cfg.sys" For Input As #1
        Input #1, s1
    Close #1
    Roz.Caption = s1: If s1 = "Ano" Then Rozliseni
End Sub

Private Sub Image7_Click()
    If ZobrazenoOd + 9 < Fil.ListCount - 1 Then ZobrazOd ZobrazenoOd + 1
End Sub

Private Sub Lb_Click(Index As Integer)
    Dim i As Byte
    Select Case Index
        Case 0 To 4
            If Index = 1 Then NactiSoubory
            For i = 0 To 4: Frm(i).Visible = False: Next
            Frm(Index).Visible = True
        Case 5: Form1.EditMode
        Case 6:
            Dim s As String
            s = App.Path & "\MAPS\" & Jmeno.Text & ".map"
            If Trim(Dir(s)) = "" Then Exit Sub
            Form1.HraMode s
        Case 7: UkonciAplikaci
        
    End Select
End Sub

Private Sub Lb_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Jaky = Index Then Exit Sub
    Jaky = Index
    Dim i As Byte
    For i = 0 To Lb.Count - 1
        If Tit(i) = True Then Lb(i).ForeColor = &HE0E0E0: Tit(i) = False
    Next
    If Index >= 0 Then Lb(Index).ForeColor = &H808080: Tit(Index) = True
End Sub

Private Sub UkonciAplikaci()
    Open App.Path & "\Data\Cfg.sys" For Output As #1
        Write #1, Roz.Caption
    Close #1
    End
End Sub

Public Sub NactiSoubory()
    Fil.Path = App.Path & "\MAPS": Fil.Refresh
    ZobrazOd 0
End Sub

Private Sub ZobrazOd(X As Integer)
    ZobrazenoOd = X
    Dim i As Integer, s As String
    For i = 0 To 9: Soub(i).Caption = "": Next
    For i = X To X + 9
        If i = Fil.ListCount Then Exit For
        s = Fil.List(i)
        s = Left(s, Len(s) - 4)
        Soub(i - X).Caption = s
    Next
    Soub_Click 0
End Sub

Private Sub Naho_Click()
    If ZobrazenoOd > 0 Then ZobrazOd ZobrazenoOd - 1
End Sub

Private Sub Roz_Click()
    If Roz.Caption = "Ano" Then Roz.Caption = "Ne" Else Roz.Caption = "Ano"
End Sub

Private Sub Soub_Click(Index As Integer)
    If Soub(Index).Caption <> "" Then Jmeno.Text = Soub(Index).Caption
End Sub

Private Sub Soubor_Click(Index As Integer)
    Dim od As Long
    od = Index * 1638 + 1
    Form1.RB.Text = Mid(MAPY.Text, od, 1638)
    Form1.HraMode0
End Sub

Private Sub Soubor_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Jaky2 = Index Then Exit Sub
    Jaky2 = Index
    Dim i As Byte
    For i = 0 To Soubor.Count - 1
        If Tit2(i) = True Then Soubor(i).ForeColor = &HE0E0E0: Tit2(i) = False
    Next
    If Index >= 0 Then Soubor(Index).ForeColor = &H808080: Tit2(Index) = True
End Sub

Public Sub Rozliseni()
    Set Dir7Draw = Dir7.DirectDrawCreate("")
    Dir7Draw.SetCooperativeLevel hWnd, DDSCL_NORMAL + DDSCL_FULLSCREEN
    Dir7Draw.SetDisplayMode 800, 600, 32, 0, DDSDM_DEFAULT
End Sub

Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Sub TransparentniOkno(ByVal hWnd As Long, Uroven As Integer)
    Dim X As Long
    On Error Resume Next
    If Uroven < 0 Then Uroven = 0
    If Uroven > 255 Then Uroven = 255
    X = GetWindowLong(hWnd, -20)
    X = X Or &H80000
    SetWindowLong hWnd, -20, X
    SetLayeredWindowAttributes hWnd, 0, Uroven, &H2
End Sub