Puzzle games :
Posted: Fri Oct 03, 2003 10:47 am
This is my first post in box, hope you like ?
your work is get:
and add some feature for it 
your work is get:
Code: Select all
;fill Const auto
Enumeration
#idwindow
#idnew
#idexit
#idabout
#idmenu
#idredo
#idundo
#idframe
EndEnumeration
;VAR
watr = #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible
Dim idbutton.l(3,3)
Dim gridmark.l(3,3)
;PROCEDURES
Procedure newpuzzle()
For i = 0 To 3
For j = 0 To 3
gridmark(i,j) = i*4+j+1
HideGadget(idbutton(i,j),#FALSE)
Next
Next
i.l=3
j.l=3
While i >=1
While j >=1
ui = Random(i-1)
uj = Random(j-1)
k = gridmark(i,j)
gridmark(i,j) = gridmark(ui,uj)
gridmark(ui,uj) = k
j = j - 1
Wend
i = i - 1
Wend
For i=0 To 3
For j=0 To 3
If gridmark(i,j) = 16
m = i
n = j
EndIf
SetGadgetText(idbutton(i,j),Str(gridmark(i,j)))
Next
Next
gridmark(m,n) = 0
HideGadget(idbutton(m,n),#TRUE)
EndProcedure
;;;
Procedure.l checkpuzzled()
Dim check(4*4)
For i = 0 To 3
For j= 0 To 3
check(4*i+j) = gridmark(i,j)
Next
Next
For i = 0 To 4*4-3
If check(i) > check(i+1)
ProcedureReturn 0
EndIf
Next
ProcedureReturn 1
EndProcedure
;;;
Procedure About()
MessageRequester("About","For 'learn' typing Redo Ctrl+Y :)" + Chr(13)+Chr(10)+"Learner: sec",#MB_OK)
EndProcedure
;ENDPROCEDURES
;MAIN PROGRAM
If OpenWindow(idwindow,0,0,300,350,watr,"Puzzle") And CreateGadgetList(WindowID()) And CreateMenu(#idmenu,WindowID())
Frame3DGadget(#idframe,0,0,300,328,"")
MenuTitle("&File")
MenuItem(#idnew,"New Puzzle" + Chr(9) + "F2")
MenuBar()
MenuItem(#idexit,"Exit" + Chr(9) + "Alt+X")
MenuTitle("&Un/Redo")
MenuItem(#idundo,"Undo" + Chr(9) + "Ctrl+Z")
MenuItem(#idredo,"Redo" + Chr(9) + "Ctrl+Y")
MenuTitle("&Help")
MenuItem(#idabout,"About")
;some button
For i = 0 To 3
For j = 0 To 3
idbutton(i,j) = i*4+j+8
; gridmark(i,j) = i*4+j+1
ButtonGadget(idbutton(i,j),j*(75),i*(80)+6,75,80,"");Str(gridmark(i,j)))
Next j
Next i
; gridmark(3,3) = 0
; HideGadget(idbutton(3,3),#TRUE)
newpuzzle()
HideWindow(idwindow,#FALSE)
Repeat
wmevent = WaitWindowEvent()
Select wmevent
Case #PB_Event_CloseWindow
quit = 1
Case #PB_Event_Menu
Select EventMenuID()
Case #idnew
newpuzzle()
Case #idexit
quit = 1
Case #idundo
Case #idredo
Case #idabout
About()
EndSelect
Case #PB_Event_Gadget
; If EventType() = #PB_EventType_LeftClick
ev = EventGadgetID()
bi = -1
bj = -1
For i = 0 To 3
For j = 0 To 3
If idbutton(i,j) = ev
bi = i
bj = j
i = 3
Break
EndIf
Next j
Next i
If (bi > -1) And (bj > -1)
ai = -1
aj = -1
If (bi > 0) And (gridmark(bi-1,bj) = 0)
ai = bi - 1
aj = bj
ElseIf (bi<3) And (gridmark(bi+1,bj) = 0)
ai = bi + 1
aj = bj
ElseIf (bj>0) And (gridmark(bi,bj-1) = 0)
ai = bi
aj = bj-1
ElseIf (bj<3) And (gridmark(bi,bj+1) =0)
ai = bi
aj = bj+1
EndIf
If (ai > -1) And (aj > -1)
gridmark(ai,aj) = gridmark(bi,bj)
gridmark(bi,bj) = 0
HideGadget(idbutton(bi,bj),#TRUE)
HideGadget(idbutton(ai,aj),#FALSE)
SetGadgetText(idbutton(ai,aj),Str(gridmark(ai,aj)))
EndIf
EndIf
If checkpuzzled() = 1
MessageRequester("Finish!","Well done.",#MB_OK)
newpuzzle()
EndIf
; EndIf
EndSelect
Until quit = 1
EndIf
;MessageRequester("Goodbye!","See you later",#MB_OK)
End