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
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.