Jeu la cible

Télécharger le projet
Commenter

Description

Bon !!! C'est un petit jeu, avec une cible qui se déplace sur le Form dont vous allez essayer de toucher avec des "Click".

La feuille du score est liée avec un fichier INI

Je vous mets le code mais télécharger le Zip est mieux

A bientôt pour un autre prog

Source / Exemple : 


Dim Score As Long
Dim Vie As Integer
Dim Level As Integer
Dim ControlLevel As Integer
Dim CheminFichierScore As String

Private Sub cmdDebut_Click()
Timer.Interval = 1000
Timer.Enabled = True
'Arret Clignotement de " GAME OVER"
    TimerGameOver.Enabled = False
'Réactivation de la zone d'affichage
    lblMessage.Enabled = True
Vie = 5
Score = 0
lblMessage = ""
' Affiche La Cible
    lblMauvais.Visible = True
    lblPassable.Visible = True
    lblBien.Visible = True
    lblTresBien.Visible = True
    TraitVertical.Visible = True
    TraitHorizontal.Visible = True
    
cmdPause.Enabled = True
cmdDebut.Enabled = False
Level = 1
ControlLevel = 0
End Sub

Private Sub cmdPause_Click()
If cmdPause.Caption = "&Pause" Then
    Timer.Enabled = False
' Cacher La Cible au début
    lblMauvais.Visible = False
    lblPassable.Visible = False
    lblBien.Visible = False
    lblTresBien.Visible = False
    TraitVertical.Visible = False
    TraitHorizontal.Visible = False
    
    cmdPause.Caption = "&Continuer"
Else
    Timer.Enabled = True
    
' Affiche La Cible
    lblMauvais.Visible = True
    lblPassable.Visible = True
    lblBien.Visible = True
    lblTresBien.Visible = True
    TraitVertical.Visible = True
    TraitHorizontal.Visible = True
    cmdPause.Caption = "&Pause"
End If
End Sub

Private Sub cmdQuitter_Click()
End
End Sub

Private Sub Form_Click()
If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Pause") Then
    Vie = Vie - 1
    Beep
    lblMessage.ForeColor = vbBlack
    lblMessage.Caption = "Hors de La Cible"
End If
End Sub

Private Sub Form_Load()
    TimerGameOver.Enabled = False
    Timer.Enabled = False
' Cacher La Cible au début
    lblMauvais.Visible = False
    lblPassable.Visible = False
    lblBien.Visible = False
    lblTresBien.Visible = False
    TraitVertical.Visible = False
    TraitHorizontal.Visible = False
    
    cmdPause.Enabled = False
    lblScore.Caption = "0"
    lblLevel.Caption = Level
    lblVie.Caption = "5"
    CheminFichierScore = App.Path & "\Score.ini"
End Sub

Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub Label4_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub lblBien_Click()
If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Pause") Then
    Score = Score + 200
    ControlLevel = ControlLevel + 200
    lblMessage.ForeColor = vbBlue
    lblMessage.Caption = "Bien Viser"
End If
End Sub

Private Sub lblMauvais_Click()
If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Pause") Then
    Score = Score + 50
    ControlLevel = ControlLevel + 50
    lblMessage.ForeColor = vbMagenta
    lblMessage.Caption = "Revoit tes Coups"
End If
End Sub

Private Sub lblPassable_Click()
If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Pause") Then
    Score = Score + 100
    ControlLevel = ControlLevel + 100
    lblMessage.ForeColor = vbCyan
    lblMessage.Caption = "Pas mal Viser"
End If
End Sub

Private Sub lblTresBien_Click()
If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Pause") Then
    Score = Score + 300
    ControlLevel = ControlLevel + 300
    lblMessage.ForeColor = vbGreen
    lblMessage.Caption = "Au coeur de La Cible"
End If
End Sub

Private Sub MenuAides_Aide_Click(Index As Integer)
MsgBox "Essayer d'atteindre le coeur de La Cible avec un Click Gauche" & vbCrLf _
    & "Vous allez obtenir des points de bonus" & vbCrLf & vbCrLf & "Bonne Chance" & vbCrLf _
    , vbOKOnly, "Aide " & frmCible.Caption
End Sub

Private Sub MenuAIdesAPropos_Click(Index As Integer)
frmApropos.Show
End Sub

Private Sub MenuQuitter_Click(Index As Integer)
End
End Sub

Private Sub MenuScore_Click(Index As Integer)
    If (cmdDebut.Enabled = True) Or (cmdPause.Caption = "&Continuer") Then
        frmScore.Show
    End If
End Sub

Private Sub Timer_Timer()
    Dim Hauteur As Integer
    Dim Largeur As Integer
'Déplacement de la Cible
    Randomize
        Hauteur = (Rnd * 4320)
        Largeur = (Rnd * 5640)
        lblMauvais.Top = Hauteur
        lblMauvais.Left = Largeur
        lblPassable.Top = Hauteur + 240
        lblPassable.Left = Largeur + 360
        lblBien.Top = Hauteur + 600
        lblBien.Left = Largeur + 720
        lblTresBien.Top = Hauteur + 840
        lblTresBien.Left = Largeur + 1080
        
'Trait Horizontal
        TraitVertical.X1 = Largeur
        TraitVertical.Y1 = Hauteur + 1080
        TraitVertical.X2 = Largeur + 3000
        TraitVertical.Y2 = Hauteur + 1080
        
 'Trait Vertical
        TraitHorizontal.X1 = Largeur + 1440
        TraitHorizontal.Y1 = Hauteur
        TraitHorizontal.X2 = Largeur + 1440
        TraitHorizontal.Y2 = Hauteur + 2160
        
' Pause si la fenêtre est réduite
    If frmCible.WindowState = 1 Then
        Timer.Enabled = False
        cmdPause.Caption = "&Continuer"
    End If
lblScore.Caption = Score
lblVie.Caption = Vie

If lblVie.Caption = "0" Then
    lblMessage.ForeColor = vbRed
    lblMessage.Caption = "GAME OVER"
    TimerGameOver.Enabled = True 'Active Clignotement " GAME OVER"
    cmdPause.Enabled = False
    cmdDebut.Enabled = True
    Timer.Enabled = False
' Cacher La Cible au début
    lblMauvais.Visible = False
    lblPassable.Visible = False
    lblBien.Visible = False
    lblTresBien.Visible = False
    TraitVertical.Visible = False
    TraitHorizontal.Visible = False
' Sauvegarde du Score
    If Score > Val(LitDansFichierScore("SCORES", "Score1", CheminFichierScore)) Then
                'Décalage du 2 eme Score vers la 3 eme
                WritePrivateProfileStringA "SCORES", "Nom3", LitDansFichierScore("SCORES", "Nom2", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score3", LitDansFichierScore("SCORES", "Score2", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level3", LitDansFichierScore("SCORES", "Level2", CheminFichierScore), CheminFichierScore
                
                'Décalage de l'ex 1 er Score vers la 2 eme
                WritePrivateProfileStringA "SCORES", "Nom2", LitDansFichierScore("SCORES", "Nom1", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score2", LitDansFichierScore("SCORES", "Score1", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level2", LitDansFichierScore("SCORES", "Level1", CheminFichierScore), CheminFichierScore
                
                'Ecriture du meilleur Score
                WritePrivateProfileStringA "SCORES", "Nom1", InputBox("Tapez votre Nom ", "Meilleur Score"), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score1", Score, CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level1", Level, CheminFichierScore
                
             ElseIf Score > Val(LitDansFichierScore("SCORES", "Score2", CheminFichierScore)) Then
                'Décalage du 2 eme Score vers la 3 eme
                WritePrivateProfileStringA "SCORES", "Nom3", LitDansFichierScore("SCORES", "Nom2", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score3", LitDansFichierScore("SCORES", "Score2", CheminFichierScore), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level3", LitDansFichierScore("SCORES", "Level2", CheminFichierScore), CheminFichierScore
                
                'Ecriture du 2 eme meilleur Score
                WritePrivateProfileStringA "SCORES", "Nom2", InputBox("Tapez votre Nom ", "2 eme Meilleur Score"), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score2", Score, CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level2", Level, CheminFichierScore
                
             ElseIf Score > Val(LitDansFichierScore("SCORES", "Score3", CheminFichierScore)) Then
                WritePrivateProfileStringA "SCORES", "Nom3", InputBox("Tapez votre Nom ", "3 eme Meilleur Score"), CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Score3", Score, CheminFichierScore
                WritePrivateProfileStringA "SCORES", "Level3", Level, CheminFichierScore
             
    End If ' Fin If Score >
End If ' Fin If lblVie.Caption = "0"

If ControlLevel >= 1000 Then
    Level = Level + 1
        Timer.Interval = Timer.Interval - 50
    ControlLevel = 0
End If

lblLevel.Caption = Level

End Sub

Private Sub TimerGameOver_Timer()
If lblMessage.Enabled = True Then
    lblMessage.Enabled = False
Else
    lblMessage.Enabled = True
End If
End Sub

' A ECRIRE DANS UN MODULE
'
'Ces codes  du module, sont de CECILE MUNO que je remercie
'
'
Option Explicit
' La fonction enregistrant une chaîne dans un fichier .INI,
' et retournant comme valeur zéro (alias Faux) ssi l'opération échoue :
  Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal paragraphe As String, ByVal variable As String, ByVal Valeur_de_la_variable As String, ByVal Fichierini As String) As Integer
  Declare Function sleepA Lib "kernel32" (ByVal milliseconde As Long)
  Public Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal valeur As String, ByVal nom_du_fichier As String) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
   (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
   (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Integer, _
   ByVal lpFileName As String) As Long
'----------------------------------------------------------------------
'

    
'Public Function EcritScore(Section As String, Nom As String, Score As Integer, Fichier As String) As Long
'    EcritScore = WritePrivateProfileString(Section, SousSection, Valeur, CheminFichier)
'End Function
Public Function LitDansFichierScore(Section As String, Cle As String, Fichier As String, _
    Optional ValeurParDefaut As String = "") As String
    Dim strReturn As String

    strReturn = String(255, 0)
    GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
    LitDansFichierScore = Left(strReturn, InStr(strReturn, Chr(0)) - 1)
End Function

Conclusion :


Je remercie CECILE MUNO pour le code que j'ai utilisé dans le module pour faire le fichier INI
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.