LABYRINTHE VIEWER

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

Télécharger le zip

02 mars 2005 08:58:42 :

MAJ Mineurs