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