Code:
'Fifteen by Jim Klutho
' PB 8.04
#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"
'--------Constants-----------------------
%IDM_FILE_EXIT = 1001
%IDM_FILE_NEW = 1002
%IDC_FIFTEEN = 1000
'--------Types--------------------------
TYPE Square
theLabel AS STRING * 2
theColor AS LONG
theBackGround AS LONG
END TYPE
'--------Globals------------------------
GLOBAL s() AS Square
GLOBAL b() AS LONG
GLOBAL lpPoint AS POINTAPI
GLOBAL hMenu AS DWORD
GLOBAL hDlg AS LONG
GLOBAL hBoard AS LONG
'--------Declares------------------------
DECLARE SUB FifteenRedraw
DECLARE SUB InitGame
DECLARE SUB MakeRandomBoard
'--------Functions-----------------------
SUB InitGame
LOCAL countx AS LONG
LOCAL county AS LONG
LOCAL mycount AS LONG
REDIM s(15) AS square
REDIM b(3,3)
FOR countx=0 TO 15
IF countx=0 THEN
s(countx).theLabel=""
ELSE
s(countx).theLabel=FORMAT$(countx)
END IF
IF countx = 0 THEN
s(countx).theColor=%WHITE
s(countx).theBackGround=%WHITE
ELSEIF countx MOD 2 THEN
s(countx).theColor=%BLACK
s(countx).theBackGround=%WHITE
ELSE
s(countx).theColor=%GREEN
s(countx).theBackGround=%WHITE
END IF
NEXT countx
mycount=1
FOR county=0 TO 3
FOR countx = 0 TO 3
b(countx,county)=mycount
INCR mycount
NEXT countx
NEXT county
b(3,3)=0
END SUB
SUB MakeRandomBoard
LOCAL direction AS LONG
LOCAL countx AS LONG
LOCAL county AS LONG
LOCAL x AS LONG
'random 1 is up, 2 is down, 3 is right, 4 is left
FOR x = 1 TO 1000
direction = RND(1, 4)
FOR county= 0 TO 3
FOR countx = 0 TO 3
IF b(countx,county)= 0 THEN
IF direction = 1 AND county <> 0 THEN SWAP b(countx,county),b(countx,county - 1)
IF direction = 2 AND county <> 3 THEN SWAP b(countx,county),b(countx,county + 1)
IF direction = 3 AND countx <> 3 THEN SWAP b(countx,county),b(countx + 1,county)
IF direction = 4 AND countx <> 0 THEN SWAP b(countx,county),b(countx - 1,county)
END IF
NEXT countx
NEXT county
NEXT x
END SUB
CALLBACK FUNCTION ShowFifteenProc()
LOCAL Result AS LONG
LOCAL countx AS LONG
LOCAL county AS LONG
LOCAL mycount AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_FIFTEEN
'%STN_CLICKED or %STN_DBLCLK assumed
Result=GetCursorPos (lpPoint)
Result=ScreenToClient (CBHNDL,lpPoint)
IF Result <> 0 THEN
countx=lpPoint.x\125
county=lpPoint.y\125
END IF
IF b(countx,county)=0 THEN
BEEP
ELSE
'check for blank to the right
IF countx <> 3 THEN 'check for out of bounds
IF b(countx + 1,county)=0 THEN SWAP b(countx + 1,county),b(countx,county): FifteenRedraw : GOTO checkdone
END IF
'check for blank to the left
IF countx <> 0 THEN 'check for out of bounds
IF b(countx - 1,county)=0 THEN SWAP b(countx - 1,county),b(countx,county): FifteenRedraw : GOTO checkdone
END IF
'check for blank down
IF county <> 3 THEN 'check for out of bounds
IF b(countx,county + 1)=0 THEN SWAP b(countx,county + 1),b(countx,county): FifteenRedraw : GOTO checkdone
END IF
'check for blank up
IF county <> 0 THEN 'check for out of bounds
IF b(countx,county - 1)=0 THEN SWAP b(countx ,county - 1),b(countx,county): FifteenRedraw : GOTO checkdone
END IF
END IF
checkdone:
CASE %IDM_FILE_NEW
InitGame
MakeRandomBoard
FifteenRedraw
CASE %IDM_FILE_EXIT
DIALOG END CBHNDL , 0
END SELECT
END SELECT
END FUNCTION
SUB FifteenRedraw
LOCAL countx AS LONG
LOCAL county AS LONG
LOCAL mycolor AS LONG
LOCAL offset AS LONG
GRAPHIC CLEAR %WHITE
GRAPHIC COLOR %BLACK, %WHITE
GRAPHIC BOX (0, 0) - (500, 500)
GRAPHIC LINE (125, 0) - (125, 500)
GRAPHIC LINE (250, 0) - (250, 500)
GRAPHIC LINE (375, 0) - (375, 500)
GRAPHIC LINE (0, 125) - (500, 125)
GRAPHIC LINE (0, 250) - (500, 250)
GRAPHIC LINE (0, 375) - (500, 375)
GRAPHIC FONT "Times New Roman", 36, 0
FOR county=0 TO 3
FOR countx = 0 TO 3
IF b(countx,county) < 10 THEN offset = 20 ELSE offset = 5
GRAPHIC COLOR s(b(countx,county)).theColor, s(b(countx,county)).theBackGround
GRAPHIC SET POS (125 * countx + 30 + offset, 125 * county + 35 )
GRAPHIC PRINT s(b(countx,county)).theLabel
NEXT countx
NEXT county
GRAPHIC REDRAW
END SUB
FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
LOCAL hPopUp1 AS DWORD
MENU NEW BAR TO hMenu
MENU NEW POPUP TO hPopUp1
MENU ADD POPUP, hMenu, "File", hPopUp1, %MF_ENABLED
MENU ADD STRING, hPopUp1, "New", %IDM_FILE_NEW, %MF_ENABLED
MENU ADD STRING, hPopUp1, "-", 0, 0
MENU ADD STRING, hPopUp1, "Exit", %IDM_FILE_EXIT, %MF_ENABLED
MENU ATTACH hMenu, hDlg
FUNCTION = hMenu
END FUNCTION
FUNCTION ShowFifteen(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
DIALOG NEW PIXELS, hParent, "Fifteen Puzzle", 70, 70, 510, 525, TO hDlg
CONTROL ADD GRAPHIC, hDlg, %IDC_FIFTEEN, "", 5, 0, 500, 500, %SS_NOTIFY
CONTROL HANDLE hDlg,%IDC_FIFTEEN TO hBoard
GRAPHIC ATTACH hDlg, %IDC_FIFTEEN, REDRAW
AttachMENU1 hDlg
InitGame
MakeRandomBoard
FifteenRedraw
DIALOG SHOW MODAL hDlg, CALL ShowFifteenProc TO lRslt
FUNCTION = lRslt
END FUNCTION
FUNCTION PBMAIN()
ShowFifteen %HWND_DESKTOP
END FUNCTION