TRIOCOLOR JEU DE DOMINOS EN COULEURS (VB6)

Messages postés
373
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
17 juin 2013
- - Dernière réponse : philbar71
Messages postés
70
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
5 juillet 2013
- 10 août 2009 à 13:41
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/50309-triocolor-jeu-de-dominos-en-couleurs-vb6

philbar71
Messages postés
70
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
5 juillet 2013
-
Eh ben ! Quel travail !
Je suis effectivement très intéressé par ces propositions de modifications, fussent-elles mineures pour certaines. Mais, comme toi, je suis très attaché à tout ce qui peut être simplifié dans le code ou amélioré dans l'aspect de l'interface utilisateur.
De même il faut garder constamment à l'esprit que l'usage du programme doit être la plus transparente et instinctive possible. On sait très bien que l'utilisateur ne prend que rarement la peine de se pencher sur l'aide (qui décrit, entre autres, certaines astuces de jeu).
Je constate que tes modifications procèdent de la même démarche.
Je t'avais donné, en PV, mon adresse eMail pour que tu puisses entrer directement en contact avec moi. Je pense que tu l'auras notée.
Je souscris donc à ta proposition de me faire parvenir, par ce canal, tous les fichiers-sources que tu as modifié, ainsi que le document Word qui les décrit.
Merci d'y ajouter aussi ta propre version compilée.
Je réaliserai par la suite un nouveau zip que je posterai ici.

Merci pour cette collaboration qui s'annonce fructueuse.
Note : Je serai absent à partir de demain et jusqu'à vendredi soir (soit du 11 au 14 août).
Philbar
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Statut
Membre
Dernière intervention
19 avril 2016
-
Voici les principales corrections apportées ce jour.
Je ne cite pas la 1ère qui concerne le transfert des fichiers annexe (.ini, help, parties, images) dans des dossier séparés.

Corrections d’erreurs et Améliorations

2) Dans le dialogue d’ouverture d’une partie, ‘Annuler’ ne fonctionne pas
Ajout des lignes suivantes : (correction nécessaire)
a) Private Sub MenuOuvrePartie_Click()
‘ On Error Resume Next
On Error GoTo 9
Cmd2.DialogTitle = "Ouvrir une Partie enregistrée" InitialisePartieEnr
….
Cmd2.ShowOpen
' If Err = 32755 Then Exit Sub
Fich = Cmd2.FileName

b) InitialisePartieEnr
Exit Sub
9: If Err = 32755 Then On Error GoTo 0: Exit Sub
Msg = MsgBox(Str(Err) + " " + Error)
End Sub

3) correction du libellé de 'Ccercle.Caption' d'OptionsTrio
remplacer ‘Couleur du du cercle Ordi’ par ‘Couleur du cercle Ordi’
et donner à ce texte la couleur attribuée
ajout de :
Private Sub Ccercle_Click()
CmdCoul.Flags = &H3
CmdCoul.Color = CoulCercle
Ccercle.ForeColor = CoulCercle
CmdCoul.Action = 3
If Error = 32755 Then Exit SubIf Hex(CmdCoul.Color) "C0C0C0" Or CmdCoul.Color QBColor(3) Or _
CmdCoul.Color = 0 Then
Msg = MsgBox("Couleur interdite car réservée au programme." + cr + "faites un _
autre choix...", 48, "Contrôle de couleur")
Exit Sub
End If
CoulCercle = CmdCoul.Color
Ccercle.ForeColor = CoulCercle
If AvCercle And Not JoueurSeul And Ptx <> 0 Then

Dans Sub Form_Load() de BaseTrio
Entrée$ = Space$(255)
Ret& = GetPrivateProfileString("Couleurs", "CoulCercle", "", Entrée$, 255, Fichini)
cce$ = Left(Entrée$, Ret&)
‘ If cce$ <> "" Then CoulCercle = Val(cce$) If cce$ <> "" Then CoulCercle Val(cce$): OptionsTrio.Ccercle.ForeColor CoulCercle

4) correction de la 6ème couleur qui passe en VERT (non indispensable)
afin d’obtenir un contraste plus marqué entre le mauve et le lilas la ligne Coul(4) &HFF&: Coul(5) &HC00000:’ Coul(6) = &HC000C0 devient Coul(4) &HFF&: Coul(5) &HC00000: Coul(6) = &HFF00

5) correction sur l’Exit de la routine Sub InitialisePartieEnr() dans BASETRIO
pour effacer le ‘On Error GoTo T_Err2’, ajout de : (erreur mineure, mais correction nécessaire)
If Vpo Then PionsOrdin.Show
Fin: On Error GoTo 0: Exit Sub
T_Err2: Close
Traite_Erreur Fich
‘ Exit Sub
GoTo Fin
End Sub

6) Insertion d’une fonction ‘LireIni’ pour simplication d’écriture (non indispensable)
(mais gain en code et en taille EXE)
remplacer toutes les lignes faisant appel à ‘GetPrivateProfileString’ :
‘ entrée$=Space$(255)
‘ ret$ = GetPrivateProfileString(, "Options", "ParolePC", "", entrée$, 255, Fichini)
‘ AvP1= Left(entrée$, ret$)
If AvP1 <> "" Then AvPO = AvP1
par
AvP1=LireIni("Options", "ParolePC")
If AvP1 <> "" Then AvPO = AvP1

Et ajouter la fonction suivante, dans Module1 :
Public Function LireIni(ByVal Chapitre As String, ByVal Rubrique As String) As String
Dim e$, ret$: e$ = Space$(255)
ret$ = GetPrivateProfileString(Chapitre, Rubrique, "", e$, 255, Fichini)
LireIni = Left(e$, ret$)
End Function

Exemple dans Sub Form_Load()
…For i 1 To 6: cc$ "Couleur" + Trim(Str(i)) CoulEnr$ LireIni("Couleurs", cc$): If CoulEnr$ <> "" Then Coul(i) Val(CoulEnr$)
Next i
cfe$ = LireIni("Couleurs", "CoulFond")
If cfe$ <> "" Then
CoulFEcr = Val(cfe$)
BaseTrio.Picture = CoulFondTrio.FondEcran(CoulFEcr).Picture
End Ifcok$ LireIni("Couleurs", "CoulOk"): If cok$ <> "" Then OkCouleur cok$
cce$ = LireIni("Couleurs", "CoulCercle")If cce$ <> "" Then CoulCercle Val(cce$): OptionsTrio.Ccercle.ForeColor CoulCercleOpj LireIni("Options", "Jeu_à_un"): If Opj <> "" Then JoueurSeul Opj: Jr = OpjAvs LireIni("Options", "AvecSon"): If Avs <> "" Then AvSon AvsAvP1 LireIni("Options", "ParolePC"): If AvP1 <> "" Then AvPO AvP1Ctr1 LireIni("Options", "Triple_au_Début"): If Ctr1 <> "" Then CTr Ctr1Avc LireIni("Options", "Cerclage"): If Avc <> "" Then AvCercle AvcAve LireIni("Options", "SauvPlato"): If Ave <> "" Then AvEnr AveAvP LireIni("Options", "PressePap"): If AvP <> "" Then AvPP AvPAVJ1 LireIni("Options", "VoirJouable"): If AVJ1 <> "" Then AvJ AVJ1Azp LireIni("Options", "ZonePions"): If Azp <> "" Then Zpn Azp
MnuGdEcr = LireIni("Options", "PleinEcran")


7) pour info, utilisation de tableau (Array) (léger gain de code et de temps, non essentielle)
les lignes suivantes peuvent s’écrire comme les lignes qui suivront :
'Pions ci-dessous classés Doubles en bas
‘ LPions = "111,211,311,411,511,611,122,123,124,125,126,132,133,134,135,136,142,143,144,145,146,152,153,"
‘ LPions = LPions + "154,155,156,162,163,164,165,166,444,544,644,455,456,465,466,555,655,566,666,"
‘ LPions = LPions + "222,322,422,522,622,233,234,235,236,243,244,245,246,253,254,255,256,263,264,265,266,"
‘ LPions = LPions + "333,433,533,633,344,345,346,354,355,356,364,365,366"
‘ Pn(1) Left(LPions, 3): For i 1 To 75: Pn(i + 1) = Mid(LPions, 4 * i + 1, 3): Next i

Avec : Public Pn as Variant dans Module1, au lieu de Public Pn(76) as string * 3
Et suppression de 'Public LPions As String 'Liste des Pions

Pn = Array("0","111", "211", "311", "411", "511", "611", "122", "123", "124", "125", "126", "132", "133", "134", "135", "136", "142", "143", "144" _
,"145", "146", "152", "153", "154", "155", "156", "162", "163", "164", "165", "166", "444", "544", "644", "455", "456", "465", "466" _
, "555", "655", "566", "666", "222", "322", "422", "522", "622", "233", "234", "235", "236", "243", "244", "245", "246", "253", "254" _
, "255", "256", "263", "264", "265", "266", "333", "433", "533", "633", "344", "345", "346", "354", "355", "356", "364", "365", "366")

En cours d'application :
8) pour rappel des options enregistrées lors de parties antérieures (non essentielle)
ajout de l’affichage des options au démarrage
Private Sub Form_Activate()
If Not DebLance Then Exit Sub
If Deb Then
MenuPleinEcran.Checked = MnuGdEcr
If MenuPleinEcran.Checked Then BaseTrio.WindowState = 2: GrandEcran
End If
If Not OkCouleur Then AvertisCoul.Show 1
DebLance = False: Distribue_Click: MenuTypeJeu_Click
End Sub
Reste à faire la restauration du fichier ini

9) pour assistance débutant, ajout d'une option dans OptionsTrio (non essentielle)

[Voir le pion jouable] bouton Check dans OptionsTrio

a) Avec ajout dans Module1
Public AvJ As Boolean 'Option voir Pion Jouable
Public AVJ1 As String 'Option Pion jouable pour ProfileString

b) Pour enregistrer son action, ajout dans code d'OptionsTrio :
b1) en Sub Form_Load() : If AvJ Then VoirPionJouable True Else VoirPionJouable False

b2) en Sub OKButton_Click() AvJ VoirPionJouable.Value: AVJ1 Str(AvJ)
Ret& = WritePrivateProfileString("Options", "VoirJouable", AVJ1, Fichini)

c) Pour la lecture du Fichini, ajout dans code de BaseTrio :
c1) en Sub Form_Load() :
AVJ1 = LireIni ("Options", "VoirJouable", Fichini)
If AVJ1 <> "" Then AvJ = AVJ1

d) Pour son fonctionnement, dans BaseTrio,
création d’une routine d’affichage du carré sélecteur de pion :
Private Sub VoirCarré(ByVal x As Integer, ByVal Coulor As Double) Shape.Left Pion(x).Left - 2: Shape.Top Pion(x).Top - 2 Shape.BorderColor Coulor: Shape.Visible True
End Sub
avec modification dans les routines suivantes :
Private Sub Pion_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 1 And Pj(Index) > 0 Then ' Shape.Left Pion(Index).Left - 2: Shape.Top Pion(Index).Top - 2
' Shape.BorderColor = Rouge
' Shape.Visible = True
VoirCarré Index, Rouge

Private Sub Passer_Click()

Pion(k).ToolTipText = " " & Pion(k).ToolTipText & Tsup$ ' Shape.Left Pion(k).Left - 2: Shape.Top Pion(k).Top - 2
' Shape.BorderColor = Bleu
' Shape.Visible = True
VoirCarré k, Bleu
Exit For 'Nouveau Pion Joueur
End If

Private Sub ControleJoueur()

ContrôleCouleurs
If Not MalPlacé Then
Ptrouvé = Pjoué : If AvJ Then VoirCarré i, Vert
DialogOrdin.Caption = "Vous avez au moins" + Cr + "1 pion jouable"


10) pour voir l’utilisation possible du pion en Reprise, ajout de rotation du pion
La picture ‘ImgReprise’ est dupliquée dans la Form de de RepriseTrio.
On obtient donc ImgReprise(0) (pointe en haut) et ImgReprise(1) avec pointe en bas
Le code devient :
Dim Fcoul(3), Im
Private Sub AnnulReprise_Click()
REnCours = False: BaseTrio.PlatoCoplato: Unload Me
End Sub
Private Sub Form_Load() For Im 0 To 1: ImgReprise(Im).Top 6: ImgReprise(Im).Left = 12: ImgReprise(Im).Visible = False: Next Im 0: ImgReprise(Im).Visible True ' set 1ère picture et mémorise les 3 couleurs Fcoul(1) Coul(Val(Mid(Pnrc, 1, 1))): Fcoul(2) Coul(Val(Mid(Pnrc, 2, 1))): Fcoul(3) = Coul(Val(Mid(Pnrc, 3, 1)))
xl = BaseTrio.Left / XTw + BaseTrio.Plato.Left / 3 - 3
yl = BaseTrio.Top / YTw + BaseTrio.Plato.Top * 10 Fw (RepriseTrio.ScaleWidth) + 6: Fh (RepriseTrio.ScaleHeight) + 26
SetWindowPos hwnd, conHwndTopmost, xl, yl, Fw, Fh, conSwpNoActivate Or conSwpShowWindow REnCours True: BaseTrio.AnnulCoup.Visible False X1 (ImgReprise(Im).Width / 2): Y1 (ImgReprise(Im).Height / 3)
ImgReprise(Im).FillColor = Fcoul(1): FloodFill ImgReprise(Im).hdc, X1, Y1, 0 X1 (ImgReprise(Im).Width / 3): Y1 (ImgReprise(Im).Height * 3 / 4)
ImgReprise(Im).FillColor = Fcoul(2): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
X1 = (ImgReprise(Im).Width * 2 / 3)
ImgReprise(Im).FillColor = Fcoul(3): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
End Sub

Private Sub ImgReprise_Click(index As Integer) Fcoul(0) Fcoul(1): Fcoul(1) Fcoul(3): Fcoul(3) = Fcoul(2): Fcoul(2) = Fcoul(0) 'Rotation couleurs ImgReprise(Im).Visible False: Im (index + 1) Mod 2: ImgReprise(Im).Visible = True 'bascule picture

X1 = BaseTrio.Left / XTw + BaseTrio.Plato.Left / 3 - 3
yl = BaseTrio.Top / YTw + BaseTrio.Plato.Top * 10 'pas de regénération Fw et de Fh
SetWindowPos hwnd, conHwndTopmost, xl, yl, Fw, Fh, conSwpNoActivate Or conSwpShowWindow
If Im = 0 Then X1 (ImgReprise(Im).Width / 2): Y1 (ImgReprise(Im).Height / 3) ' image pointe en haut
ImgReprise(Im).FillColor = Fcoul(1): FloodFill ImgReprise(Im).hdc, X1, Y1, 0 X1 (ImgReprise(Im).Width / 3): Y1 (ImgReprise(Im).Height * 3 / 4)
ImgReprise(Im).FillColor = Fcoul(2): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
X1 = (ImgReprise(Im).Width * 2 / 3)
ImgReprise(Im).FillColor = Fcoul(3): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
Else X1 (ImgReprise(Im).Width / 2): Y1 (ImgReprise(Im).Height * 2 / 3) ' image pointe en bas
ImgReprise(Im).FillColor = Fcoul(2): FloodFill ImgReprise(Im).hdc, X1, Y1, 0 X1 (ImgReprise(Im).Width / 3): Y1 (ImgReprise(Im).Height / 4)
ImgReprise(Im).FillColor = Fcoul(1): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
X1 = (ImgReprise(Im).Width * 2 / 3)
ImgReprise(Im).FillColor = Fcoul(3): FloodFill ImgReprise(Im).hdc, X1, Y1, 0
End If
End Sub

Il reste à voir … ce qu'il y aura à trouver.

j'ai un document (Word) récapitulant ce texte et aussi une version modifiée de TrioColor, à ta disposition.
Babu
philbar71
Messages postés
70
Date d'inscription
samedi 1 juin 2002
Statut
Membre
Dernière intervention
5 juillet 2013
-
Bonjour BABUDROME,
Merci pour ton commentaire et l'intérêt que tu portes à ce jeu et tes recherches d'amélioration du code.
Pour le SStab c'est un contrôle pourtant basique en VB6.
Je te fais un petit mot en PV pour un contact direct.
Philbar
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Statut
Membre
Dernière intervention
19 avril 2016
-
Bravo!
J'ai toutefois corrigé quelques erreurs mineures, amélioré certains points, ajouté une option marquant le point à jouer (pour débutant).
Je suis prêt à te communiquer un document explicitant ces modifications.
Par contre, je n'ai pas d'affichage des scores (?) et n'ai pas de connaissance d'un SStab. comment ça marche ?
Babu
cs_PapyJo
Messages postés
17
Date d'inscription
dimanche 26 janvier 2003
Statut
Membre
Dernière intervention
17 juillet 2006
-
Désolé d'avoir posé cette question idiote.
En effet j'ai remèdié à la chose et je vais de ce
pas essayer ce jeu qui me semble très bien fait

PapyJo