win32forth-cvs — CVS Commit List

[Win32forth-cvs] win32forth/demos WINCLOCK.F,1.1,1.2

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/demos
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29330/demos

Modified Files:
	WINCLOCK.F 
Log Message:
Centered the window of the improved version of Andrew Stephenson.

Index: WINCLOCK.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/demos/WINCLOCK.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** WINCLOCK.F	21 Dec 2004 00:18:52 -0000	1.1
--- WINCLOCK.F	5 Oct 2005 15:31:21 -0000	1.2
***************
*** 22,42 ****
  -1 value prev-y
  
  : moveto        ( x y -- )
!                 0max screen-height 4 - min swap 0max screen-width 4 - min swap
!                 bit-originy + swap bit-originx +  swap
!                 over prev-x = over prev-y = and
!                 IF      2drop
!                 ELSE    2dup to prev-y
!                              to prev-x
                          MoveTo: demo-dc
!                 THEN    ;
  
  : lineto        ( x y -- )
!                 0max screen-height 4 - min swap 0max screen-width 4 - min swap
!                 bit-originy + swap bit-originx +  swap
!                 over prev-x = over prev-y = and
!                 IF      2drop
!                 ELSE    2dup to prev-y
!                              to prev-x
                          LineTo: demo-dc
                  then    ;
--- 22,43 ----
  -1 value prev-y
  
+ : new-point-chk ( x y -- x y true | false )
+         0max screen-height 4 - min swap 0max screen-width 4 - min swap
+         bit-originy + swap bit-originx +  swap
+         over prev-x = over prev-y = and
+         if      2drop false ( don't draw )
+         else    2dup to prev-y
+                      to prev-x true ( do draw )
+         then ;
+ 
  : moveto        ( x y -- )
!                 new-point-chk
!                 if
                          MoveTo: demo-dc
!                 then    ;
  
  : lineto        ( x y -- )
!                 new-point-chk
!                 if
                          LineTo: demo-dc
                  then    ;
***************
*** 132,135 ****
--- 133,141 ----
  :M StartSize:   ( -- width height )     \ starting window size
                  480 480
+ 
+                 ;M
+ 
+ :M StartPos:    ( -- x y )              \ starting postion on screen
+                 CenterWindow: Self
                  ;M
  
***************
*** 186,190 ****
  : >screeny      ( n1 -- n2 )
                  screen-width 480 */ ;
! 
  : makesin       ( -- )
                  cr
--- 192,196 ----
  : >screeny      ( n1 -- n2 )
                  screen-width 480 */ ;
! ((
  : makesin       ( -- )
                  cr
***************
*** 203,213 ****
                          >screeny dup r>   scale-y */
                  swap 1 and + negate center-y + ;
  
  : xy-scale      ( 6deg scale -- x1 y1 )
                  >r
!                 dup        sintbl +CELLS @ >screenx dup r@  center-x */
!                 swap 1 and +        center-x +
!                 swap 15 +  sintbl +CELLS @ >screeny dup r>   scale-y */
!                 swap 1 and + negate center-y + ;
  
  -1 value last-hour
--- 209,223 ----
                          >screeny dup r>   scale-y */
                  swap 1 and + negate center-y + ;
+ ))
+ 
+ : sin      ( deg -- x )    60 mod sintbl +CELLS @ ;
+ : cos      ( deg -- y )    15 + sin negate ;
+ : roundup  ( x sx -- x' )  swap 1 and + ;
+ 
  
  : xy-scale      ( 6deg scale -- x1 y1 )
                  >r
!                 dup  sin >screenx dup r@  center-x */ roundup center-x +
!                 swap cos >screeny dup r>   scale-y */ roundup center-y + ;
  
  -1 value last-hour
***************
*** 220,248 ****
   0 value this-second
  
! : .sec          ( n1 -- )
                  >r
!                 center-x center-y  r@    center-x 20 - xy-scale line
!                 r@ 1- 020 xy-scale r@    center-x 20 - xy-scale line
!                 r@ 1+ 020 xy-scale r@    center-x 20 - xy-scale line
!                 center-x center-y  r@ 1- 020           xy-scale line
!                 center-x center-y  r@ 1+ 020           xy-scale line
                  r>drop ;
  
! : .min          ( n1 -- )
                  >r
!                 center-x center-y  r@           center-x dup 10 / - xy-scale line
!                 r@ 1- center-x 3 / xy-scale r@  center-x dup 10 / - xy-scale line
!                 r@ 1+ center-x 3 / xy-scale r@  center-x dup 10 / - xy-scale line
!                 center-x center-y  r@ 1-        center-x 3 /        xy-scale line
!                 center-x center-y  r@ 1+        center-x 3 /        xy-scale line
                  r>drop ;
  
! : .hr           ( n1 -- )
                  >r
!                 center-x center-y   r@          center-x 2 / xy-scale line
!                 r@ 2 - center-x 3 / xy-scale r@ center-x 2 / xy-scale line
!                 r@ 2 + center-x 3 / xy-scale r@ center-x 2 / xy-scale line
!                 center-x center-y   r@ 2 -      center-x 3 / xy-scale line
!                 center-x center-y   r@ 2 +      center-x 3 / xy-scale line
                  r>drop ;
  
--- 230,265 ----
   0 value this-second
  
! : cxy           center-x center-y ;
! : inner         20 xy-scale ;
! : outer         center-x 20 - xy-scale ;
! : innersc       center-x  3 / xy-scale ;
! : outermin      center-x dup 10 / - xy-scale ;
! : outerhr       center-x  2/  xy-scale ;
! 
! : .sec          ( sec -- )
                  >r
!                 cxy r@ outer line
!                 r@ 1-  inner r@ outer line
!                 r@ 1+  inner r@ outer line
!                 cxy r@ 1- inner line
!                 cxy r@ 1+ inner line
                  r>drop ;
  
! : .min          ( min -- )
                  >r
!                 cxy r@ outermin line
!                 r@ 1-  innersc r@ outermin line
!                 r@ 1+  innersc r@ outermin line
!                 cxy r@ 1- innersc line
!                 cxy r@ 1+ innersc line
                  r>drop ;
  
! : .hr           ( hr -- )
                  >r
!                 cxy r@ outerhr line
!                 r@ 2 -  innersc r@  outerhr line
!                 r@ 2 +  innersc r@  outerhr line
!                 cxy r@ 2 - innersc line
!                 cxy r@ 2 + innersc line
                  r>drop ;
  
***************
*** 306,314 ****
                  ccolor >color line-color
                  60 0
!                 DO      I    cdiam xy-scale 2dup 1+ swap 1+ swap line
                  LOOP    5 +TO cdiam
                  cdiam center-x 30 - >
                  IF      16 TO cdiam
!                 THEN    ;
  
  : .hms          ( -- )
--- 323,332 ----
                  ccolor >color line-color
                  60 0
!                 DO     \ draws dots (lines 1 pixel long)
!                     I    cdiam xy-scale 2dup 1+ swap 1+ swap line
                  LOOP    5 +TO cdiam
                  cdiam center-x 30 - >
                  IF      16 TO cdiam
!                 THEN  ;
  
  : .hms          ( -- )
***************
*** 321,341 ****
                  60 0
                  do      white  line-color
!                         i center-x  1 - xy-scale i 1+ center-x  1 - xy-scale line
                          i center-x 12 - xy-scale i 1+ center-x 12 - xy-scale line
                          i 5 mod
                          if      ltcyan line-color           \ 1 second markers
!                                 i center-x 12 - xy-scale i center-x 1 - xy-scale line
                          else    yellow line-color           \ 5 second markers
!                                 i center-x 20 - xy-scale i center-x 1 - xy-scale line
                          then
                  loop    ;
  
  : new-clock     ( -- )          \ draw a new clock,
!                 screen-width  2 / 1- TO center-x
!                 screen-height 2 / 1- TO center-y       \ calibrate screen center
                  center-x center-x center-y */ TO scale-y          \ calibrate aspect ratio
                  white line-color                        \ default color=white
                  show-border
!                 show-circle ;                    \ display the circle
  
  : show-time     ( -- )          \ show the time if it has changed
--- 339,359 ----
                  60 0
                  do      white  line-color
!                         i center-x  1-  xy-scale i 1+ center-x  1-  xy-scale line
                          i center-x 12 - xy-scale i 1+ center-x 12 - xy-scale line
                          i 5 mod
                          if      ltcyan line-color           \ 1 second markers
!                                 i center-x 12 - xy-scale i center-x 1- xy-scale line
                          else    yellow line-color           \ 5 second markers
!                                 i center-x 20 - xy-scale i center-x 1- xy-scale line
                          then
                  loop    ;
  
  : new-clock     ( -- )          \ draw a new clock,
!                 screen-width  2/ 1- TO center-x
!                 screen-height 2/ 1- TO center-y         \ calibrate screen center
                  center-x center-x center-y */ TO scale-y          \ calibrate aspect ratio
                  white line-color                        \ default color=white
                  show-border
!                 show-circle ;                   \ display the circle
  
  : show-time     ( -- )          \ show the time if it has changed
***************
*** 351,356 ****
                  Start: GCLOCK
                  RANDOM-INIT                             \ initialize random numbers
!                 screen-width  2 / 1 - TO center-x
!                 screen-height 2 / 1 - TO center-y       \ calibrate screen center
                  white line-color                        \ default color=white
                  new-clock
--- 369,374 ----
                  Start: GCLOCK
                  RANDOM-INIT                             \ initialize random numbers
!                 screen-width  2/ 1- TO center-x
!                 screen-height 2/ 1- TO center-y         \ calibrate screen center
                  white line-color                        \ default color=white
                  new-clock
***************
*** 374,379 ****
                          delay-ms ms
                  again   ;
! 
! ( with-img ) ' WinClock turnkey WinClock     \ build an application on disk
! 5 pause-seconds
  
--- 392,400 ----
                          delay-ms ms
                  again   ;
! false #if
! ' WinClock turnkey WinClock     \ build an application on disk
! 1 pause-seconds
! #else
! WinClock
! #then
  

[Win32forth-cvs] win32forth/src/lib FileAssociations.f,NONE,1.1 StatusBarClass.f,NONE,1.1

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3155/src/lib

Added Files:
	FileAssociations.f StatusBarClass.f 
Log Message:
Rod: added library files required for Sudoku

--- NEW FILE: FileAssociations.f ---
\ FileAssociations.f         Utility to register a file extension to open a program.  Rod Oakford August 2005

\               A subkey with the name of the file extension (e.g. .mpg) is added in HKEY_CLASSES_ROOT.
\               The default value of this key is set to a TypeName which is added as another subkey of HKEY_CLASSES_ROOT.
\               If this .ext already exists the previous TypeName is saved (and restored when the association is deleted).
\               Further subkeys are added to the TypeName key to define the Icon and Command String to Open the program.
\
\               Win2k and later require deletion of the previous Command String for a new association to work if the user
\               has changed the association using Folder Options\File Types (rather than with RegEdit or an installer).
\
\               s" .ext"  s" Type" s" App.exe"  SetAssociation
\               s" .ext"  s" App.exe"  DeleteAssociation

cr .( Loading File Associations)

INTERNAL

Create TypeName  32 allot             \ this key will be called App.ext
Create FileExtension 8 allot          \ the file extension including the .
Create PreviousKey 16 allot           \ this key will be called App.bak to hold the previous Type Name
Create FileType  32 allot             \ the description that appears under the Type heading in explorer
Create DefaultIcon 256 allot          \ full path to Icon, with index in .exe
Create CommandLine 256 allot          \ full pathname to App.exe with "%1" and any options (e.g. /Play)
Create Options  8 allot

: SetHKCRPath ( -- )
        HKEY_CLASSES_ROOT to regBaseKey
        BaseReg off  ProgReg off ;

: RestoreRegPath ( -- )
        HKEY_CURRENT_USER to regBaseKey
        s" SOFTWARE\" BaseReg place
        PROGREG-INIT ;

: DeleteTypeNameSubKey ( s" SubKey" -- )   \ deletes key HKEY_CLASSES_ROOT\<TypeName>\<SubKey>
        TypeName count ProgReg place  ProgReg +place
        ProgReg count asciiz
        HKEY_CLASSES_ROOT Call RegDeleteKey
        IF
            s" Unable to delete " pad place
            progreg count pad +place
            pad count asciiz
            z" DeleteSubKey"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
        THEN 
        ;

: DeleteKeyValue ( hKey s" Value Name" -- )   \ deletes value HKEY_CLASSES_ROOT\<Key Name>\<Value Name>
        ProgReg place
        ProgReg count
        asciiz swap Call RegDeleteValue
        IF
            s" Unable to delete " pad place
            progreg count pad +place
            pad count asciiz
            z" DeleteKeyValue"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
        THEN 
        ;

: SaveDefaultValue ( -- )   \ will be empty for a new extension
        s" " FileExtension count RegGetString
        PreviousKey count  FileExtension count  RegSetString ;
  
: RestoreDefaultValue ( -- )   \ if previous key exists
        PreviousKey count  FileExtension count  RegGetString  RegType @ REG_SZ =
        IF  s" "  FileExtension count  RegSetString  ELSE  2drop  THEN ;

: DeleteExtension ( -- )   \ if default value is empty, otherwise just delete previous key
        s" " FileExtension count RegGetString nip 0=
        IF  FileExtension count  asciiz  HKEY_CLASSES_ROOT Call RegDeleteKey drop
        ELSE  FileExtension count  RegGetKey dup  PreviousKey count  DeleteKeyValue (RegCloseKey) drop
        THEN ;

EXTERNAL

: DeleteAssociation ( s" .ext"  s" App.exe" -- )
        "minus-ext"  2dup TypeName place  PreviousKey place  s" .bak" PreviousKey +place
        2dup FileExtension place  TypeName +place
        SetHKCRPath
        s" " FileExtension count RegGetString  TypeName  count  STR=
        IF
            RestoreDefaultValue
            DeleteExtension
            s" \Shell\Open\Command"  DeleteTypeNameSubKey
            s" \Shell\Open"          DeleteTypeNameSubKey
            s" \Shell"               DeleteTypeNameSubKey
            s" \DefaultIcon"         DeleteTypeNameSubKey
            s" "                     DeleteTypeNameSubKey
        ELSE
            s" Unable to delete " pad place
            FileExtension count pad +place
            pad count asciiz
            z" Delete Association"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
        THEN
        RestoreRegPath ;

: SetAssociation ( s" .ext"  s" Type"  s" App.exe </Options>" -- )
        2dup bl scan 2dup Options place nip -   \ first word only, rest to options  
        2dup "minus-ext"  2dup TypeName place  PreviousKey place  s" .bak" PreviousKey +place
        "path-file   \ get full path name of App.exe
        IF
            pad place
            s"  not found in current path" pad +place
            pad count asciiz
            z" Set Association"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
            4drop
        ELSE
            2dup DefaultIcon place  s" ,0" DefaultIcon +place
            s$ '"' pad place  pad +place  s$ '" "%1"' pad +place  Options count pad +place  pad count CommandLine place
            FileType place
            2dup FileExtension place  TypeName +place
            SetHKCRPath
            RestoreDefaultValue
            SaveDefaultValue
            TypeName count  s" "  FileExtension count  RegSetString
            FileType count  s" "  TypeName count       RegSetString
            DefaultIcon count  s" "  TypeName count pad place  s" \DefaultIcon"        pad +place  pad count RegSetString
            Commandline count  s" "  TypeName count pad place  s" \Shell\Open\Command" pad +place  pad count RegSetString
            RestoreRegPath
        THEN ;

MODULE

\s
: ss ( -- )   s" .sku"  s" Sudoku File"  s" Sudoku.exe"  SetAssociation ;
: dd ( -- )   s" .sku"  s" Sudoku.exe"  DeleteAssociation ;

--- NEW FILE: StatusBarClass.f ---
\ StatusBarClass.f      StatusBar class by Rod Oakford
\                       June 2003

anew -StatusBar.f

cr  .( Loading StatusBar class...)

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\ StatusBar Class \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

:Class StatusBar  <Super Control

: SendMessage ( lParam wParam message -- result )   hWnd Call SendMessage ;
: SendMessageDrop ( lParam wParam message -- )   SendMessage drop ;

:M SetSimple: ( flag -- )   \ sets status bar to show single part or multipart
        0 swap SB_SIMPLE  SendMessageDrop
        ;M

:M IsSimple: ( -- f )
        0 0 SB_ISSIMPLE  SendMessage
        ;M

:M SetParts:   ( p0  p1  p2  p3 ... n -- )
        pad 2dup 2>r
        swap 1- 4 *  bounds swap do  i !  -4 +loop
        r> r> SB_SETPARTS SendMessageDrop
        ;M

:M Start: ( Parent -- )    \ creates an empty statusbar in parent window
        to Parent
        z" msctls_statusbar32" Create-Control
\        WS_CLIPSIBLINGS +Style: self
\        SW_SHOWNORMAL Show: self
\        FALSE SetSimple: self
        ;M

int BorderStyle         \ style of border to use

:M RaisedBorder: ( -- ) \ text drawn below border (default)
        0 to BorderStyle
        ;M

:M NoBorder: ( -- )     \ text drawn at border level (no border)
        SBT_NOBORDERS to BorderStyle
        ;M

:M SunkenBorder: ( -- )   \ text drawn above border
        SBT_POPOUT to BorderStyle
        ;M

:M ClassInit: ( -- )   \ initialize class
        ClassInit: super
        RaisedBorder: self
        ;M

\ NULL MinHeight: self  appears to reset to the default height statusbar
:M MinHeight: ( #pixels)   \ set minimum height of text region (not including borders)
        0 swap SB_SETMINHEIGHT SendMessageDrop
        ;M

:M GetBorders: ( -- hWidth vWidth divWidth)   \ returns the border widths in pixels
        HERE 0 SB_GETBORDERS SendMessageDrop
        HERE DUP @  SWAP CELL+ DUP @  SWAP CELL+ @
        ;M

:M Redraw: ( -- )   \ redraw the statusbar after changes (e.g., size)
        0 0 WM_SIZE SendMessageDrop
        ;M

:M SetTextPart: ( a n p)   \ set text in p'th part (255 for single part)
        -rot asciiz  swap BorderStyle or
        SB_SETTEXT  SendMessageDrop
        ;M

:M GetTextPart: ( p -- a n )   \ get text in p'th part (255 for single part)
        gettext$ swap  dup 255 = IF  WM_GETTEXT  ELSE  SB_GETTEXT
        THEN  SendMessage  gettext$  swap 32767 and
        ;M

:M UpdatePart: ( text$ p -- )   >r count
        2dup r@ GetTextPart: self  compare
        IF
            r> SetTextPart: self
        ELSE
            r> 3drop
        THEN
        ;M

:M SetBkColor: ( color -- )
        0 SB_SETBKCOLOR SendMessageDrop
        ;M

;Class

[Win32forth-cvs] win32forth/apps/Sudoku/Res Sudoku.ico,NONE,1.1 SudokuDialog.RES,NONE,1.1 SudokuDialog.h,NONE,1.1 Toolbar.bmp,NONE,1.1 arrow_m0.cur,NONE,1.1 arrow_m1.cur,NONE,1.1 arrow_m2.cur,NONE,1.1 arrow_m3.cur,NONE,1.1 arrow_m4.cur,NONE,1.1 arrow_m5.cur,NONE,1.1 arrow_m6.cur,NONE,1.1 arrow_m7.cur,NONE,1.1 arrow_m8.cur,NONE,1.1 arrow_m9.cur,NONE,1.1

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Sudoku/Res
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1760/apps/Sudoku/Res

Added Files:
	Sudoku.ico SudokuDialog.RES SudokuDialog.h Toolbar.bmp 
	arrow_m0.cur arrow_m1.cur arrow_m2.cur arrow_m3.cur 
	arrow_m4.cur arrow_m5.cur arrow_m6.cur arrow_m7.cur 
	arrow_m8.cur arrow_m9.cur 
Log Message:
Rod: added files for Sudoku game

--- NEW FILE: arrow_m8.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m6.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Sudoku.ico ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Toolbar.bmp ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m0.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: SudokuDialog.RES ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m9.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: SudokuDialog.h ---
//{{NO_DEPENDENCIES}}
// Microsoft Developer Studio generated include file.
// Used by SudokuDialog.rc
//
#define IDD_ABOUTBOX                    100
#define IDD_HELP                        148
#define IDD_IMPORT                      158
#define IDC_SUDOKU_EDIT                 1004
#define IDC_FILE                        1005
#define IDC_HELP_TEXT                   1006
#define IDC_IMPORT_TEXT                 1007
#define IDC_KEYS                        1020
#define IDC_ACTIONS                     1021
#define IDC_NAME                        1022
#define IDC_FACTS                       1023
#define IDC_VERSION                     1024
#define IDC_RULES                       1025
#define ID_ICON                         65535

// Next default values for new objects
// 
#ifdef APSTUDIO_INVOKED
#ifndef APSTUDIO_READONLY_SYMBOLS
#define _APS_3D_CONTROLS                     1
#define _APS_NEXT_RESOURCE_VALUE        159
#define _APS_NEXT_COMMAND_VALUE         32787
#define _APS_NEXT_CONTROL_VALUE         1008
#define _APS_NEXT_SYMED_VALUE           101
#endif
#endif

--- NEW FILE: arrow_m3.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m1.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m7.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m5.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m4.cur ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: arrow_m2.cur ---
(This appears to be a binary file; contents omitted.)

[Win32forth-cvs] win32forth/apps/Sudoku Applause7.wav,NONE,1.1 Sudoku.f,NONE,1.1 Sudoku.fpj,NONE,1.1 SudokuDialogs.f,NONE,1.1 SudokuMenu.f,NONE,1.1 SudokuPrinting.f,NONE,1.1 SudokuResources.f,NONE,1.1 SudokuStatusBar.f,NONE,1.1 SudokuToolbar.f,NONE,1.1

[Rod O. <rod...@us...>]

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

[Win32forth-cvs] win32forth/apps/Sudoku/Games Easy1.sku,NONE,1.1 Easy10.sku,NONE,1.1 Easy2.sku,NONE,1.1 Easy3.sku,NONE,1.1 Easy4.sku,NONE,1.1 Easy5.sku,NONE,1.1 Easy6.sku,NONE,1.1 Easy7.sku,NONE,1.1 Easy8.sku,NONE,1.1 Easy9.sku,NONE,1.1 Expert1.sku,NONE,1.1 Expert10.sku,NONE,1.1 Expert2.sku,NONE,1.1 Expert3.sku,NONE,1.1 Expert4.sku,NONE,1.1 Expert5.sku,NONE,1.1 Expert6.sku,NONE,1.1 Expert7.sku,NONE,1.1 Expert8.sku,NONE,1.1 Expert9.sku,NONE,1.1 Extreme1.sku,NONE,1.1 Extreme10.sku,NONE,1.1 Extreme2.sku,NONE,1.1 Extreme3.sku,NONE,1.1 Extreme4.sku,NONE,1.1 Extreme5.sku,NONE,1.1 Extreme6.sku,NONE,1.1 Extreme7.sku,NONE,1.1 Extreme8.sku,NONE,1.1 Extreme9.sku,NONE,1.1 Hard1.sku,NONE,1.1 Hard10.sku,NONE,1.1 Hard2.sku,NONE,1.1 Hard3.sku,NONE,1.1 Hard4.sku,NONE,1.1 Hard5.sku,NONE,1.1 Hard6.sku,NONE,1.1 Hard7.sku,NONE,1.1 Hard8.sku,NONE,1.1 Hard9.sku,NONE,1.1 Standard1.sku,NONE,1.1 Standard10.sku,NONE,1.1 Standard2.sku,NONE,1.1 Standard3.sku,NONE,1.1 Standard4.sku,NONE,1.1 Standard5.sku,NONE,1.1 Standard6.sku,NONE,1.1 Standard7.sku,NONE,1.1 Standard8.sku,NONE,1.1 Standard9.sku,NONE,1.1

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Sudoku/Games
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1760/apps/Sudoku/Games

Added Files:
	Easy1.sku Easy10.sku Easy2.sku Easy3.sku Easy4.sku Easy5.sku 
	Easy6.sku Easy7.sku Easy8.sku Easy9.sku Expert1.sku 
	Expert10.sku Expert2.sku Expert3.sku Expert4.sku Expert5.sku 
	Expert6.sku Expert7.sku Expert8.sku Expert9.sku Extreme1.sku 
	Extreme10.sku Extreme2.sku Extreme3.sku Extreme4.sku 
	Extreme5.sku Extreme6.sku Extreme7.sku Extreme8.sku 
	Extreme9.sku Hard1.sku Hard10.sku Hard2.sku Hard3.sku 
	Hard4.sku Hard5.sku Hard6.sku Hard7.sku Hard8.sku Hard9.sku 
	Standard1.sku Standard10.sku Standard2.sku Standard3.sku 
	Standard4.sku Standard5.sku Standard6.sku Standard7.sku 
	Standard8.sku Standard9.sku 
Log Message:
Rod: added files for Sudoku game

--- NEW FILE: Standard3.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert3.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme7.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme8.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme6.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme4.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy10.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme2.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert2.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy7.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme1.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme10.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard4.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard6.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard2.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard1.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard7.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme9.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy3.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard3.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard10.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert10.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy9.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard5.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy1.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard9.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard2.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy2.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard8.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard10.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard1.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy6.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert1.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme5.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard6.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy5.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard8.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert5.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard4.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy4.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert9.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard5.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert8.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Standard7.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert7.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Hard9.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert4.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Expert6.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Extreme3.sku ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: Easy8.sku ---
(This appears to be a binary file; contents omitted.)

[Win32forth-cvs] win32forth/apps/Sudoku/Res - New directory

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Sudoku/Res
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32222/Res

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/Sudoku/Res added to the repository

[Win32forth-cvs] win32forth/apps/Sudoku/Games - New directory

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Sudoku/Games
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32155/Games

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/Sudoku/Games added to the repository

[Win32forth-cvs] win32forth/apps/Sudoku - New directory

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Sudoku
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32042/Sudoku

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/Sudoku added to the repository

[Win32forth-cvs] win32forth/apps/ProMgr RecentFiles.f,1.1,NONE RegistrySupport.f,1.1,NONE

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/ProMgr
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9681/apps/ProMgr

Removed Files:
	RecentFiles.f RegistrySupport.f 
Log Message:
Moved RecentFiles.f and RegistrySupport.f into the src\lib - folder were they should be.

--- RegistrySupport.f DELETED ---

--- RecentFiles.f DELETED ---

[Win32forth-cvs] win32forth/src/lib multiopen.f,1.2,1.3

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5310/src/lib

Modified Files:
	multiopen.f 
Log Message:
Increased the file buffer

Index: multiopen.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/multiopen.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** multiopen.f	1 May 2005 06:27:42 -0000	1.2
--- multiopen.f	1 Oct 2005 16:57:26 -0000	1.3
***************
*** 8,11 ****
--- 8,13 ----
  \- ofn-struct  create ofn-struct 19 cells , 22 CELLS allot       \ OPENFILENAME struct
  
+ 12048 constant  /szFile  \ Was 2048
+ 
  #ifndef fdlg-filter
  
***************
*** 28,32 ****
          ofn-struct 11 cells+ !                        \ save initial dir
          ofn-struct 7 cells+ !                         \ save initial filename
!         2048  ofn-struct  8 cells+ !                  \ file length
          ofn-struct 6  cells+ !                        \ filterindex
          [ OFN_PATHMUSTEXIST   OFN_FILEMUSTEXIST OR  nostack1
--- 30,34 ----
          ofn-struct 11 cells+ !                        \ save initial dir
          ofn-struct 7 cells+ !                         \ save initial filename
!         /szFile  ofn-struct  8 cells+ !               \ file length
          ofn-struct 6  cells+ !                        \ filterindex
          [ OFN_PATHMUSTEXIST   OFN_FILEMUSTEXIST OR  nostack1
***************
*** 55,59 ****
  :Class MultiFileOpenDialog   <Super  Object
  
! 2048 bytes szFile
  int fcnt    \ number of selected files
  int filterndx
--- 57,61 ----
  :Class MultiFileOpenDialog   <Super  Object
  
! /szFile bytes szFile
  int fcnt    \ number of selected files
  int filterndx
***************
*** 65,69 ****
          ClassInit: super
          0 szDir !
!         szfile 2048 erase
          1 to filterndx
          0 to fcnt
--- 67,71 ----
          ClassInit: super
          0 szDir !
!         szfile /szFile erase
          1 to filterndx
          0 to fcnt
***************
*** 154,156 ****
  
  ;Class
! MODULE

[Win32forth-cvs] win32forth/src/lib RecentFiles.f,NONE,1.1 RegistrySupport.f,NONE,1.1

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9681/src/lib

Added Files:
	RecentFiles.f RegistrySupport.f 
Log Message:
Moved RecentFiles.f and RegistrySupport.f into the src\lib - folder were they should be.

--- NEW FILE: RegistrySupport.f ---
\ $Id: RegistrySupport.f,v 1.1 2005/10/02 09:07:36 dbu_de Exp $

\ RegistrySupport.f       Extensions to the words in Registry.f  by Rod Oakford
\                   July 20th, 2004   Works in v6.09.xx and later

\                   SetRegistryValue and GetRegistryValue are like
\                   RegSetString and RegGetString except that they take
\                   an extra parameter RegType.  For REG_DWORD the integer value
\                   is returned and the length is 4.  For REG_BINARY and REG_SZ
\                   address and length are returned.  The registry key no longer
\                   includes "Settings" but any key name can be set in progreg.
\                   Values are set in the key HKEY_CURRENT_USER\Software\<progreg>

\                   Words are also included to save and restore sets of registry entries.
\                   A registry entry requires:
\                   Address, Length, DefaultAddress, DefaultLength, Reg Type and Reg Value Name
\                   For REG_DWORD length is omitted and default value is just an integer.
\                   For REG_SZ the address of a counted string and the max length that
\                   will be returned (to prevent a buffer overrun) are needed in address,
\                   the default value needs address and length.
\                   For REG_BINARY address and length are needed for both address and default.
\                   Please see the example at the end of this file.
\                   The address of Height, Width, OriginX, and OriginY in an object derived
\                   from class Window are 12, 16, 20 and 24 bytes offset from the object address.
\                   The address of the integer stored in a "value" is  ' <value> 4 +


cr .( Loading Registry Support...)

INTERNAL

[UNDEFINED] Messagebox [IF]   \ must not be MessageBox in v6.09.08 or Windows procedure is found
: MessageBox ( szText szTitle style hOwnerWindow -- result )
            >r  -rot  swap  r>
            Call MessageBox ;
[THEN]

0 value RegistryTable    \ address of current registry table in dictionary
0 value CurrentSet       \ address of data in current registry entries set
0 value RegEntries       \ number of registry entries in current set
0 value CurrentRegEntry  \ index of registry entry in registry table
50 value MaxLength       \ the maximum length of a ValueName incl null (clipped if longer)
                         \ 50 makes a reg entry 64 bytes long ( 50 + count + 13 )
: RegistryTableEntry ( n -- a )   RegistryTable CurrentRegEntry MaxLength 14 + * + + MaxLength + ;
: ValueName ( -- a n )      MaxLength negate RegistryTableEntry count ;
: RegistryType ( -- n )     1 RegistryTableEntry c@ ;
: DefaultLength ( -- n )    2 RegistryTableEntry w@ ;
: DefaultAddress ( -- a )   4 RegistryTableEntry  @ ;
: Length ( -- n )           8 RegistryTableEntry w@ ;
: Address ( -- a )          10 RegistryTableEntry @ ;
: UpdateAddress ( a n -- )
        RegistryType
        Case
            REG_DWORD   of  drop Address !            endof
            REG_BINARY  of  drop Address Length move  endof
            ( REG_SZ default )  -rot  Length min  Address place
        EndCase
        ;
: SetCurrentRegSet ( a -- )   dup to CurrentSet  dup @ to RegEntries
        cell+ dup @ to RegistryTable  cell+ count progreg place ;

EXTERNAL

: SetRegistryValue  { a1 n1 a2 n2 RegType \ khdl -- }   \ a1,n1=value string, a2,n2=key string
        0 0 RegGetKey to khdl                 \ no s" settings", include in progreg if needed
        khdl -1 = IF  EXIT  THEN              \ just return, ignore error
        a1 n1 asciiz                          \ null-terminate value string
        RegType REG_SZ = IF  1 +to n1  THEN   \ include null in count for REG_SZ
        n1 swap
        RegType
        0 a2  2dup n2 + c!                    \ null-terminate key string
        khdl Call RegSetValueEx drop
        khdl Call RegCloseKey drop
        ;

: GetRegistryValue ( a1 n1 RegType -- a2 n2 )            \ a1,n1=key string, a2,n2=value string
        >r  0 0 RegGetString                             \ n2=0 if key not found
        RegType @
        Case
            REG_DWORD   of  drop @  RegLen @  endof      \ for REG_DWORD a2=the value, n2=4
            REG_BINARY  of  drop    RegLen @  endof      \ no extra 0 in length
            ( REG_SZ default )
        EndCase
        dup r> RegType @ = not and
        IF                                               \ RegType not as requested and n2>0
            z" Registry type different"
            z" GetRegistrySetting"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
        THEN
        ;

: RegistrySet ( a n <name> -- )   \ creates a new named registry entries set
        Create  here >r  ( RegEntries ) 0 ,  ( RegistryTable ) 0 ,  ( s" KeyName" ) dup c, Z",
                here r@ cell+ !  r> SetCurrentRegSet
        Does> ( -- )   SetCurrentRegSet ;

: Entries ( -- )    here CurrentSet cell+ !  0 to RegEntries ;

: RegEntry  ( Address a [n]  Default a [n]  RegistryType n  <"RegValueName"> -- )
        MaxLength
        here ,"Text"
        dup c@ MaxLength min over c!   \ clip RegValueName to MaxLength characters incl null
        here - + 1+ allot              \ allot for counted string and null (MaxLength 1+)
        dup c,
        REG_DWORD = IF  4 swap 4  THEN
        w, , w, ,
        1 +to RegEntries
        ;

: EndEntries ( -- )   RegEntries CurrentSet ! ;

: SaveSettings ( -- )
        RegEntries 0 ?DO
            i to CurrentRegEntry
            Address Length
            RegistryType REG_SZ = IF  drop count  THEN
            ValueName RegistryType SetRegistryValue
        LOOP
        ;

: DefaultSettings ( -- )
        RegEntries 0 ?DO
            i to CurrentRegEntry
            DefaultAddress DefaultLength
            UpdateAddress
        LOOP
        ;

: RestoreSettings ( -- )
        RegEntries 0 ?DO
            i to CurrentRegEntry
            ValueName RegistryType GetRegistryValue
            RegType @ REG_SZ REG_DWORD between  over or 0= IF  2drop DefaultAddress DefaultLength  THEN
            UpdateAddress
        LOOP
        ;

: DeleteKey ( -- )   \ deletes key HKEY_CURRENT_USER\Software\<progreg>
        basereg count pad place   \ Software\
        progreg count pad +place   \ user defined key
        pad count asciiz
        HKEY_CURRENT_USER Call RegDeleteKey
        IF
            s" Unable to delete " pad place
            progreg count pad +place
            pad count asciiz
            z" DeleteKey"
            MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop
        THEN
        ;

MODULE


\s

\ RegistryExample
\               An example on how to save Window and other settings in the registry by Rod Oakford
\               Fload this file, resize the window, close the window, window settings are saved.

\             1.  Near the beginning of an application define some sets of registry entries that
\               you will want to save and restore e.g.
\               s" MyName\MyApp\WindowPlacement" RegistrySet WindowSettings
\               These sets are initially empty but contain the registry key name.  This is placed
\               in progreg when the "RegSetName" e.g. WindowSettings is executed and values are saved
\               (or restored) in the key HKEY_CURRENT_USER\Software\<progreg>

\             2.  Near the end of the application add specific entries to these sets then SaveSettings,
\               DefaultSettings and RestoreSettings will work.

\               A registry entry contains an address of the bytes to save, a default value which
\               will be used if the key is not found, the type of registry entry (REG_DWORD, REG_BINARY
\               or REG_SZ) and the name of the registry setting value.  A set of registry enties is
\               stored in a Registry table in the dictionary which is selected when "RegSetName" is
\               executed.

\               NOTE if you set a menu with MyMenu SetMenuBar: self you must also
\               override the late bound method WindowHasMenu: to return TRUE
\               otherwise the start size of the window will be wrong.  Even so
\               the height will still be wrong if the menu wraps to two or more rows.
\               (AdjustWindowRect does not take this into account)
\               It is better to use MyMenu to CurrentMenu in ClassInit:
\               otherwise you are setting the default menu then replacing it.


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ **********EXAMPLE**********
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ Needs RegistrySupport


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\       Define two registry sets
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

s" MyName\MyApp\Window"   RegistrySet WindowSettings
s" MyName\MyApp\Options"  RegistrySet Options


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\       Define a simple window
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

0 value WindowState

:Object Frame   <Super Window

:M ClassInit:
        ClassInit: super
\        MyMenu to CurrentMenu
        ;M

:M WindowHasMenu: ( -- f )   True ;M   \ default menu will be displayed if another is not set

:M On_Size: ( h m w -- h m w )
        dup to WindowState   \ get WindowState, don't save size of maximised or minimised window
        ;M

:M On_Done:
        MenuHandle: CurrentMenu Call DestroyMenu drop   \ need to destroy menu in v6.09
        ZeroMenu: CurrentMenu                           \ otherwise window won't open again
        On_Done: super
        WindowState SIZE_RESTORED = IF  WindowSettings SaveSettings  THEN
        Options SaveSettings
        ;M

;Object


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\       Some other values to save and restore
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Create Title ," Window Title"   \ limited later to 9 characters in Options entries
Create DefTitle ," Default"
Create BinaryData  -1 , -1 ,
Create DefaultBin  1 c, 2 c, 3 c, 4 c, 5 c, 6 c, 7 c, 8 c,
False value Toolbar?


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\       Registry settings
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

WindowSettings entries
\ Address        Length    Default Value    Reg Type                Reg Value Name
Frame 12 +       ( 4 )     300              REG_DWORD     RegEntry  "WindowWidth"
Frame 16 +                 200              REG_DWORD     RegEntry  "WindowHeight"
Frame 20 +                 100              REG_DWORD     RegEntry  "WindowLeft"
Frame 24 +                 100              REG_DWORD     RegEntry  "WindowTop"
EndEntries

Options entries
\ Address        Length    Default Value    Reg Type                Reg Value Name
' Toolbar? 4 +   ( 4 )     True             REG_DWORD     RegEntry  "Toolbar?"
Title            9         DefTitle count   REG_SZ        RegEntry  "Title"
BinaryData       8         DefaultBin 8     REG_BINARY    RegEntry  "BinaryData"
EndEntries


: go
        WindowSettings RestoreSettings
        Start: frame
        Title count SetText: frame
        ;
go


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\       Other testing words
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

: Close ( -- )   Close: frame ;

: ShowData ( -- )
        cr ." Window: "  Frame 12 + ?  Frame 16 + ?  Frame 20 + ?  Frame 24 + ?
        cr ." Title: "  Title count type
        cr ." Binary: "  BinaryData  8 0 DO  dup i + c@ .  LOOP  drop
        cr ." Toolbar: "  Toolbar?  IF  ." True"  ELSE  ." False"  THEN
        ;

: Open ( -- )
        WindowSettings RestoreSettings
        Options RestoreSettings
        Start: frame
        Title count SetText: frame
        ShowData
        ;

: Default ( -- )
        WindowSettings DefaultSettings
        Options DefaultSettings
        Start: frame
        Title count SetText: frame
        ShowData
        ;

: S1 ( -- )   WindowSettings  SaveSettings ;
: S2 ( -- )   Options  SaveSettings ;
: N1 ( -- )   BinaryData 8 erase  s" New Title" Title place
                false to Toolbar?  S2  open ;
: N2 ( -- )   BinaryData 8 -1 fill  s" Old Title" Title place
                true to Toolbar?  S2  open ;
: D1 ( -- )   WindowSettings  DeleteKey ;
: D2 ( -- )   Options  DeleteKey ;

comment:

DeleteKey should be fairly safe as it will not delete keys containing subkeys.
To delete MyName from the registry entirely delete Window, Options then MyApp first:

s" MyName" RegistrySet MyName
s" MyName\MyApp" RegistrySet MyApp
WindowSettings DeleteKey
Options DeleteKey
MyApp DeleteKey
MyName DeleteKey

comment;

--- NEW FILE: RecentFiles.f ---
\ $Id: RecentFiles.f,v 1.1 2005/10/02 09:07:36 dbu_de Exp $

\ RecentFiles.f         RecentFiles class by Rod Oakford
\                       July 2003
\
\                       Use when defining menuitems before a MenuSeparator, usually on the File menu e.g.
\           POPUP "&File"
\               MENUITEM     "Page Set&up..."   ( word to do Page Setup )            ;
\               9 RECENTFILES   RecentFiles  ( -- FileName$ )  ( word to open file ) ;
\               MENUSEPARATOR
\               MENUITEM     "E&xit  \tAlt-F4"  bye                                  ;
\
\               9 RECENTFILES RecentFiles creates an object of the class RECENTFILES with space for 9 menuitems
\               You can use the following methods:
\               FileName$  Insert: RecentFiles  to add FileName to the top of the list and push the others down
\               Number  SetNumber: RecentFiles  to set the max number of Files shown in the list (max 9 in this case)
\               nth GetRecentFile: RecentFiles  to get the nth FileName$ in the list


cr  .( Loading RecentFiles class...)

INTERNAL

:Class  RECENTFILES  <Super MENUITEMS
int mfunc               \ the menu function
int AllocatedFiles      \ Maximum number of recent files allocated for
int MaxFiles            \ Largest number of recent files saved on file menu
int NumberOfFiles       \ Menu separator is removed if no recent files
int FirstPos            \ Pos of first recent file on file menu

: WithoutFileNumber ( text$ -- text$ )  dup c@ 3 - 0 max >r  3 +  r> over c! ;

:M DoMenu:   { ID \ Text$ -- }
        ID mid mid MaxFiles + within
        IF
            MAXSTRING LocalAlloc: Text$
            MF_BYCOMMAND MAXSTRING Text$ 1+
            ID popid Call GetMenuString Text$ c!
            Text$ WithoutFileNumber  mfunc execute-menufunc
        THEN
        ;M

:M ClassInit: ( n -- )   \ allot n menu IDs to recent files
        dup to AllocatedFiles to MaxFiles
        ClassInit: Super
        here to mfunc
        hide !csp docol , ]
        AllocatedFiles 1- +to IDcounter
        ;M

:M LoadMenu: ( pid parent -- )   \ don't add anything to menu
        to parent to popid
        popid Call GetMenuItemCount 1+ to FirstPos
        0 to NumberOfFiles
        ;M

int ID
int Pos
:M Reset: { \ Text$ -- }    \ Numbers recent files and deletes any more than allowed
    NumberOfFiles           \ There must be a menu separator before any further menu items
    IF
        MAXSTRING LocalAlloc: Text$
        FirstPos to Pos
        BEGIN
            MF_BYPOSITION MAXSTRING Text$ 1+
            Pos popid Call GetMenuString dup Text$ c!
        WHILE
            Pos FirstPos MaxFiles + <
            IF
                Pos FirstPos - 49 + Text$ 2 + c!  Text$ 1+ mid Pos + FirstPos -
                MF_BYPOSITION Pos popid Call ModifyMenu drop 1 +to Pos
            ELSE
                MF_BYPOSITION Pos popid Call DeleteMenu drop  -1 +to NumberOfFiles
            THEN
        REPEAT
        MF_BYPOSITION MAXSTRING Text$ 1+ FirstPos popid Call GetMenuString 0=
        IF                  \ Remove second separator if no recent files
            MF_BYPOSITION FirstPos 1- popid Call DeleteMenu drop
        THEN
    THEN
        ;M

:M Insert:   { FileName$  \ MenuText$ Text$ -- }   FileName$ c@
    IF
        MAXSTRING LocalAlloc: MenuText$
        s" &1 " MenuText$ place FileName$ count MenuText$ +place MenuText$ +NULL
        MAXSTRING LocalAlloc: Text$
        NumberOfFiles 0=
        IF                  \ Insert second separator if no recent files
            0 0 MF_BYPOSITION MF_SEPARATOR or FirstPos 1- popid Call InsertMenu drop
        THEN
        mid to ID
        BEGIN
            MF_BYCOMMAND MAXSTRING Text$ 1+
            ID popid Call GetMenuString  Text$ c!
            Text$ WithoutFileNumber count  FileName$ count  CAPS-COMPARE
            IF
                -1
            ELSE
                MF_BYCOMMAND ID popid Call DeleteMenu drop  -1 +to NumberOfFiles  0
            THEN
            ID mid MaxFiles 1- + < and   \ Text$ contains menutext of last recent file
        WHILE                            \ or menutext of matched file
            1 +to ID                     \ or 0 if last Pos is empty and no match
        REPEAT                           \ insert filename with ID of match or last recent file
        MenuText$ 1+  ID MF_BYPOSITION FirstPos popid Call InsertMenu drop
        1 +to NumberOfFiles
        Reset: self
    THEN
        ;M

:M SetNumber: ( n -- )
        AllocatedFiles min to MaxFiles
        Reset: self
        ;M

:M GetRecentFile: { Index -- FileName$ }
        Index 1 NumberOfFiles between
        IF
            MF_BYPOSITION MAXSTRING temp$ 1+
            Index FirstPos + 1- popid Call GetMenuString
        ELSE
            0
        THEN
        temp$ c! temp$ WithoutFileNumber
        ;M

;Class

MODULE

[Win32forth-cvs] win32forth/apps/Player4 Catalog.f,1.10,1.11 Mediatree.f,1.12,1.13 PLAYER4.F,1.21,1.22

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Player4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17661/apps/Player4

Modified Files:
	Catalog.f Mediatree.f PLAYER4.F 
Log Message:
- Optimized drag/dropping files into the catalog.
- Now old deleted records will be used first before extending the database.

Index: PLAYER4.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** PLAYER4.F	29 Sep 2005 16:46:06 -0000	1.21
--- PLAYER4.F	1 Oct 2005 12:57:38 -0000	1.22
***************
*** 80,86 ****
          MENUITEM     "&Import directory tree...\tCtrl+I"  'I' +k_control pushkey ;
          MENUITEM     "S&earch and make a collection..." SearchCatalog  ;
          MENUITEM     "&Start/Resume playing\tCtrl+R"      'R' +k_control pushkey ;
  
-        
          SUBMENU      "S&ort"
             MENUITEM  "Se&t maximum random level"        SetRandomLevel   ;
--- 80,87 ----
          MENUITEM     "&Import directory tree...\tCtrl+I"  'I' +k_control pushkey ;
          MENUITEM     "S&earch and make a collection..." SearchCatalog  ;
+         MENUSEPARATOR
          MENUITEM     "&Start/Resume playing\tCtrl+R"      'R' +k_control pushkey ;
+         MENUSEPARATOR
  
          SUBMENU      "S&ort"
             MENUITEM  "Se&t maximum random level"        SetRandomLevel   ;

Index: Mediatree.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Mediatree.f	29 Sep 2005 16:46:06 -0000	1.12
--- Mediatree.f	1 Oct 2005 12:57:38 -0000	1.13
***************
*** 37,41 ****
  
  :M FillTreeView:  ( -- )
!                 0  to last-selected-rec
                  tvins  /tvins  erase
                  tvitem /tvitem erase
--- 37,41 ----
  
  :M FillTreeView:  ( -- )
!                 0 to last-selected-rec
                  tvins  /tvins  erase
                  tvitem /tvitem erase
***************
*** 94,114 ****
   ;
  
! : AddDropFiles {  wParam lParam \ drop$ #File wHndl -- res }
          SetForegroundWindow: self
          MAXCOUNTED 1+ LocalAlloc: drop$
          0 to #File
!         0 0 -1 wParam  Call DragQueryFile  ?dup
             if  datfile$ count file-exist? check-config
!                database$  create/open dup file-append throw to wHndl
!                    begin    MAXCOUNTED drop$ #File wParam Call DragQueryFile dup 0>
                     while    wHndl drop$ rot AddDropFile   1 +to #File
                     repeat
            then
!         2drop wParam Call DragFinish
          wHndl CloseReMap
          RefreshCatalog ;
  
! :M WM_DROPFILES ( wParam lParam -- res )
!         AddDropFiles  ;M
  
  : CreateTreeView   ( -- ) \ create a treeview window
--- 94,115 ----
   ;
  
! : AddDropFiles {  hDrop \ drop$ #File wHndl -- res }
          SetForegroundWindow: self
+         wait-cursor
          MAXCOUNTED 1+ LocalAlloc: drop$
          0 to #File
!         0 0 -1 hDrop  Call DragQueryFile  ?dup
             if  datfile$ count file-exist? check-config
!                database$ create/open dup file-append throw to wHndl
!                    begin    MAXCOUNTED drop$ #File hDrop Call DragQueryFile dup 0>
                     while    wHndl drop$ rot AddDropFile   1 +to #File
                     repeat
            then
!         2drop hDrop Call DragFinish
          wHndl CloseReMap
          RefreshCatalog ;
  
! :M WM_DROPFILES ( hDrop lParam -- res )
!         drop AddDropFiles  ;M
  
  : CreateTreeView   ( -- ) \ create a treeview window

Index: Catalog.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Catalog.f	29 Sep 2005 16:46:06 -0000	1.10
--- Catalog.f	1 Oct 2005 12:57:38 -0000	1.11
***************
*** 100,108 ****
   ;
  
- : write-record ( wHndl - )
-    InlineRecord [ sizeof RecordDef ] literal rot 
-    write-file abort" Can't save record"
-  ;
- 
  : type-space    ( adr cnt -  )   type space  ;
  : type-cr       ( adr cnt -  )   type cr  ;
--- 100,103 ----
***************
*** 169,173 ****
    ;
  
! : get-a-record-from-the-free-list   ( - n )
      vadr-config dup>r first-free-record  @
      r@ next-in-freelist r@ first-free-record ! r>record
--- 164,168 ----
    ;
  
! : get-a-record-from-the-free-list   ( - adr )
      vadr-config dup>r first-free-record  @
      r@ next-in-freelist r@ first-free-record ! r>record
***************
*** 176,179 ****
--- 171,182 ----
    ;
  
+ : write-record ( wHndl - )    \ Recycle deleted records first.
+    InlineRecord [ sizeof RecordDef ] literal
+    vadr-config #free-list @
+     if     get-a-record-from-the-free-list swap cmove drop
+     else   rot write-file abort" Can't save record"
+     then
+  ;
+ 
  : build-free-list   ( - )
      0 vadr-config  #free-list !
***************
*** 181,185 ****
   ;
  
! : delete-record   ( n - )
     dup true swap n>record dup>r RecordDef Deleted- c!
     0 r> RecordDef Excluded- c!
--- 184,188 ----
   ;
  
! : delete-record   ( n - )  
     dup true swap n>record dup>r RecordDef Deleted- c!
     0 r> RecordDef Excluded- c!

[Win32forth-cvs] win32forth/src Dc.f,1.5,1.6

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24685/src

Modified Files:
	Dc.f 
Log Message:
Added Polyline: and removed a duplicated definition of FillPath:
as suggested by David R Pochin in Forthwrite 127 (December 2004).

Index: Dc.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Dc.f	29 Aug 2005 15:56:27 -0000	1.5
--- Dc.f	2 Oct 2005 07:25:36 -0000	1.6
***************
*** 185,189 ****
  \ Added Polygon: as suggested by Pierre Abbat
  :M Polygon:     ( ptr cnt - )
!         swap hDC Call Polygon ?win-error ;m
  
  :M PolyDraw:    ( tptr pptr cnt -- )
--- 185,194 ----
  \ Added Polygon: as suggested by Pierre Abbat
  :M Polygon:     ( ptr cnt - )
!         swap hDC Call Polygon	?win-error ;m
! 
! \ Samstag, Oktober 01 2005 dbu
! \ Added as suggested by David R Pochin in Forthwrite 127 (December 2004)
! :M Polyline:	( ptr cnt - )
!         swap hDC Call Polyline  ?win-error ;m
  
  :M PolyDraw:    ( tptr pptr cnt -- )
***************
*** 199,204 ****
          hDC Call StrokePath     ?win-error ;M
  
! :M FillPath:    ( -- )                  \ rls - new  ? Needs Brushes ?
!         hDC Call FillPath       ?win-error ;M
  
  :M StrokeAndFillPath:    ( -- )         \ rls - new  ? Needs Brushes ?
--- 204,211 ----
          hDC Call StrokePath     ?win-error ;M
  
! \ Samstag, Oktober 01 2005 dbu
! \ Removed as suggested by David R Pochin in Forthwrite 127 (December 2004)
! \ :M FillPath:    ( -- )                  \ rls - new  ? Needs Brushes ?
! \         hDC Call FillPath       ?win-error ;M
  
  :M StrokeAndFillPath:    ( -- )         \ rls - new  ? Needs Brushes ?
***************
*** 206,210 ****
  
  :M EndPath:     ( -- )
!         hDC Call EndPath       ?win-error ;M
  
  :M SetROP2:     ( mode -- oldmode )
--- 213,217 ----
  
  :M EndPath:     ( -- )
!         hDC Call EndPath       	?win-error ;M
  
  :M SetROP2:     ( mode -- oldmode )

[Win32forth-cvs] win32forth/doc p-index.htm,1.4,1.5

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/doc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9760/doc

Modified Files:
	p-index.htm 
Log Message:
Fixed the Link to "Programming Forth" by Stephen Pelc

Index: p-index.htm
===================================================================
RCS file: /cvsroot/win32forth/win32forth/doc/p-index.htm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** p-index.htm	27 Jun 2005 15:42:21 -0000	1.4
--- p-index.htm	1 Oct 2005 09:06:50 -0000	1.5
***************
*** 109,113 ****
    <img border="0" src="ONWEB.gif" width="16" height="16"> For the more advanced user (PDF format)</li>
  
!   <li><a href="http://www.mpeltd.demon.co.uk/arena/ProgramForth.pdf">Programming Forth</a> by <a href="mailto:sf...@mp...">Stephen Pelc</a>
    <img border="0" src="ONWEB.gif" width="16" height="16"> (PDF format)</li>
  
--- 109,113 ----
    <img border="0" src="ONWEB.gif" width="16" height="16"> For the more advanced user (PDF format)</li>
  
!   <li><a href="http://www.mpeforth.com/arena/ProgramForth.pdf">Programming Forth</a> by <a href="mailto:sf...@mp...">Stephen Pelc</a>
    <img border="0" src="ONWEB.gif" width="16" height="16"> (PDF format)</li>
  

[Win32forth-cvs] win32forth/apps/SciEdit RecentFiles.f,1.2,NONE

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/SciEdit
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9681/apps/SciEdit

Removed Files:
	RecentFiles.f 
Log Message:
Moved RecentFiles.f and RegistrySupport.f into the src\lib - folder were they should be.

--- RecentFiles.f DELETED ---

[Win32forth-cvs] win32forth/apps/Player4 Catalog.f,1.9,1.10 Mediatree.f,1.11,1.12 PLAYER4.F,1.20,1.21 Pl_Version.f,1.11,1.12

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Player4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18303/apps/Player4

Modified Files:
	Catalog.f Mediatree.f PLAYER4.F Pl_Version.f 
Log Message:
Jos: Made it possible to drag and drop files into de catalog.

Index: PLAYER4.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** PLAYER4.F	25 Sep 2005 14:27:42 -0000	1.20
--- PLAYER4.F	29 Sep 2005 16:46:06 -0000	1.21
***************
*** 535,538 ****
--- 535,539 ----
  \ build an application on disk or run Player
  \ -----------------------------------------------------------------------------
+ 
  turnkey? [if]
          false to MciDebug?

Index: Mediatree.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Mediatree.f	26 May 2005 08:29:29 -0000	1.11
--- Mediatree.f	29 Sep 2005 16:46:06 -0000	1.12
***************
*** 85,90 ****
  
  :M ExWindowStyle:    ( -- style )
!         ExWindowStyle: Super 
!         WS_EX_CLIENTEDGE or ;M
  
  : CreateTreeView   ( -- ) \ create a treeview window
--- 85,114 ----
  
  :M ExWindowStyle:    ( -- style )
!         ExWindowStyle: Super
!         WS_EX_CLIENTEDGE or
!         WS_EX_ACCEPTFILES or ;M
! 
! : AddDropFile ( wHndl adr cnt - )
!         2dup r/o  open-file  throw dup file-size  throw  d>s swap  close-file  throw
!         (add-file) drop
!  ;
! 
! : AddDropFiles {  wParam lParam \ drop$ #File wHndl -- res }
!         SetForegroundWindow: self
!         MAXCOUNTED 1+ LocalAlloc: drop$
!         0 to #File
!         0 0 -1 wParam  Call DragQueryFile  ?dup
!            if  datfile$ count file-exist? check-config
!                database$  create/open dup file-append throw to wHndl
!                    begin    MAXCOUNTED drop$ #File wParam Call DragQueryFile dup 0>
!                    while    wHndl drop$ rot AddDropFile   1 +to #File
!                    repeat
!           then
!         2drop wParam Call DragFinish
!         wHndl CloseReMap
!         RefreshCatalog ;
! 
! :M WM_DROPFILES ( wParam lParam -- res )
!         AddDropFiles  ;M
  
  : CreateTreeView   ( -- ) \ create a treeview window
***************
*** 148,150 ****
  \s
  
! 

[Win32forth-cvs] win32forth/doc/ProMgr prjFile Menu.gif,1.1,NONE prjHelp Menu.gif,1.1,NONE prjProject Menu.gif,1.1,NONE prjProject Window.gif,1.1,NONE

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/doc/ProMgr
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24975/doc/ProMgr

Removed Files:
	prjFile Menu.gif prjHelp Menu.gif prjProject Menu.gif 
	prjProject Window.gif 
Log Message:
Rod: removed old gifs for ProjectManager.htm

--- prjProject Window.gif DELETED ---

--- prjProject Menu.gif DELETED ---

--- prjFile Menu.gif DELETED ---

--- prjHelp Menu.gif DELETED ---

[Win32forth-cvs] win32forth/doc Preferences.gif,1.1,NONE

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/doc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11122/doc

Removed Files:
	Preferences.gif 
Log Message:
Remove some unneccessary files.

--- Preferences.gif DELETED ---

[Win32forth-cvs] win32forth/apps/ForthForm CONTROLPROPERTY.F,1.1,NONE CONTROLPROPERTYII.F,1.1,NONE CreateMenuForm.ff,1.1,NONE FORMPROPERTY.frm,1.1,NONE PREFERENCES.frm,1.1,NONE controlpropertyII.frm,1.1,NONE

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/ForthForm
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10929/apps/ForthForm

Removed Files:
	CONTROLPROPERTY.F CONTROLPROPERTYII.F CreateMenuForm.ff 
	FORMPROPERTY.frm PREFERENCES.frm controlpropertyII.frm 
Log Message:
Remove some unneccessary files.

--- CONTROLPROPERTY.F DELETED ---

--- PREFERENCES.frm DELETED ---

--- controlpropertyII.frm DELETED ---

--- CreateMenuForm.ff DELETED ---

--- FORMPROPERTY.frm DELETED ---

--- CONTROLPROPERTYII.F DELETED ---

[Win32forth-cvs] win32forth/src/kernel version.f,1.6,1.7

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/src/kernel
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2582/src/kernel

Modified Files:
	version.f 
Log Message:
Updated to match the new Version 6.11.06 on www.win32forth.org

Index: version.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/version.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** version.f	15 Sep 2005 16:36:09 -0000	1.6
--- version.f	26 Sep 2005 15:22:04 -0000	1.7
***************
*** 3,7 ****
  cr .( Loading META version info)
  
! 61105     VALUE #VERSION#
  
  \ Change only the version number above; the build number is automatically assigned.
--- 3,7 ----
  cr .( Loading META version info)
  
! 61106     VALUE #VERSION#
  
  \ Change only the version number above; the build number is automatically assigned.

[Win32forth-cvs] win32forth fkernel.exe,1.26,1.27 setup.exe,1.14,1.15

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2582

Modified Files:
	fkernel.exe setup.exe 
Log Message:
Updated to match the new Version 6.11.06 on www.win32forth.org

Index: setup.exe
===================================================================
RCS file: /cvsroot/win32forth/win32forth/setup.exe,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
Binary files /tmp/cvsPbLPsP and /tmp/cvs3MR1Ap differ

Index: fkernel.exe
===================================================================
RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
Binary files /tmp/cvsslby6O and /tmp/cvsMJUGip differ

[Win32forth-cvs] win32forth/src/lib MDI.F,1.4,1.5

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22456/win32forth/src/lib

Modified Files:
	MDI.F 
Log Message:
gah: removed int parent from MDIChildWindow class since it's now defined in class Window

Index: MDI.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/MDI.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** MDI.F	20 Jun 2005 07:40:47 -0000	1.4
--- MDI.F	26 Sep 2005 10:53:54 -0000	1.5
***************
*** 9,12 ****
--- 9,15 ----
  \         ( 0 @ returns 0 in v5.2 but in v6.09.07 causes an exception )
  
+ \         Monday, September 26 2005 removed parent from MDIChildWindow class since it's now
+ \         defined in Window class
+ 
  cr .( Loading Multiple Document Interface classes...)
  
***************
*** 91,95 ****
  
  \ :M WM_SIZE  ( h m w l -- f )   DefFrameProc ;M   \ remove if MDIClient window does not fill entire
!                                                    \ client area, use On_Size instead to Move: MDIClient 
  :M WM_MENUCHAR ( h m w l -- f )   DefFrameProc ;M
  :M WM_SETFOCUS ( h m w l -- f )   DefFrameProc ;M
--- 94,98 ----
  
  \ :M WM_SIZE  ( h m w l -- f )   DefFrameProc ;M   \ remove if MDIClient window does not fill entire
!                                                    \ client area, use On_Size instead to Move: MDIClient
  :M WM_MENUCHAR ( h m w l -- f )   DefFrameProc ;M
  :M WM_SETFOCUS ( h m w l -- f )   DefFrameProc ;M
***************
*** 138,145 ****
  
  int hChild
! :M GetFirstChild: ( -- hWndChild ) \ get handle of the first child window 
  	GW_CHILD MDIClient: self call GetWindow dup to hChild ;M
  
! :M GetNextChild: ( -- hWndChild ) \ get handle of the next child window 
  	GW_HWNDNEXT hChild call GetWindow dup to hChild ;M
  
--- 141,148 ----
  
  int hChild
! :M GetFirstChild: ( -- hWndChild ) \ get handle of the first child window
  	GW_CHILD MDIClient: self call GetWindow dup to hChild ;M
  
! :M GetNextChild: ( -- hWndChild ) \ get handle of the next child window
  	GW_HWNDNEXT hChild call GetWindow dup to hChild ;M
  
***************
*** 147,151 ****
  	GetFirstChild: self ?dup
  	if   begin >r lParam wParam msg r> call SendMessage drop
! 		   GetNextChild: self dup 0=	
  	     until drop
  	then ;M
--- 150,154 ----
  	GetFirstChild: self ?dup
  	if   begin >r lParam wParam msg r> call SendMessage drop
! 		   GetNextChild: self dup 0=
  	     until drop
  	then ;M
***************
*** 154,158 ****
  	GetFirstChild: self ?dup
  	if   begin >r lParam wParam msg r> call PostMessage drop
! 		   GetNextChild: self dup 0=	
  	     until drop
  	then ;M
--- 157,161 ----
  	GetFirstChild: self ?dup
  	if   begin >r lParam wParam msg r> call PostMessage drop
! 		   GetNextChild: self dup 0=
  	     until drop
  	then ;M
***************
*** 167,172 ****
  :Class MDIChildWindow  <super Window
  
- int Parent
- 
  :M Classinit: ( -- )
          ClassInit: super
--- 170,173 ----
***************
*** 336,344 ****
  
  : DoMDIMsg ( pMsg f  -- pMsg f )
!         dup MDIClient: Frame 0<> and  
          IF
              drop dup MDIClient: Frame Call TranslateMDISysAccel 0=
!         THEN               
          ;
  msg-chain chain-add DoMDIMsg
- 

[Win32forth-cvs] win32forth/src/lib bitmap.f,1.4,1.5

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5874/src/lib

Modified Files:
	bitmap.f 
Log Message:
Further fix for the properties dialog bug in ForthForm.

Index: bitmap.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/bitmap.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** bitmap.f	24 Sep 2005 10:37:06 -0000	1.4
--- bitmap.f	26 Sep 2005 04:23:42 -0000	1.5
***************
*** 414,421 ****
  :M WM_LBUTTONUP     ( h w m l -- )
                      WM_LBUTTONUP WM: Super
                      hwnd  Call IsWindow
                      if    Paint: self
!                     then
!                     0 ;M
  
  :M WM_LBUTTONDBLCLK ( h m w l -- )
--- 414,423 ----
  :M WM_LBUTTONUP     ( h w m l -- )
                      WM_LBUTTONUP WM: Super
+                     \ make sure it is a valid window before try painting
+                     \ in case button is used to close parent
                      hwnd  Call IsWindow
                      if    Paint: self
!                     else  false to iflag     \ reset in button flag
!                     then  ;M
  
  :M WM_LBUTTONDBLCLK ( h m w l -- )

[Win32forth-cvs] win32forth/apps/ForthForm CreateToolBar.f,1.2,1.3 FORMOBJECT.F,1.6,1.7 Forms.frm,1.2,1.3

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/ForthForm
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3279/apps/ForthForm

Modified Files:
	CreateToolBar.f FORMOBJECT.F Forms.frm 
Log Message:
Removed the duplicate Parent since it is now defined in window.f

Index: FORMOBJECT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FORMOBJECT.F	21 Sep 2005 12:40:39 -0000	1.6
--- FORMOBJECT.F	25 Sep 2005 20:00:35 -0000	1.7
***************
*** 1422,1427 ****
                  if      s" MultiStatusBar TheStatusBar" append&crlf
                  then    GetSuperclass: self DIALOG-CLASS =      \ only for dialogwindow super class
!                 if  s" int parent   \ pointer to parent of form" append&crlf
!                     SaveScreen?
                      if  frmXPos (.) append 1 +spaces frmYPos (.) append
                          s"  2value XYPos  \ save screen location of form" append&crlf
--- 1422,1426 ----
                  if      s" MultiStatusBar TheStatusBar" append&crlf
                  then    GetSuperclass: self DIALOG-CLASS =      \ only for dialogwindow super class
!                 if  SaveScreen?
                      if  frmXPos (.) append 1 +spaces frmYPos (.) append
                          s"  2value XYPos  \ save screen location of form" append&crlf

Index: Forms.frm
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/Forms.frm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Forms.frm	21 Aug 2005 06:22:00 -0000	1.2
--- Forms.frm	25 Sep 2005 20:00:35 -0000	1.3
***************
*** 8,12 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  150 175 2value XYPos  \ save screen location of form
  
--- 8,11 ----
***************
*** 359,363 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  270 170 2value XYPos  \ save screen location of form
  
--- 358,361 ----
***************
*** 572,576 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  210 225 2value XYPos  \ save screen location of form
  
--- 570,573 ----
***************
*** 910,914 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  150 175 2value XYPos  \ save screen location of form
  
--- 907,910 ----
***************
*** 1452,1456 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  150 175 2value XYPos  \ save screen location of form
  
--- 1448,1451 ----
***************
*** 1580,1584 ****
  ' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
  ColorObject FrmColor      \ the background color 
- 0 value parent   \ pointer to parent of form
  150 175 2value XYPos  \ save screen location of form
  
--- 1575,1578 ----

Index: CreateToolBar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CreateToolBar.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** CreateToolBar.f	21 Aug 2005 06:22:00 -0000	1.2
--- CreateToolBar.f	25 Sep 2005 20:00:35 -0000	1.3
***************
*** 6,10 ****
  
  int &bitmap
- int parent
  max-path bytes BitmapFile
  BitmapObject TheBitmap
--- 6,9 ----

[Win32forth-cvs] win32forth/src/lib toolbar.f,1.2,1.3

[Rod O. <rod...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16019/src/lib

Modified Files:
	toolbar.f 
Log Message:
Rod: changed Win32ToolBar Class to use Control instead of Child-Window

Index: toolbar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/toolbar.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** toolbar.f	10 Jun 2005 16:44:23 -0000	1.2
--- toolbar.f	25 Sep 2005 18:31:51 -0000	1.3
***************
*** 21,24 ****
--- 21,27 ----
  
          Change log:
+                 September 25th, 2005 - 18:59 - Rod
+                 Changed to use Control rather than Child-Window
+ 
                  September 22nd, 2003 - 16:11 - EAB
                  Corrected bug in On_GetButtonInfo: that was causing incorrect tooltips
***************
*** 295,299 ****
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
! :Class  Win32ToolBar    <super  Child-Window
  
          int ButtonTable
--- 298,302 ----
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
! :Class  Win32ToolBar    <super  Control
  
          int ButtonTable
***************
*** 328,355 ****
      Rectangle   ButtonRect
  
- 
- \ -------------------- Create Tool-bar Child Window --------------------
- 
- create toolbar-class   z," ToolbarWindow32"     \ Pre-registered class
- 
- : create-toolbar ( -- hWnd )
-                 \ Make sure Common Controls are loaded
-                 ICC_BAR_CLASSES 8 sp@ Call InitCommonControlsEx 3drop
-                 NULL                            \ Creation parameter
-                 appInst                         \ Instance handle
-                 id                              \ Child id
-                 Parent conhndl =
-                 if   conhndl
-                 else GetHandle: Parent          \ parent window handle
-                 then
-                 0 0                             \ Size h,w
-                 0 0                             \ Position y,x
-                 WindowStyle: [ self ]           \ Style
-                 NULL                            \ Window name
-                 toolbar-class                   \ Pre-registered class
-                 0                               \ Extended style
-                 Call CreateWindowEx
-                 ;
- 
  : register-struct-size ( -- )
                  \ Register tbb structure size
--- 331,334 ----
***************
*** 369,373 ****
  
  :M On_Init:     ( -- )
!                 On_Init: super
                  ;M
  
--- 348,365 ----
  
  :M On_Init:     ( -- )
!                 ;M
! 
! :M WM_CREATE
!                 On_Init: [ self ]
!                 0
!                 ;M
! 
! :M On_Done:     ( -- )
!                 ;M
! 
! :M WM_DESTROY
!                 On_Done: [ self ]
!                 old-wndproc CallWindowProc
!                 0 to hWnd
                  ;M
  
***************
*** 383,387 ****
                  else
                          to Parent
!                         create-toolbar to hWnd
                          register-struct-size
  
--- 375,379 ----
                  else
                          to Parent
!                         z" ToolbarWindow32" Create-Control 
                          register-struct-size