Labyrinthe viewer

Description

Ce code est à but didactique. Je l'ai déstiné au débutants pour plusieurs raisons :
- Il aborde des notions peu utilisées par les débutants : Gestion dynamique des controls, Utilisation de Fonctions, Indentation, lecture et analyse de fichiers. ( l'indentation n'étant pas importante masi facilite tellement la lecture )
- Il est commenté de fond en comble ( sauf ma LibMod, je fais sa documentation en ce moment même )
- Adapation de la taille de mon labyrinthe en fonction du fichier.

Je considère que ces raison sont suffisante. A vous de juger !
En plus, je ne l'ai pas fini, je voulais faire une IA et j'ai codé 2 ou 3 fonctions pour. A vous de continuer !

( PS : Désolé pour les fautes, je suis trop naze en Francais :p )

Source / Exemple :


Option Explicit
' Variables Globales ( A éviter )
Dim Labi As String
Dim OneLine As Integer

Private Sub Form_Load()
Dim i As Integer
Dim iPos As Integer

' Ouverture de mon Laboratoire
Labi = Lire(App.Path & "\Start.lab")

' Initialisation de mes Vars
iPos = 1
i = 1

' Compte le nombre de cases par lignes
' Pour l'instant, cette fonction ne sert pas mais si vous désirez pouvoir
' jouer ou faire un IA, il faudra l'utiliser ( à condition que toute les
' lignes aient le même nombre de cases
OneLine = LenLine

' Début de la boucle
' Tant que i est différent de LenCount ( soit le nombre total de cases ) :
While i <= LenCount

' Initialisation des nouveaux controls
CtrlInit i

' Vérification
If iPos - 1 <> 0 Then

    ' Me sert au décalage en X de mes controls :
    ' Remet en fait mes controls au X correct ( le % servant de marqueur )
    If Mid(Labi, iPos - 1, 1) = "%" Then
    iPos = iPos + 2
    Lab(i).Top = Lab(i - 1).Top + Lab(i).Height
    Lab(i).Left = Lab(i - OneLine).Left
    
        Else
        ' Sinon :
        ' Procédure standart, décalage de la largeur de mon control vers la droite
        Lab(i).Left = Lab(i - 1).Left + Lab(i).Width
        Lab(i).Top = Lab(i - 1).Top
        
    End If
    
End If

' Mise en rapport des cases :
' Si le chiffre est égal à 0 :
' Image Vide
    If Mid(Labi, iPos, 1) = 0 Then
    Lab(i).Picture = LoadPicture(App.Path & "\blanc.bmp")
    Lab(i).Tag = "0"
    
        ' S'il est égal à 1 :
        ' Image Noir
        ElseIf Mid(Labi, iPos, 1) = 1 Then
        Lab(i).Picture = LoadPicture(App.Path & "\noir.bmp")
        Lab(i).Tag = "1"
            
            ' S'il est égal à 2 :
            ' Image Goal
            ElseIf Mid(Labi, iPos, 1) = 2 Then
            Lab(i).Picture = LoadPicture(App.Path & "\goal.bmp")
            Lab(i).Tag = "2"
            
            ' Sinon, il est égal à 3:
            ' Image Départ
                ElseIf Mid(Labi, iPos, 1) = 3 Then
                Lab(i).Picture = LoadPicture(App.Path & "\depart.bmp")
                Lab(i).Tag = "3"
                
' Remarque : Pour la même raison que tout à l'heure, je tag mes controls
' En effet, il est beaucoup plus simple et plus rapide de vérifier le tag
' d'une image que l'image elle même. Mais cette fonction en me sert pas
' pour l'instant.
End If

' Incrémentation de mes valeurs :
' i + 1 car c'est le compte de mes cases
i = i + 1

' Ipos + 2 car il y à un séparateur entre 2 cases
iPos = iPos + 2
Wend

' Redimension de ma Form
Resize i - 1

End Sub

' Fonction qui compte le nombre de cases de mon labyrinthe.
' Elle me permet d'adapter mon labyrinthe à toute les taille de tableau
Function LenCount() As Integer
Dim iPos As Integer
Dim iCount As Integer

' Initialisation de iPos
iPos = 1

' Tant que iPos est inférieur ou égal a la taille de la variable "Labi"
While iPos <= Len(Labi)

' Incrémente le compteur de 1 à chaque fois que ma routine rencontre un
' séparateur.

    If Mid(Labi, iPos, 1) = "%" Then
        iCount = iCount + 1
        End If

    If Mid(Labi, iPos, 1) = ";" Then
        iCount = iCount + 1
        End If

' Incrémentation d Ipos ( compteur de caractères )
iPos = iPos + 1
Wend

' Affectation de ma fonction à ma Variable de comptage
LenCount = iCount
End Function

' Cette fonction compte le nombres de cases d'une seul ligne.
' Elle me permet de pouvoir replacer mes controls au X correcte et
' ultérieurement de faire mon IA.
Function LenLine() As Integer
Dim iPos As Integer
Dim iCount As Integer

' Initialisation de iPos
iPos = 1

' Tant qu'on est pas à la fin de la ligne :
While Mid(Labi, iPos, 1) <> "%"

' Si on rencontre un séparateur : Incrémentation
    If Mid(Labi, iPos, 1) = ";" Then
        iCount = iCount + 1
        End If

' Incrémentation de iPos
iPos = iPos + 1
Wend

' Affection de ma Var + 1 ( en effet, il y a mon séparateur "%" qui
' n'a pas été compté ) à ma fonction
LenLine = iCount + 1
End Function

Sub Resize(i As Integer)

' Resizing Vertical
Me.Height = Lab(i).Top + Lab(i).Height + 500

' Resizing Horizontal
Me.Width = Lab(i).Left + Lab(i).Width + 200

End Sub

Sub CtrlInit(i As Integer)

' Chare un nouveau control
Load Lab(i)

' Réglage des propriétés de ce control
Lab(i).Stretch = True
Lab(i).Visible = True
End Sub

' Fonction de ma LibMod ( que je conseil dailleur au débutant une fois
' que je l'aurai mis à jour sur VBFrance )
Function Lire(File As String) As String

On Error GoTo Error

Dim Tout As String
Dim Texte As String

Open File For Input As #1
Line Input #1, Texte

Tout = Texte

    While Not EOF(1)
        Line Input #1, Texte
        Tout = Tout + vbNewLine + Texte
    Wend

Lire = Tout
Close #1

Exit Function

Error:
MsgBox Err.Description, vbInformation, "LibMod Erreur :"
Lire = "Erreur"
End Function

Conclusion :


Si vous trouver ds bugs, des mauvaises habitudes au niveau du code, des optimisations...
Ne noter pas sans commentaires SVP

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.