Menu
▾
▴
win32forth-cvs
|
From: Rod O. <rod...@us...> - 2005-10-03 22:04:42
|
Update of /cvsroot/win32forth/win32forth/apps/Sudoku In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1760/apps/Sudoku Added Files: Applause7.wav Sudoku.f Sudoku.fpj SudokuDialogs.f SudokuMenu.f SudokuPrinting.f SudokuResources.f SudokuStatusBar.f SudokuToolbar.f Log Message: Rod: added files for Sudoku game --- NEW FILE: SudokuResources.f --- \ SudokuResources.f Script for adding the resources into Sudoku.exe \ September 2005 Rod Oakford Needs Resources.f winver winnt4 >= [if] s" Sudoku.exe" AddToFile 101 s" res\Sudoku.ico" "path-file drop AddIcon 142 s" res\arrow_m0.cur" "path-file drop AddCursor 143 s" res\arrow_m1.cur" "path-file drop AddCursor 144 s" res\arrow_m2.cur" "path-file drop AddCursor 145 s" res\arrow_m3.cur" "path-file drop AddCursor 146 s" res\arrow_m4.cur" "path-file drop AddCursor 147 s" res\arrow_m5.cur" "path-file drop AddCursor 148 s" res\arrow_m6.cur" "path-file drop AddCursor 149 s" res\arrow_m7.cur" "path-file drop AddCursor 150 s" res\arrow_m8.cur" "path-file drop AddCursor 151 s" res\arrow_m9.cur" "path-file drop AddCursor false EndUpdate \ UpdateFile [THEN] --- NEW FILE: SudokuMenu.f --- \ SudokuMenu.f Command IDs and Menus for Sudoku by Rod Oakford \ September 2005 needs RecentFiles cr .( Loading Menu and Command ID's...) : NewID ( <name> -- ) defined IF drop ELSE count "header NextID DOCON , , THEN ; IDCounter constant IDM_FIRST \ File menu NewID IDM_NEW NewID IDM_OPEN NewID IDM_CLOSE NewID IDM_SAVE NewID IDM_SAVE_AS NewID IDM_PAGE_SETUP NewID IDM_PRINT NewID IDM_IMPORT NewID IDM_OPEN_FILE NewID IDM_EXIT \ View menu NewID IDM_SIZE_1 NewID IDM_SIZE_2 NewID IDM_SIZE_3 NewID IDM_SIZE_4 NewID IDM_CURSOR_NUMBER NewID IDM_SHOW_SIZING NewID IDM_TOGGLE_TOOLBAR NewID IDM_TOGGLE_STATUSBAR NewID IDM_FONT NewID IDM_TEXT_COLOUR_1 NewID IDM_TEXT_COLOUR_2 NewID IDM_TEXT_COLOUR_3 NewID IDM_TEXT_COLOUR_4 NewID IDM_FIXED_COLOUR NewID IDM_VARIABLE_BACKGROUND_COLOUR NewID IDM_FIXED_BACKGROUND_COLOUR NewID IDM_WARNING_COLOUR NewID IDM_HIGHLIGHT_COLOUR NewID IDM_MARGIN_COLOUR NewID IDM_ELIMINATION_COLOUR \ Game menu NewID IDM_FORWARD NewID IDM_BACKWARD NewID IDM_START_EDIT NewID IDM_ESCAPE NewID IDM_TOGGLE_EDIT NewID IDM_RESTART NewID IDM_ELIMINATION NewID IDM_HINT NewID IDM_SOLUTION NewID IDM_NUMBER_SOLUTIONS \ NewID IDM_CONTINUE NewID IDM_CHECK_ALL NewID IDM_TOGGLE_VISIBLE NewID IDM_TOGGLE_AUDIBLE \ Help menu NewID IDM_HELP NewID IDM_ABOUT NewID IDM_UNINSTALL NewID IDM_SAVE_SETTINGS NewID IDM_RESTORE_SETTINGS NewID IDM_DEFAULT_SETTINGS \ Toolbar popup NewID IDM_SAVE_TOOLBAR NewID IDM_RESTORE_TOOLBAR NewID IDM_DEFAULT_TOOLBAR NewID IDM_FLAT \ Miscellaneous NewID IDM_LEFT NewID IDM_RIGHT NewID IDM_UP NewID IDM_DOWN NewID IDM_DELETE NewID IDM_KEY_1 NewID IDM_KEY_2 NewID IDM_KEY_3 NewID IDM_KEY_4 NewID IDM_KEY_5 NewID IDM_KEY_6 NewID IDM_KEY_7 NewID IDM_KEY_8 NewID IDM_KEY_9 NewID IDM_SELECT_BLANK NewID IDM_SELECT_1 NewID IDM_SELECT_2 NewID IDM_SELECT_3 NewID IDM_SELECT_4 NewID IDM_SELECT_5 NewID IDM_SELECT_6 NewID IDM_SELECT_7 NewID IDM_SELECT_8 NewID IDM_SELECT_9 NewID IDM_PLUS NewID IDM_MINUS NewID IDM_PAUSE NewID IDM_STOP NewID IDM_COLOUR_1 NewID IDM_COLOUR_2 NewID IDM_COLOUR_3 NewID IDM_COLOUR_4 NewID IDM_OPTIONS IdCounter constant IDM_LAST : allot-erase ( n -- ) here over allot swap erase ; Create CommandTable IDM_LAST IDM_FIRST - cells allot-erase : IsCommand? ( ID -- f ) IDM_FIRST IDM_LAST within ; : >CommandTable ( ID -- addr ) dup IsCommand? IF IDM_FIRST - cells CommandTable + ELSE drop abort" error - command ID out of range" THEN ; : DoCommand ( ID -- ) >CommandTable @ ?dup IF execute THEN ; : SetCommand ( ID -- ) last @ name> swap >CommandTable ! ; MENUBAR SudokuMenu Popup "&File" MenuItem "&New... \tCtrl+N" IDM_NEW DoCommand ; MenuItem "&Open... \tCtrl+O" IDM_OPEN DoCommand ; MenuItem "&Save" IDM_SAVE DoCommand ; MenuItem "Save &As..." IDM_SAVE_AS DoCommand ; MenuSeparator MenuItem "Page setup" IDM_PAGE_SETUP DoCommand ; MenuItem "Print \tCtrl+P" IDM_PRINT DoCommand ; MenuSeparator MenuItem "&Import... \tCtrl+I" IDM_IMPORT DoCommand ; 9 RECENTFILES RecentFiles IDM_OPEN_FILE DoCommand ; MenuSeparator MenuItem "E&xit \tAlt+F4" IDM_EXIT DoCommand ; Popup "&View" :MENUITEM hSize1 "Size&1 \tCtrl+1" IDM_SIZE_1 DoCommand ; :MENUITEM hSize2 "Size&2 \tCtrl+2" IDM_SIZE_2 DoCommand ; :MENUITEM hSize3 "Size&3 \tCtrl+3" IDM_SIZE_3 DoCommand ; :MENUITEM hSize4 "Size&4 \tCtrl+4" IDM_SIZE_4 DoCommand ; MenuSeparator :MENUITEM hCursor "Show number by cursor" IDM_CURSOR_NUMBER DoCommand ; :MENUITEM hSizing "Adjust game while sizing" IDM_SHOW_SIZING DoCommand ; MenuSeparator :MENUITEM hToolbar "&Toolbar" IDM_TOGGLE_TOOLBAR DoCommand ; :MENUITEM hStatusBar "&Statusbar" IDM_TOGGLE_STATUSBAR DoCommand ; MenuSeparator MenuItem "&Font... \t Ctrl+F" IDM_FONT DoCommand ; MenuSeparator SubMenu "&Change colours" \ MenuItem "&Variable" IDM_VARIABLE_COLOUR DoCommand ; MenuItem "Text colour &1" IDM_TEXT_COLOUR_1 DoCommand ; MenuItem "Text colour &2" IDM_TEXT_COLOUR_2 DoCommand ; MenuItem "Text colour &3" IDM_TEXT_COLOUR_3 DoCommand ; MenuItem "Text colour &4" IDM_TEXT_COLOUR_4 DoCommand ; MenuItem "&Fixed" IDM_FIXED_COLOUR DoCommand ; MenuItem "&Warning" IDM_WARNING_COLOUR DoCommand ; MenuItem "&Variable background" IDM_VARIABLE_BACKGROUND_COLOUR DoCommand ; MenuItem "&Fixed background" IDM_FIXED_BACKGROUND_COLOUR DoCommand ; MenuItem "&Highlight" IDM_HIGHLIGHT_COLOUR DoCommand ; MenuItem "&Margin" IDM_MARGIN_COLOUR DoCommand ; MenuItem "&Elimination" IDM_ELIMINATION_COLOUR DoCommand ; EndSubMenu Popup "&Game" :MENUITEM hEdit "&Edit fixed numbers" IDM_TOGGLE_EDIT DoCommand ; MenuSeparator MenuItem "&Undo move \tCtrl+<--" IDM_BACKWARD DoCommand ; MenuItem "Re&do move \tCtrl+-->" IDM_FORWARD DoCommand ; MenuItem "&Restart \tCtrl+R" IDM_RESTART DoCommand ; MenuItem "&Hint \tCtrl+H" IDM_HINT DoCommand ; \ MenuItem "Continue" IDM_CONTINUE DoCommand ; MenuItem "&Check \tCtrl+C" IDM_CHECK_ALL DoCommand ; MenuSeparator :MenuItem hSolution "&See solution \tCtrl+S" IDM_SOLUTION DoCommand ; :MenuItem hNumberSolutions "Find &number of solutions" IDM_NUMBER_SOLUTIONS DoCommand ; :MenuItem hEliminate "Show &Eliminations \tCtrl+E" IDM_ELIMINATION DoCommand ; :MENUITEM hVisible "&Visible warning on errors" IDM_TOGGLE_VISIBLE DoCommand ; :MENUITEM hAudible "&Audible warning on errors" IDM_TOGGLE_AUDIBLE DoCommand ; Popup "&Help" MenuItem "&Help \tF1" IDM_HELP DoCommand ; MenuItem "&About" IDM_ABOUT DoCommand ; MenuItem "&Uninstall" IDM_UNINSTALL DoCommand ; \ MenuItem "&Save settings" IDM_SAVE_SETTINGS DoCommand ; \ MenuItem "&Restore settings" IDM_RESTORE_SETTINGS DoCommand ; \ MenuItem "&Default settings" IDM_DEFAULT_SETTINGS DoCommand ; ENDBAR POPUPBAR ToolbarPopup Popup " " :MenuItem hFlat "&Flat Toolbar" IDM_FLAT DoCommand ; MenuSeparator MenuItem "&Save Toolbar" IDM_SAVE_TOOLBAR DoCommand ; MenuItem "&Restore Toolbar" IDM_RESTORE_TOOLBAR DoCommand ; MenuItem "&Default Toolbar" IDM_DEFAULT_TOOLBAR DoCommand ; ENDBAR : CheckSize { n -- } \ check nth size on view menu, uncheck the rest 5 1 DO i n = IF true ELSE false THEN LOOP check: hSize4 check: hSize3 check: hSize2 check: hSize1 ; --- NEW FILE: SudokuDialogs.f --- \ SudokuDialogs.f Dialogs for Sudoku contained in SudokuDialog.res \ AboutSudoku - the about dialog \ SudokuHelp - the help screen \ ImportDialog - for importing numbers into the game \ September 2005 Rod Oakford cr .( Loading Dialogs...) s" res" "fpath+ Create ImportNumbers 256 allot 0 value start 0 value solution Font ImportFont -13 Height: ImportFont 0 Width: ImportFont \- SudokuVersion Create SudokuVersion ," 1.0" FileOpenDialog OpenText "" "Text Files (*.txt)|*.txt|All Files (*.*)|*.*|" 0 value hFile load-dialog SudokuDialog \ needs SudokuDialog.res, SudokuDialog.h \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ About box \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object AboutSudoku <Super dialog :M GetTemplate: ( -- a ) IDD_ABOUTBOX SudokuDialog find-dialog-id ;M :M On_Init: ( -- ) s" Sudoku version " pad place SudokuVersion count pad +place pad count IDC_VERSION SetDlgItemText: self ;M ;Object : SA conhndl start: AboutSudoku drop ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Help box \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Create HelpText Z," Numbers can be placed on the grid via the keyboard using the arrow keys to select the current square." +Z," Easier is to use the mouse to select the current number from the toolbar and left click on a square" +Z," to place it. Right click will remove the number. The current number can also be changed using the" +Z," wheel on the mouse or selected by clicking on one of the fixed numbers. Moves can be undone and" +Z," redone using the buttons on the toolbar or from the game menu.\n\nShortcut keys:" Create Keys Z," Keys\n\nCtrl + N\n\nCtrl + O\n\nCtrl + P\n\nCtrl + I\n\n" +Z," Ctrl + 1\n\nCtrl + 2\n\nCtrl + 3\n\nCtrl + 4\n\nCtrl + F\n\n" +Z," Ctrl + <-\n\nCtrl + ->\n\nCtrl + R\n\nCtrl + H\n\n" +Z," Ctrl + C\n\nCtrl + S\n\nCtrl + E" Create Actions Z," Action\n\nstart a new (blank) game, fill in your own starting numbers" +Z," \n\nopen a sudoku file (.sku)" +Z," \n\nprint the current position (use Page Setup to set margins for both printer and screen)" +Z," \n\nimport text to make a new game" +Z," \n\nmake the window one of 4 fixed sizes" +Z," \n\n(the window can be dragged to any size)" +Z," \n\n" +Z," \n\n" +Z," \n\nchange the font for the digits" +Z," \n\nundo last move" +Z," \n\nredo last move" +Z," \n\nrestart the game" +Z," \n\nreveal the number in the current square (provided a solution can be found)" +Z," \n\ncheck the current position for errors" +Z," \n\nshow the full solution for the current position (if possible)" +Z," \n\nshade squares not possible for the current number" :Object SudokuHelp <Super dialog :M GetTemplate: ( -- a ) IDD_HELP SudokuDialog find-dialog-id ;M :M On_Init: ( -- ) HelpText IDC_HELP_TEXT hWnd Call SetDlgItemText drop Keys IDC_KEYS hWnd Call SetDlgItemText drop Actions IDC_ACTIONS hWnd Call SetDlgItemText drop ;M ;Object : SH conhndl start: SudokuHelp drop ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Import Dialog \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Create ImportText Z," Copy and paste a Sudoku board into this box. It can be all in one line, +Z," or in a 9 by 9 box. The Importer will ignore spaces and read the numbers +Z," in order. The characters 0, '.', ?,'_' or * will be interpreted as blanks +Z," in the game. Alternatively open a text file to import." :Object ImportDialog <Super Dialog :M GetTemplate: ( -- a ) IDD_IMPORT SudokuDialog find-dialog-id ;M :M On_Init: ( -- ) ImportText IDC_IMPORT_TEXT hWnd Call SetDlgItemText drop ImportNumbers 256 erase Create: ImportFont Handle: ImportFont IDC_SUDOKU_EDIT SetDlgItemFont: self ;M : Blank? ( c -- f ) Case '.' of true endof '?' of true endof '*' of true endof '0' of true endof '_' of true endof ( default ) false swap EndCase ; : CollectNumbers ( -- ) pad 512 IDC_SUDOKU_EDIT GetDlgItemText: self \ 889 seems to be largest length of pad possible 0 ?DO pad i + dup c@ dup 49 58 within IF drop 1 ELSE blank? IF '0' over c! 1 ELSE 0 THEN THEN ImportNumbers +place LOOP 0 to start 0 to solution ImportNumbers count 81 / 81 * bounds ?DO true 81 0 DO i j + c@ dup '0' = IF j to Start THEN 49 58 within and LOOP IF i to Solution THEN 81 +LOOP ; : OpenTextFile ( -- ) GetHandle: self start: OpenText dup dup c@ IF count r/o open-file IF 2drop ( ReadErrorMessage ) \ file does not exist \ IF drop ReadErrorMessage \ file does not exist ELSE to hFile pad 512 hFile read-file drop pad + 0 swap c! pad IDC_SUDOKU_EDIT GetHandle: self call SetDlgItemText drop THEN hFile close-file drop ELSE drop THEN ; :M On_Command: ( hCtrl code ID -- f ) Case IDC_FILE Of OpenTextFile EndOf IDCANCEL Of 0 end-dialog EndOf IDOK Of CollectNumbers 1 end-dialog EndOf false swap ( default result ) Endcase ;M ;Object : SI conhndl start: ImportDialog IF \ cr ImportNumbers 243 dump Start IF cr start 81 type THEN Solution IF cr solution 81 type THEN THEN ; --- NEW FILE: SudokuPrinting.f --- \ SudokuPrinting.f Page setup and printing for Sudoku game \ September 2005 Rod Oakford \ Needs PrintSupport cr .( Loading Printing...) : OnPageSetup ( -- ) GetHandle: Frame PSD cell+ ! PSD_MARGINS PSD_MINMARGINS or PSD_INTHOUSANDTHSOFINCHES or PSDFlags ! PageSetupDlg IF ptPaperSize 2@ Resolution 1000 */ swap Resolution 1000 */ to PaperSize \ Redraw: Frame Autosize: Frame THEN ; IDM_PAGE_SETUP SetCommand : OnPrint ( -- ) GetHandle: Frame PD cell+ ! 1 nFromPage w! 1 nMinPage w! 1 nMaxPage w! True PD_NOSELECTION ( PD_HIDEPRINTTOFILE or ) PD_RETURNDC or PD_PAGENUMS or 1 Print-init2 ?dup IF True to Printing GetHandle: mdc \ save Handle of memory DC for screen on stack swap PutHandle: mdc \ use mdc as Print DC SaveDC: mdc \ save Print DC size LeftMargin TopMargin \ save on stack Resolution \ save Resolution of screen on stack \ DPI: ThePrinter drop to Resolution LOGPIXELSX hDC @ Call GetDeviceCaps to Resolution \ Resolution of printer \ Quality-print to Resolution Resolution over size swap */ to size Resolution over FactorFontSize \ increase FontSize in ratio of printer res to screen res \ rtMargin 2@ to LeftMargin to TopMargin Print-start Get-copies 0 DO Start-page PrepareDC: Frame End-page LOOP Print-end ChangeFontSize \ restore FontHeight to Resolution \ restore Resolution of screen ( used in margins ) to TopMargin to LeftMargin to size RestoreDC: mdc \ restore Print DC PutHandle: mdc \ restore Handle for screen in mdc Print-close False to Printing THEN ; IDM_PRINT SetCommand --- NEW FILE: Sudoku.f --- \ Sudoku.f Application to play and solve Sudoku puzzles. \ September 2005 Rod Oakford cr .( Loading Sudoku...) anew -Sudoku.f Create SudokuVersion ," 1.2" s" apps\Sudoku" "fpath+ s" apps\Sudoku\res" "fpath+ WinLibrary Winmm.dll needs AcceleratorTables.f needs RegistrySupport.f needs SudokuMenu.f needs SudokuStatusBar.f needs SudokuToolbar.f needs SudokuDialogs.f [...1265 lines suppressed...] \ Su \ \s cr .( Save Sudoku.exe [Y/N]: ) key dup emit dup 121 = swap 89 = or nostack [IF] )) [defined] VIMAGE [if] also VIMAGE [then] [defined] CONSOLE-DLL? [if] false to CONSOLE-DLL? [then] ' Su turnkey Sudoku.exe needs SudokuResources cr .( Do you want to associate .sku files with Sudoku.exe [Y/N]: ) key dup emit dup 121 = swap 89 = or nostack [IF] Needs FileAssociations s" .sku" s" Sudoku File" s" Sudoku.exe" SetAssociation [THEN] 2 pause-seconds bye (( [ELSE] Su [THEN] )) --- NEW FILE: Applause7.wav --- (This appears to be a binary file; contents omitted.) --- NEW FILE: SudokuToolbar.f --- \ SudokuToolbar.f Toolbar for Sudoku game \ September 2005 Rod Oakford s" apps\Sudoku\res" "fpath+ Needs Toolbar.f Needs SudokuMenu.f cr .( Loading Sudoku Toolbar...) :ToolStrings SudokuTooltips ts," Make a new game" ts," Open game file" ts," Save game file" ts," Print game" ts," Select 1" ts," Select 2" ts," Select 3" ts," Select 4" ts," Select 5" ts," Select 6" ts," Select 7" ts," Select 8" ts," Select 9" ts," Select blank" ts," Undo last move" ts," Redo last move" ts," Make larger" ts," Make smaller" ts," Start/stop timer" ts," Text colour 1" ts," Text colour 2" ts," Text colour 3" ts," Text colour 4" ts," Options dialog" ;ToolStrings :ToolBarTable SudokuTable \ Bmp Ndx ID Initial Style Initial State Tooltip Ndx \ The default state and style for all buttons are enabled and button style \ You can modify as desired SeparatorButton, 0 IDM_NEW TBSTATE_ENABLED TBSTYLE_BUTTON 0 ToolBarButton, 1 IDM_OPEN TBSTATE_ENABLED TBSTYLE_BUTTON 1 ToolBarButton, 2 IDM_SAVE TBSTATE_ENABLED TBSTYLE_BUTTON 2 ToolBarButton, SeparatorButton, 3 IDM_PRINT TBSTATE_ENABLED TBSTYLE_BUTTON 3 ToolBarButton, SeparatorButton, 4 IDM_SELECT_1 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 4 ToolBarButton, 5 IDM_SELECT_2 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 5 ToolBarButton, 6 IDM_SELECT_3 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 6 ToolBarButton, 7 IDM_SELECT_4 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 7 ToolBarButton, 8 IDM_SELECT_5 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 8 ToolBarButton, 9 IDM_SELECT_6 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 9 ToolBarButton, 10 IDM_SELECT_7 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 10 ToolBarButton, 11 IDM_SELECT_8 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 11 ToolBarButton, 12 IDM_SELECT_9 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 12 ToolBarButton, 13 IDM_SELECT_BLANK TBSTATE_ENABLED TBSTATE_CHECKED or TBSTYLE_CHECKGROUP 13 ToolBarButton, SeparatorButton, 14 IDM_BACKWARD TBSTATE_ENABLED TBSTYLE_BUTTON 14 ToolBarButton, 15 IDM_FORWARD TBSTATE_ENABLED TBSTYLE_BUTTON 15 ToolBarButton, SeparatorButton, 18 IDM_PAUSE TBSTATE_ENABLED TBSTYLE_CHECK 18 ToolBarButton, SeparatorButton, 19 IDM_COLOUR_1 TBSTATE_ENABLED TBSTATE_CHECKED or TBSTYLE_CHECKGROUP 19 ToolBarButton, 20 IDM_COLOUR_2 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 20 ToolBarButton, 21 IDM_COLOUR_3 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 21 ToolBarButton, 22 IDM_COLOUR_4 TBSTATE_ENABLED TBSTYLE_CHECKGROUP 22 ToolBarButton, ToolBarTableExtraButtons: 16 IDM_PLUS TBSTATE_ENABLED TBSTYLE_BUTTON 16 ToolBarButton, 17 IDM_MINUS TBSTATE_ENABLED TBSTYLE_BUTTON 17 ToolBarButton, SeparatorButton, 23 IDM_OPTIONS TBSTATE_ENABLED TBSTYLE_BUTTON 23 ToolBarButton, ;ToolBarTable 0 value BitmapFileHeader : BitmapInfo BitmapFileHeader 14 + ; : BitmapData BitmapFileHeader dup 10 + @ + ; : LoadBitmapFile ( a n -- ) "path-file drop \ added September 2005 r/o open-file abort" Couldn't open the ToolBar bitmaps" >r here dup to BitmapFileHeader \ set the bmp address r@ file-size 2drop \ the bmp length dup allot \ allocate the space r@ read-file 2drop \ read the bmp file r> close-file drop \ close file ; s" Toolbar.bmp" LoadBitmapFile :Object SudokuToolBar <Super Win32Toolbar int hBitmap int pszValueNameDefault :M SaveRestoreDefault: ( f -- ) pszValueName swap pszValueNameDefault to pszValueName SaveRestore: self to pszValueName ;M (( :M AddBitmaps: ( n -- ) \ loads n images from bitmap loaded in memory DIB_RGB_COLORS BitmapInfo BitmapData CBM_INIT BitmapInfo \ info pointer GetDC: self call CreateDIBitmap to nID NULL to hInst tbab swap TB_ADDBITMAP hwnd call SendMessage Drop ;M )) :M Start: ( parent -- ) SudokuTable IsButtonTable: self SudokuTooltips IsTooltips: self Start: super \ Create bitmap handle DIB_RGB_COLORS BitmapInfo BitmapData CBM_INIT BitmapInfo \ info pointer GetDC: self dup>r call CreateDIBitmap to hBitmap r> ReleaseDC: self 0 hBitmap 24 AddBitmaps: self drop \ Set-up registry key for customization data... z" Software\Win32Forth\Sudoku\Options" \ Registry sub-key z" ToolBarLayout" \ value key name SetRegistryKey: self z" ToolBarLayoutDefault" to pszValueNameDefault True SaveRestoreDefault: self False SaveRestore: self ;M :M WM_RBUTTONDOWN ( h m w l -- res ) \ right click for context menu sent to frame window swap rot GetHandle: Parent Call SendMessage drop 0 ;M :M WindowStyle: ( -- style ) WS_CHILD \ not WS_VISIBLE - start hidden, not flat TBSTYLE_TOOLTIPS or CCS_ADJUSTABLE or WS_CLIPSIBLINGS or ;M :M On_Done: ( -- ) hbitmap if hbitmap Call DeleteObject drop 0 to hbitmap then On_Done: super ;M :M On_CustHelp: ( -- f ) \ Request for customization help z" Reset: resets all buttons to their previous positions.\nButtons can also be rearranged or deleted by holding down the shift key while dragging." z" Customize Toolbar" MB_OK MessageBox: self drop true ;M ;Object 0 value ToolbarHeight : ShowToolbar ( -- ) GetWindowRect: SudokuToolbar nip swap - nip to ToolbarHeight SW_SHOW show: SudokuToolbar true check: hToolbar ; : HideToolbar ( -- ) 0 to ToolbarHeight SW_HIDE show: SudokuToolbar false check: hToolbar ; : CheckNumber ( n -- ) \ check nth number on toolbar, uncheck the rest IDM_SELECT_BLANK + true swap CheckButton: SudokuToolBar ; \s Needs ToolbarClass Needs SudokuMenu cr .( Loading Sudoku Toolbar...) false value FlatToolbar? :Object SudokuToolBar <Super CustomizableToolbar s" Toolbar.bmp" LoadBitmapFile DefaultButtons \ Buttons that will be initially displayed \ iBmp idCommand Style State (optional) Separator 0 IDM_NEW Button 1 IDM_OPEN Button 2 IDM_SAVE Button Separator 3 IDM_PRINT Button Separator 4 IDM_SELECT_1 CheckGroup 5 IDM_SELECT_2 CheckGroup 6 IDM_SELECT_3 CheckGroup 7 IDM_SELECT_4 CheckGroup 8 IDM_SELECT_5 CheckGroup 9 IDM_SELECT_6 CheckGroup 10 IDM_SELECT_7 CheckGroup 11 IDM_SELECT_8 CheckGroup 12 IDM_SELECT_9 CheckGroup 13 IDM_SELECT_BLANK CheckGroup Checked Separator 14 IDM_BACKWARD Button 15 IDM_FORWARD Button Separator 18 IDM_PAUSE Check Separator 19 IDM_COLOUR_1 CheckGroup Checked 20 IDM_COLOUR_2 CheckGroup 21 IDM_COLOUR_3 CheckGroup 22 IDM_COLOUR_4 CheckGroup ExtraButtons \ Buttons that will be available to customize the toolbar 16 IDM_PLUS Button 17 IDM_MINUS Button Separator 23 IDM_OPTIONS Button :M TooltipText: ( id -- Z$ ) Case IDM_NEW OF Z" Make a new game" ENDOF IDM_OPEN OF Z" Open game file" ENDOF IDM_SAVE OF Z" Save game file" ENDOF IDM_PRINT OF Z" Print game" ENDOF IDM_SELECT_1 OF Z" Select 1" ENDOF IDM_SELECT_2 OF Z" Select 2" ENDOF IDM_SELECT_3 OF Z" Select 3" ENDOF IDM_SELECT_4 OF Z" Select 4" ENDOF IDM_SELECT_5 OF Z" Select 5" ENDOF IDM_SELECT_6 OF Z" Select 6" ENDOF IDM_SELECT_7 OF Z" Select 7" ENDOF IDM_SELECT_8 OF Z" Select 8" ENDOF IDM_SELECT_9 OF Z" Select 9" ENDOF IDM_SELECT_BLANK OF Z" Select blank" ENDOF IDM_BACKWARD OF Z" Undo last move" ENDOF IDM_FORWARD OF Z" Redo last move" ENDOF IDM_PLUS OF Z" Make larger" ENDOF IDM_MINUS OF Z" Make smaller" ENDOF IDM_PAUSE OF Z" Start/stop timer" ENDOF IDM_COLOUR_1 OF z" Text colour 1" ENDOF IDM_COLOUR_2 OF z" Text colour 2" ENDOF IDM_COLOUR_3 OF z" Text colour 3" ENDOF IDM_COLOUR_4 OF z" Text colour 4" ENDOF IDM_OPTIONS OF Z" Options dialog" ENDOF ( default case ) Z" Undef" swap EndCase ;M :M Start: ( hParent) Start: Super \ Set-up registry key for customization data... z" Software\Win32Forth\Sudoku\Options" \ Registry sub-key z" ToolBarLayout" \ value key name z" ToolBarLayoutDefault" \ value key name SetRegistryKeys: self 24 AddBitmaps: self AddButtons: self \ AddStrings: self True to UseToolStringsInCustomize True SaveRestoreDefault: self False SaveRestore: self ;M :M WM_RBUTTONDOWN ( h m w l -- res ) \ right click for context menu sent to frame window swap rot HandleOfParent Call SendMessage drop 0 ;M :M WindowStyle: ( -- style ) WS_CHILD \ not WS_VISIBLE - start hidden, not flat TBSTYLE_TOOLTIPS or CCS_ADJUSTABLE or ;M :M On_ToolBarChange: ( -- f ) \ User has changed toolbar false ;M :M On_Reset: ( -- f ) \ User resets toolbar false SaveRestore: self true ;M ;Object 0 value ToolbarHeight : ShowToolbar ( -- ) GetWindowRect: SudokuToolbar nip swap - nip to ToolbarHeight SW_SHOW show: SudokuToolbar true check: hToolbar ; : HideToolbar ( -- ) 0 to ToolbarHeight SW_HIDE show: SudokuToolbar false check: hToolbar ; : CheckNumber ( n -- ) \ check nth number on toolbar, uncheck the rest IDM_SELECT_BLANK + true CheckButton: SudokuToolBar ; --- NEW FILE: SudokuStatusBar.f --- \ SudokuStatusBar.f StatusBar for Sudoku game \ Septmeber 2005 Rod Oakford \- hStatusBar 0 value hStatusBar Warning off Needs StatusBarClass.f Warning on cr .( Loading Sudoku StatusBar...) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Sudoku StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object SudokuStatusBar <Super StatusBar :M Start: ( parent -- ) Start: super 200 -1 2 SetParts: self ;M :M WindowStyle: [ WS_CHILD WS_CLIPSIBLINGS or ] literal \ not WS_VISIBLE - start hidden, no border ;M ;Object 0 value StatusBarHeight : ShowStatusBar ( -- ) GetWindowRect: SudokuStatusBar nip swap - nip to StatusBarHeight SW_SHOW show: SudokuStatusBar true check: hStatusBar ; : HideStatusBar ( -- ) 0 to StatusBarHeight SW_HIDE show: SudokuStatusBar false check: hStatusBar ; \s \ ******** Using ExControls.f ******** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Sudoku StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Needs ExControls.f :Object SudokuStatusBar <Super MultiStatusBar Create MultiWidth 200 , -1 , \ width of statusbar parts :M Start: ( parent -- ) Start: super MultiWidth 2 SetParts: self ;M :M WindowStyle: ( -- style ) [ WS_CHILD WS_CLIPSIBLINGS or ] literal \ not WS_VISIBLE - start hidden, no border ;M create text$ 256 allot :M GetText: ( n -- szText ) \ get text in n'th part text$ swap SB_GETTEXT SendMessage:Self drop text$ ;M :M UpdatePart: ( text$ p -- ) >r dup count r@ GetText: self zcount compare IF count asciiz r> SetText: self ELSE r> 2drop THEN ;M ;Object 0 value StatusBarHeight : ShowStatusBar ( -- ) Height: SudokuStatusBar to StatusBarHeight SW_SHOW show: SudokuStatusBar true check: hStatusBar ; : HideStatusBar ( -- ) 0 to StatusBarHeight SW_HIDE show: SudokuStatusBar false check: hStatusBar ; --- NEW FILE: Sudoku.fpj --- ProjectName= Project BuildFile= apps\Sudoku\Sudoku.f SearchPath= .;SRC;SRC\LIB;SRC\RES;SRC\CONSOLE;DOC;APPS\SUDOKU;APPS\SUDOKU\RES;RES Project,0 Modules,14 apps\Sudoku\Sudoku.f SRC\LIB\AcceleratorTables.f SRC\LIB\RegistrySupport.f apps\Sudoku\SudokuMenu.f SRC\LIB\RecentFiles.f apps\Sudoku\SudokuStatusBar.f SRC\LIB\StatusBarClass.f apps\Sudoku\SudokuToolbar.f SRC\LIB\Toolbar.f apps\Sudoku\SudokuDialogs.f apps\Sudoku\SudokuPrinting.f apps\Sudoku\SudokuResources.f SRC\LIB\Resources.f SRC\LIB\FileAssociations.f DLLs,0 Forms,0 Auxiliary Files,0 Resources,14 APPS\SUDOKU\RES\Toolbar.bmp apps\Sudoku\RES\SudokuDialog.h apps\Sudoku\RES\SudokuDialog.res apps\Sudoku\res\Sudoku.ico apps\Sudoku\res\arrow_m0.cur apps\Sudoku\res\arrow_m1.cur apps\Sudoku\res\arrow_m2.cur apps\Sudoku\res\arrow_m3.cur apps\Sudoku\res\arrow_m4.cur apps\Sudoku\res\arrow_m5.cur apps\Sudoku\res\arrow_m6.cur apps\Sudoku\res\arrow_m7.cur apps\Sudoku\res\arrow_m8.cur apps\Sudoku\res\arrow_m9.cur Docs,0 |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X