Un petit jeu moin simple qu'il en a l'air
Publié : lun. 27/avr./2020 9:40
Bonjour a tous
Un petit jeu de Pousse-pousse.
Amusez vous bien.
Un petit jeu de Pousse-pousse.
Amusez vous bien.
Code : Tout sélectionner
;¤¤¤ Jeu Pousse-pousse MLD 26/04/2020: Droits libre. ¤¤¤¤¤
;¤¤¤ Compilation PB 5.72 X86 ¤¤¤¤¤
#Fp = 1:#contner = 2:#txtinfo = 3
#txtP1 = 10:#txtP2 = 11:#txtP3 = 12:#txtP4 = 13:#txtP5 = 14:#txtP6 = 15:#txtP7 = 16:#txtP8 = 17:#txtP9 = 18:#txtP10 = 19
#txtP11 = 20:#txtP12 = 21:#txtP13 = 22:#txtP14 = 23:#txtP15 = 24:#txtP16 = 25:#txtP17 = 26:#txtP18 = 27:#txtP19 = 28:#txtP20 = 29
#txtP21 = 30:#txtP22 = 31:#txtP23 = 32:#txtP24 = 33:#txtP25 = 34:#txtP26 = 35:#txtP27 = 36:#txtP28 = 37
#txtbtinf = 40:#txtbtscr = 41:#txtbtnj = 42:#txtbtstop = 43:#txtchronos = 44:#txttemps = 45
#tim1 = 100:#fchscor = 110
#Fj= 60:#txttitre = 61:#txtnom = 62:#stringn = 63:#btjeu = 64:#btraz = 65:#btretour = 66:#editor = 67:#list = 68
Global FontID2 = LoadFont(301,"Comic sans MS",14,#PB_Font_Italic)
Global FontID3 = LoadFont(302,"Comic sans MS",12,#PB_Font_Italic)
Global FontID4 = LoadFont(303,"Arial",12)
Global dpj = 0, nj$
Macro Coul(g,coulf,coult)
SetGadgetColor(g,#PB_Gadget_BackColor,coulf):SetGadgetColor(g,#PB_Gadget_FrontColor,coult)
EndMacro
Procedure prereq();init
Global X =0,Y = 0,larg = 100,haut = 100,ngcd =10,ngcm = 37,nbchz = 7,nbcv = 4,fc = 65,hl = 70
EndProcedure
Procedure Forme()
Region = CreateRoundRectRgn_(1, 0, WindowWidth(1), WindowHeight(1), 40, 60)
SetWindowRgn_(WindowID(1), Region,1):DeleteObject_(Region)
EndProcedure
Procedure WindowCallback(WindowID,message,wParam,lParam)
res=#PB_ProcessPureBasicEvents
Select message
Case #WM_PAINT
Forme()
EndSelect
ProcedureReturn res
EndProcedure
Procedure affc()
Global Dim Tposcor((ngcm -ngcd)+1,3)
Global Dim Tposc((ngcm -ngcd)+1,4)
Global FontID1 = LoadFont(300,"Arial",hl)
lig = 0
For z = ngcd To (ngcm - ngcd)+9
lig = lig + 1
If lig = nbchz +1:Y = Y + haut +1:X = 0:lig = 1:EndIf
Tposcor(z-9,1)= z:Tposcor(z-9,2)= X:Tposcor(z-9,3)= Y
If z = 36 :fc = 33:EndIf
Tposc(z-9,1)= z:Tposc(z-9,2)= X:Tposc(z-9,3)= Y:Tposc(z-9,4)= fc
X =X +larg +1 :fc = fc +1
Next
TextGadget(z,X,Y,larg,haut,"")
Coul(z,$00A5FF,$0)
For c = 1 To (ngcm - ngcd)
TextGadget(Tposc(c,1),Tposc(c,2),Tposc(c,3),larg,haut,"",#PB_Text_Center|#SS_CENTERIMAGE | #WS_DLGFRAME|#SS_NOTIFY)
SetGadgetFont(Tposc(c,1),FontID1):Coul(Tposc(c,1),$0B86B8,$FF0000)
Next
EndProcedure
Procedure brasse()
If dpj = 1
For i = (ngcm - ngcd) To 1 Step-1
irnd = Random(27,1)
Swap Tposc(i,1),Tposc(irnd,1)
Swap Tposc(i,4),Tposc(irnd,4)
Next
EndIf
For zz = 1 To (ngcm - ngcd)
ResizeGadget(Tposc(zz,1),Tposc(zz,2),Tposc(zz,3),#PB_Ignore,#PB_Ignore)
SetGadgetText(Tposc(zz,1),Chr(Tposc(zz,4)))
Next
EndProcedure
Procedure Gscor(fj)
l = 0
Global Dim Tsc.s(0)
OpenFile(110, GetTemporaryDirectory() + "PPscor")
While Eof(110) = 0
l = l + 1:ReDim Tsc.s(l)
Tsc.s(l) = ReadString(110)
Wend
CloseFile(110)
SortArray(Tsc.s(),#PB_Sort_NoCase)
If fj = 1
SetGadgetText(3,"Bravo! " + " Champion actuel " + StringField(Tsc.s(1),2,"*") + " " +StringField(Tsc.s(1),1,"*"))
EndIf
EndProcedure
Procedure control()
pt = 0
For zz = ngcd To ngcm
If GadgetX(zz) = Tposcor(zz-9,2) And GadgetY(zz) = Tposcor(zz-9,3)
pt = pt + 1
Else
Break
EndIf
Next
If pt = (ngcm -ngcd)
dpj = 0
enrsc$ = GetGadgetText(45) + " " + "*" + nj$ + "*" + " le " + FormatDate("%dd/%mm/%YYYY",Date())+ "*"
OpenFile(110, GetTemporaryDirectory() + "PPscor")
FileSeek(110, Lof(110)):WriteStringN(110,enrsc$)
CloseFile(110)
Gscor(1)
EndIf
EndProcedure
Procedure chrono()
Static s,m,h
s +1
If s > 59:s = 0:m = m + 1:EndIf
If m > 59:m = 0:h = h + 1:EndIf
If h > 24:h = 0:EndIf
If dpj = 0:s=0:m = 0:h = 0:EndIf
If h < 10: h$ = "0" + Str(h):Else:h$ = Str(h):EndIf
If m < 10: m$ = "0" + Str(m):Else:m$ = Str(m):EndIf
If s < 10: s$ = "0" + Str(s):Else:s$ = Str(s):EndIf
SetGadgetText(45,"h " + h$ +" m "+ m$ + " s "+ s$)
EndProcedure
Procedure nj(n)
StickyWindow(1,0)
OpenWindow(60,WindowX(1)+ ((WindowWidth(1)- 350)/2),WindowY(1)+ ((WindowHeight(1)- 350)/2),350,180,"",#PB_Window_BorderLess|#NUL)
SetWindowColor(60,$AFB74C)
SetWindowLongPtr_(WindowID(60),#GWL_HWNDPARENT,FindWindow_(0,"program manager"))
SetWindowLongPtr_(WindowID(60), #GWL_STYLE, GetWindowLongPtr_(WindowID(60), #GWL_STYLE) | #WS_DLGFRAME)
SetWindowPos_(WindowID(60), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
StickyWindow(60,1)
TextGadget(61,10,10,325,27,"",#PB_Text_Center);titre
SetGadgetFont(61,FontID2):Coul(61,$AFB74C,$00FFFF)
ButtonGadget(66,260,145,80,25,"Retour")
If n =1
SetGadgetText(61,"Nouveau jeu")
TextGadget(62,40,60,70,27,"Joueur:")
SetGadgetFont(62,FontID2):Coul(62,$AFB74C,$CD0000)
StringGadget(63,130,60,180,30,nj$)
SetGadgetFont(63,FontID2):Coul(63,$AFB74C,$CD0000):SetActiveGadget(63)
SetGadgetAttribute(63,#PB_String_MaximumLength,9)
ButtonGadget(64,179,145,80,25,"Lance le Jeu")
EndIf
If n = 2
SetGadgetText(61,"Scores")
ListViewGadget(68,10,40,325,100)
SetGadgetFont(68,FontID4):Coul(68,$008000,$FFFFFF)
For tb = 1 To ArraySize(Tsc.s())
AddGadgetItem(68,-1,RemoveString(Tsc.s(tb),"*"))
Next
EndIf
If n =3
SetGadgetText(61,"Informations")
EditorGadget(67,20,40,305,100,#PB_Editor_ReadOnly|#PB_Editor_WordWrap)
Coul(67,$008000,$FFFFFF)
a1$ = "Bonjour" + #CRLF$ + "Ce jeu connu sous le nom de Pousse-pousse, consiste a remettre l'alphabet dans l'ordre." + #CRLF$
a2$ = "Un clique de souris déplace la case en lieu et place de la case vide." + #CRLF$ + "Le plus rapide est le champion."
AddGadgetItem(67,-1, a1$ + a2$)
EndIf
EndProcedure
hwnd= OpenWindow(1,0,0,806,503,"x",#PB_Window_BorderLess | #PB_Window_ScreenCentered)
SetWindowCallback(@WindowCallback())
StickyWindow(1,1)
SetWindowColor(1,$00A5FF)
prereq()
ContainerGadget(2,(WindowWidth(1)-706)/2,(WindowHeight(1)-403)/2,706,403,#PB_Container_Double)
SetGadgetColor(2,#PB_Gadget_BackColor,$1E69D2)
affc()
CloseGadgetList()
brasse()
TextGadget(3,330,467,430,27,"",#PB_Text_Center)
SetGadgetFont(3,FontID3):Coul(3,$00A5FF,$008000)
TextGadget(40,100,10,125,27, "Informations",#SS_NOTIFY)
SetGadgetFont(40,FontID2):Coul(40,$00A5FF,$0)
TextGadget(41,310,10,100,27, "Scores",#SS_NOTIFY)
SetGadgetFont(41,FontID2):Coul(41,$00A5FF,$0)
TextGadget(42,460,10,140,27, "Nouveau jeu",#SS_NOTIFY)
SetGadgetFont(42,FontID2):Coul(42,$00A5FF,$0)
TextGadget(43,660,10,100,27, "Stop",#SS_NOTIFY)
SetGadgetFont(43,FontID2):Coul(43,$00A5FF,$0)
TextGadget(44,50,465,120,27,"Chronomètre")
SetGadgetFont(44,FontID2):Coul(44,$00A5FF,$1EDBFF)
SetGadgetFont(43,FontID2):Coul(43,$00A5FF,$0)
TextGadget(45,180,465,150,27,"")
SetGadgetFont(45,FontID2):Coul(45,$00A5FF,$1EDBFF)
AddWindowTimer(1,100,1)
Gscor(0)
Repeat
Evenement = WindowEvent()
If dpj = 1
ms = ElapsedMilliseconds() - tref
If ms > 999:ms = 0:tref = ElapsedMilliseconds(): s = s + 1:chrono():EndIf
EndIf
If Evenement = #PB_Event_Timer And EventTimer() = 100
cvx = GadgetX(ngcm):cvy = GadgetY(ngcm)
EndIf
Select EventWindow()
Case 1
If GetActiveWindow() <> 60
If Evenement = #WM_LBUTTONDOWN
SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
EndIf
If Evenement = #PB_Event_Gadget
Select EventGadget()
Case 10 To ngcm -1
If dpj = 1 ;****** a virer pour teste
top = 0
cx = GadgetX(EventGadget())
cy = GadgetY(EventGadget())
If cvx - cx =101 And cvy - cy = 0:top =1:EndIf
If cvx - cx = -101 And cvy - cy = 0:top =1:EndIf
If cvx - cx = 0 And cvy - cy = 101:top =1:EndIf
If cvx - cx = 0 And cvy - cy = -101:top =1:EndIf
If top = 1
Swap cvx,cx:Swap cvy,cy
ResizeGadget(ngcm,cvx,cvy,#PB_Ignore,#PB_Ignore)
ResizeGadget(EventGadget(),cx,cy,#PB_Ignore,#PB_Ignore)
EndIf
control()
EndIf
Case 40 ;infos
nj(3)
Case 41 ;scores
nj(2)
Case 42;nj
dpj = 0:SetGadgetText(3,""):chrono():nj(1)
Case 43
Evenement = #PB_Event_CloseWindow ; On quitte
Break
EndSelect
EndIf
Case 60;2emf
If Evenement = #PB_Event_Gadget
Select EventGadget()
Case 64
dpj = 1:brasse()
If GetGadgetText(63)<> ""
nj$ = GetGadgetText(63)
Else
nj$ = "Anonyme"
EndIf
SetGadgetText(63,nj$)
CloseWindow(60)
StickyWindow(1,1)
Case 66
CloseWindow(60)
StickyWindow(1,1)
EndSelect
EndIf
EndSelect
ForEver
FreeArray(Tposcor()):FreeArray(Tposc()):FreeArray(Tsc.s())
End
Excellent. Merci du partage MLD. J'en avais commencer un il y a quelques années. 
Comme beaucoup de projets, j'ai laissé de coté 
Mais même si sur mon ordi, je n'est jamais eu ce bug, a partir du moment ou certains ont eu le problème il ne faut pas hésiter. 
Oui, mais on oublie souvent que le répertoire "courant" n'est pas nécessairement le répertoire où l'application se lance. Le système (Win ou Linux) ne fait pas un "CD <rep>" avant de lancer un programme. C'est l'OS qui gère car il travaille en interne avec le chemin complet.
Le plus sûr est donc d'utiliser les variables utilisateurs avec GetUserDirectory() sauf quand on veut faire des programmes à utiliser en mode portable.