LABYRINTHE

' PROGRAMMATION DE LA FORM (MODULE DANS LE ZIP)
' Dans la matrice, le chiffre 0 est un chemin et 1 est un mur. 2 est une clef
Option Explicit
Const NbLignes = 7
Const NbColonnes = 8
Const Dimension = 480
Const X = Dimension / 2
Const Y = Dimension / 2
Dim Fichier As String
Dim bye As Byte
Dim Planche(1 To NbLignes, 1 To NbColonnes) As Integer
Dim Ligne As Byte, Colonne As Byte
Dim J As Byte
Dim Mur As Picture
Dim ManHaut As Picture, Manbas As Picture
Dim ManGauche As Picture, mandroite As Picture
Dim Clé As Picture
Dim L As Byte, C As Byte

Private Sub Form_Load()
    ' Charger les images
    Set Mur = LoadPicture(App.Path & "\Mur_rouge.bmp")
    Set ManHaut = LoadPicture(App.Path & "\face02.ico")
    Set Manbas = LoadPicture(App.Path & "\face02.ico")
    Set ManGauche = LoadPicture(App.Path & "\face02.ico")
    Set mandroite = LoadPicture(App.Path & "\face02.ico")
    Set Clé = LoadPicture(App.Path & "\Secur07.ico")
    DsnBonhomme.Picture = mandroite
    ' Charger la *belle* musique :P
    MMControl1.FileName = App.Path & "\Bond.mid"
    MMControl1.Command = "open"
    MMControl1.Command = "play"
    bye = 1
    ' Déterminer le chemin de la matrice du niveau 1
    Fichier = "\promenade1.txt"
    ' Sous Programmes
    OuvrirFichier
    CréerCanevas
    Afficher
End Sub

'Ce code permet de déterminer lorsque l'utilisateur appuie sur une flèche
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyLeft
            DsnBonhomme.Picture = ManGauche
            gauche
        Case vbKeyUp
            DsnBonhomme.Picture = ManHaut
            haut
        Case vbKeyRight
            DsnBonhomme.Picture = mandroite
            droite
        Case vbKeyDown
            DsnBonhomme.Picture = Manbas
            bas
    End Select
    TestPosition
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MMControl1.Command = "Close"
End Sub


Public Sub OuvrirFichier()
    ' Permet de charger en mémoire la matrice du niveau où le joueur est rendu
    Dim Texte As String
    Open App.Path & Fichier For Input As #1
    For L = 1 To NbLignes
        Input #1, Texte
        For C = 1 To NbColonnes
            Planche(L, C) = Mid(Texte, C, 1)
        Next C
    Next L
    Close #1
End Sub

Public Sub Afficher()
    ' Public sub permettant d'afficher le niveau et de placer le personnage principal selon le niveau
    Dim Place As Integer
    For L = 1 To NbLignes
        For C = 1 To NbColonnes
            Place = Place + 1
            If Planche(L, C) = 1 Then
                DsnCase(Place).Picture = Mur
            End If
            If Planche(L, C) = 2 Then
                DsnCase(Place).Picture = Clé
            End If
        Next C
    Next L
    If bye <> 3 Then
    Colonne = 1
    Ligne = 4
    DsnBonhomme.Move (Colonne - 1) * Dimension + X, (Ligne - 1) * Dimension + Y
    ElseIf bye = 3 Then
    Colonne = 6
    Ligne = 1
    DsnBonhomme.Move (Colonne - 1) * Dimension + X, (Ligne - 1) * Dimension + Y
    End If
End Sub

Public Sub gauche()
    ' Quand l'utilisateur a appuyé sur la touche gauche...
    If (Colonne - 1) < 1 Then Beep: Exit Sub
    If Planche(Ligne, Colonne - 1) = 0 Then
    End If
    If Planche(Ligne, Colonne - 1) <> 1 Then
        For J = 1 To 8
            DsnBonhomme.Left = DsnBonhomme.Left - (480 / 8)
            Sleep 30 ' Effet de glissement (voir module)
        Next J
        Colonne = Colonne - 1
    End If
End Sub

Public Sub droite()
    ' Quand l'utilisateur a appuyé sur la touche droite...
    If Colonne + 1 > 8 Then Beep: Exit Sub
    If Planche(Ligne, Colonne + 1) <> 1 Then
        For J = 1 To 8
            DsnBonhomme.Left = DsnBonhomme.Left + (480 / 8)
            Sleep 30 ' Effet de glissement (voir module)
        Next J
        Colonne = Colonne + 1
    End If
End Sub

Public Sub haut()
    ' Quand l'utilisateur a appuyé sur la touche haut...
    If (Ligne - 1) < 1 Then Beep: Exit Sub
    If Planche(Ligne - 1, Colonne) <> 1 Then
        For J = 1 To 8
            DsnBonhomme.Top = DsnBonhomme.Top - (480 / 8)
            Sleep 30 ' Effet de glissement (voir module)
        Next J
        Ligne = Ligne - 1
    End If
End Sub

Public Sub bas()
    ' Quand l'utilisateur a appuyé sur la touche bas...
    If (Ligne + 1) > NbLignes Then Beep: Exit Sub
    If Planche(Ligne + 1, Colonne) <> 1 Then
        For J = 1 To 8
            DsnBonhomme.Top = DsnBonhomme.Top + (480 / 8)
            Sleep 30 ' Effet de glissement (voir module)
        Next J
        Ligne = Ligne + 1
    End If
End Sub

Public Sub CréerCanevas()
    ' Public Sub permettant de créer le niveau
    Dim Z As Integer, nombre As Integer
    For Z = 1 To (NbLignes * NbColonnes)
        Load DsnCase(Z)
        DsnCase(Z).Height = Dimension
        DsnCase(Z).Width = Dimension
    Next Z
    For Ligne = 0 To NbLignes - 1
        For Colonne = 0 To NbColonnes - 1
            nombre = nombre + 1
            DsnCase(nombre).Left = X + (Colonne * Dimension)
            DsnCase(nombre).Top = Y + (Ligne * Dimension)
            DsnCase(nombre).Visible = True
        Next Colonne
    Next Ligne
    DsnBonhomme.Height = Dimension
    DsnBonhomme.Width = Dimension
    Me.Height = Dimension * (NbLignes + 2)
    Me.Width = Dimension * (NbColonnes + 1)
End Sub

Public Sub TestPosition()
    ' Permet de dire quelle clef est bonne (niveau 1) puis de dire les événements aux sorties
    If Ligne = 3 And Colonne = 7 Then
        Beep
        DsnCase(23).Picture = LoadPicture()
        DsnCase(40).Picture = LoadPicture()
        Planche(5, 8) = 0
    End If
    If Ligne = 5 And Colonne = 8 And bye = 1 Then
        bye = 2
        Fichier = "\promenade2.txt"
        vidercase
        OuvrirFichier
        Afficher
    ElseIf Ligne = 7 And Colonne = 7 And bye = 2 Then
        bye = 3
        Fichier = "\promenade3.txt"
        vidercase
        OuvrirFichier
        Afficher
    ElseIf Ligne = 7 And Colonne = 4 And bye = 3 Then
        MsgBox "Félicitations!"
        Unload Me
        End
    End If
End Sub

Public Sub vidercase()
    ' Permet de "nettoyer" le niveau
    For J = 1 To NbLignes * NbColonnes
        DsnCase(J).Picture = LoadPicture()
    Next J
End Sub