[Win32forth-cvs] win32forth-stc/src/lib ButtonBar.f, NONE, 1.1 Buttons.f, NONE, 1.1 Calendar.f, NONE, 1.1 Label.f, NONE, 1.1 ListBox.f, NONE, 1.1 ProgressBar.f, NONE, 1.1 RebarControl.f, NONE, 1.1 ScintillaControl.f, NONE, 1.1 ScintillaEdit.f, NONE, 1.1 ScrollBar.f, NONE, 1.1 StatusBar.f, NONE, 1.1 TabControl.f, NONE, 1.1 TextBox.f, NONE, 1.1 TrackBar.f, NONE, 1.1 TrayWindow.f, NONE, 1.1 UpDownControl.f, NONE, 1.1 excontrols.f, NONE, 1.1 sendmessage.f, NONE, 1.1 toolbar.f, NONE, 1.1 treeview.f, 1.1, 1.2

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

Update of /cvsroot/win32forth/win32forth-stc/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22070/win32forth-stc/src/lib

Modified Files:
	treeview.f 
Added Files:
	ButtonBar.f Buttons.f Calendar.f Label.f ListBox.f 
	ProgressBar.f RebarControl.f ScintillaControl.f 
	ScintillaEdit.f ScrollBar.f StatusBar.f TabControl.f TextBox.f 
	TrackBar.f TrayWindow.f UpDownControl.f excontrols.f 
	sendmessage.f toolbar.f 
Log Message:
gah:Added the axtension classes plus scintilla toolbars rebars etc.

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

--- NEW FILE: UpDownControl.f ---
\ $Id: UpDownControl.f,v 1.1 2007/05/08 08:31:46 georgeahubert Exp $

\ *D doc\classes\
\ *> Controls

anew -UpDownControl.f

WinLibrary COMCTL32.DLL

needs textbox.f

cr .( Loading UpDownControl Class...)

INTERNAL
EXTERNAL

\ ------------------------------------------------------------------------
\ *W <a name="UpDownControl"></a>
\ *S UpDownControl class
\ ------------------------------------------------------------------------
:Class UpDownControl	<Super Control
\ *G Up-Down control
\ *P An up-down control is a pair of arrow buttons that the user can click to
\ ** increment or decrement a value, such as a scroll position or a number displayed
\ ** in a companion control.
\ *P For 16 Bit values only.

int style

:M ClassInit:   ( -- )
\ *G Initialise the class.
                ClassInit: super
                0 to style ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is:
\ ** WS_BORDER, UDS_ARROWKEYS, UDS_SETBUDDYINT and UDS_ALIGNRIGHT.
		WindowStyle: super
		[ WS_BORDER UDS_ARROWKEYS OR UDS_SETBUDDYINT OR UDS_ALIGNRIGHT OR ] literal or
		style or ;M

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

:M Start:       ( Parent -- )
\ *G Create the control.
		to parent Z" msctls_updown32" create-control ;M

:M StartSize:	( -- cx cy )
\ *G default window size
		40 20 ;M

:M StartPos: 	( -- x y )
\ *G default window position
		0 0 ;M

:M SetBuddy:	( hBuddy -- )
\ *G Sets the buddy window for the up-down control.
		0 SWAP UDM_SETBUDDY SendMessage:SelfDrop ;M

:M GetValue: 	( -- n )
\ *G Retrieves the current position of the up-down control.
\ ** Note: This method ABORT's on error.
		0 0 UDM_GETPOS SendMessage:Self
		word-split ABORT" Up/Down Control read error"
		;M

:M SetValue:	( n -- )
\ *G Set the current position for the up-down control.
		0 word-join 0 UDM_SETPOS SendMessage:SelfDrop ;M

:M SetDecimal: 	( -- )
\ *G Sets the radix base for the control to decimal.
\ ** Decimal numbers are signed.
		0 10 UDM_SETBASE SendMessage:SelfDrop ;M

:M SetHex: 	( -- )
\ *G Sets the radix base for the control to hexadecimal.
\ ** Hexadecimal numbers are always unsigned.
		0 16 UDM_SETBASE SendMessage:SelfDrop ;M

:M GetBase: 	( -- n )
\ *G Get the current radix base (that is, either base 10 or 16).
		0 0 UDM_GETBASE SendMessage:Self ;M

:M SetRange: 	( lower upper -- )
\ *G Sets the minimum and maximum positions (range) the control.
\ ** Neither position can be greater than the UD_MAXVAL value or less than
\ ** the UD_MINVAL value. In addition, the difference between the two positions
\ ** cannot exceed UD_MAXVAL.
		swap word-join 0 UDM_SETRANGE SendMessage:SelfDrop ;M

:M GetRange: 	( -- lower upper )
\ *G Retrieves the minimum and maximum positions (range) for the control.
		0 0 UDM_GETRANGE SendMessage:Self word-split SWAP ;M

:M Enable:      ( f -- )
\ *G Enable the control.
                ID EnableDlgItem: parent ;M

:M Disable:     ( -- )
\ *G Disable the control.
                false Enable: self ;M

;Class
\ *G End of UpDownControl control

:Class SpinnerControl           <Super UpDownControl
TextBox TheBox

:m start:     ( parent -- )     \ both must have same parent
              dup Start: TheBox
              Start: super
              ;m

:m TheBox:   ( -- spinbox ) \ in case we need it directly for some reason
              Addr: TheBox ;m

:m Move:      ( x y w h -- )
              Move: TheBox
              \ allow the updowncontrol to move with the editcontrol
              GetHandle: TheBox SetBuddy: self ;m

:m SetFont:   ( hndl -- )
              Setfont: TheBox ;m

:M Close:     ( -- )
              Close: TheBox
              Close: self ;M
;class

MODULE

\ *Z

--- NEW FILE: TrayWindow.f ---
\    File: TrayWindow.f
\
\  Author: Dirk Busch (dbu)
\   Email: dir...@wi...
\
\ Created: Sonntag, April 24 2005 - dbu
\ Updated: Sonntag, Januar 15 2006 - dbu
\
\ *D doc\classes\
\ *! TrayWindow
\ *T TrayWindow class
\ *P Windows that are created with this class will hide themself
\ ** in the windows traybar when they are minimized.

Require window.f
Require control.f

cr .( Loading TrayWindow class...)

anew -TrayWindow.f

internal

#define NIM_ADD     0x00000000
#define NIM_MODIFY  0x00000001
#define NIM_DELETE  0x00000002

#define NIF_MESSAGE 0x00000001
#define NIF_ICON    0x00000002
#define NIF_TIP     0x00000004

2 proc Shell_NotifyIconA as Shell_NotifyIcon

external

\ *W <a name="TrayWindow"></a>
\ *S Glossary
:class TrayWindow <super window
\ *G TrayWindow class

Record: &NOTIFYICONDATA
        int   nid_cbSize
        int   nid_hWnd
        int   nid_uID
        int   nid_uFlags
        int   nid_uCallbackMessage
        int   nid_hIcon
     64 bytes nid_szTip
;RecordSize: sizeof(NOTIFYICONDATA)

:M DefaultIcon: ( -- hIcon )
\ *G Get the handle of the icon whitch should be added to the traybar.
        DefaultIcon: super ;M

:M GetTooltip:  ( -- addr len )
\ *G Get the tooltip text for the traybar icon.
        s" Tooltip text" ;M

:M GetID:       ( -- uID )
        1 ;M

:M GetFlags:    ( -- uFlags )
        [ NIF_ICON NIF_MESSAGE NIF_TIP or or ] literal ;M

WM_APP 1+ constant WM_CALLBACK_MESSAGE

: ShellNotifyIcon      ( n -- )
        &NOTIFYICONDATA swap call Shell_NotifyIcon drop ;

:M AddIcon:     ( -- )
\ *G Add our icon to the traybar
        NIM_ADD ShellNotifyIcon ;M

:M DeleteIcon:  ( -- )
\ *G Remove our icon from the traybar
        NIM_DELETE ShellNotifyIcon ;M

:M On_Init:     ( -- )
        On_Init: super

        sizeof(NOTIFYICONDATA) to nid_cbSize
        GetHandle: self        to nid_hWnd
        GetID: [ self ]        to nid_uID
        GetFlags: [ self ]     to nid_uFlags
        WM_CALLBACK_MESSAGE    to nid_uCallbackMessage
        DefaultIcon: [ self ]  to nid_hIcon
        GetTooltip: [ self ]   nid_szTip swap 64 min cmove
        ;M

:M On_Done:     ( -- )
        DeleteIcon: self
        On_Done: super ;M

:M IsVisible?:  ( -- f )
\ *G Check if the window is visible or not.
        GetHandle: self call IsWindowVisible ;M

:M ShowWindow:  ( -- )
\ *G Show the window and remove the icon from the traybar.
        IsVisible?: self 0=
        if   DeleteIcon: self
             SW_RESTORE Show: self Update: self
        then ;M

:M HideWindow:  ( -- )
\ *G Hide the window and add the icon to the traybar.
        IsVisible?: self
        if   SW_HIDE Show: self Update: self
             AddIcon: self
        then ;M

:M WM_SIZE      ( hWnd uMsg wParam lParam -- res )
\ *G Handle the WM_SIZE message. If the window is minimized
\ ** it will be hidden and the icon will be added to the traybar.
        over SIZE_MINIMIZED =
        if   HideWindow: [ self ]
        then WM_SIZE WM: super
        ;M

:M WM_SYSCOMMAND ( hWnd uMsg wParam lParam -- res )
\ *G Handle the WM_SYSCOMMAND message. If the window is minimized
\ ** it will be hidden and the icon will be added to the traybar.
        over SC_MINIMIZE =
        if   HideWindow: [ self ] 0
        else hWnd WM_SYSCOMMAND 2swap DefWindowProc: self
        then ;M

: TrackPopup    ( -- )
\ Open the popup menu of the window.
        CurrentPopup
        if   get-mouse-xy
             GetHandle: self Track: CurrentPopup
        then ;

:M On_IconNotify:       ( hWnd uMsg wParam lParam -- res )
\ *G Handle the messages from the traybar icon.
\ *P The default handler removes the icon for the traybar and shows the window,
\ ** when the user click's with the left mouse button on the tray icon.
\ *P If the right mouse button is used the popup menu of the window is shown.
\ ** Use the \b SetPopupBar: \d method to assign a popup menu to the window.
        case    WM_LBUTTONUP of ShowWindow: [ self ] endof
                WM_RBUTTONUP of TrackPopup           endof
        endcase 0 ;M

:M WM_CALLBACK_MESSAGE  ( hWnd uMsg wParam lParam -- res )
        On_IconNotify: [ self ] ;M

;class
\ *G End of TrayWindow class

module

\s

\ ----------------------------------------------------------------------------
\ *S Example
\ -----------------------------------------------------------------------------

\ *+

\ Create a tray window
:object TestWindow <super TrayWindow

:M GetTooltip:  ( -- addr len )
        s" TrayWindow Test" ;M

;object

           Start: TestWindow \ open the window
SW_MINIMIZE Show: TestWindow \ minimize it to hide it in the TrayBar
\ *-
\ *Z

--- NEW FILE: ScintillaEdit.f ---
\    File: ScintillaEdit.f
\
\  Author: Dirk Busch (dbu)
\   Email: dir...@wi...
\
\ Created: Mittwoch, Juni 09 2004 - dbu
\ Updated: Samstag, Juli 03 2004 - 10:52 - dbu
\
\ A wrapper class around the ScintillaControl class.
\ This Class can be used to build a real Editor around the control.

cr .( Loading Scintilla Window...)

ANEW -ScintillaEdit.f

needs ScintillaControl.f
needs file.f
\ needs RegistryWindowPos.f

\ ------------------------------------------------------------------------------
\ ------------------------------------------------------------------------------

INTERNAL

FileOpenDialog OpenFileDialog "Open Source File" "Forth Files (*.f,*.fs,*.4th,*.fth,*.seq)|*.f;*.fs;*.4th;*.fth;*.seq|All Files (*.*)|*.*"
FileSaveDialog SaveFileDialog "Save Source File" "Forth Files (*.f)|*.f|All Files (*.*)|*.*|"

NewEditDialog  FindTextDlg "Find Text" "Search for:" "Find" "" "Case Sensitive Search"


EXTERNAL

\ ------------------------------------------------------------------------------
\ ------------------------------------------------------------------------------

:Class ScintillaEdit <super ScintillaControl

ReadFile EditFile
create FindText$ MAXSTRING char+ allot
int FindMode
int CreateBackup?

fload ScintillaLexer.f

:M SetCaretBackColor:	( color -- )	\ value of zero turns it off effect
		dup 0=
		if	false SCI_SETCARETLINEVISIBLE hwnd send-window
		else	0 swap SCI_SETCARETLINEBACK hwnd send-window
			0 true SCI_SETCARETLINEVISIBLE hwnd send-window
		then	;M

:M SetColors:	( fore back -- )
		style_default rot stylesetfore: self
		style_default swap stylesetback: self
		0 0 SCI_STYLECLEARALL hwnd send-window
		InitLexer: [ self ]
		;M

:M InitLexer:   ( -- )
                SCLEX_FORTH SetLexer: self

                0 ANSKeywords  SetKeyWords: self
                1 commentStart SetKeyWords: self
                2 commentEnd   SetKeyWords: self
                3 UserWords1   SetKeyWords: self
                4 UserWords2   SetKeyWords: self
                5 UserWords3   SetKeyWords: self
                6 UserWords4   SetKeyWords: self
                7 UserWords5   SetKeyWords: self
                8 UserWords6   SetKeyWords: self

                SCE_FORTH_DEFAULT COL_FORTH_DEFAULT StyleSetFore: self
                SCE_FORTH_COMMENT COL_FORTH_COMMENT StyleSetFore: self
                SCE_FORTH_STRING  COL_FORTH_STRING  StyleSetFore: self
                SCE_FORTH_NUMBER  COL_FORTH_NUMBER  StyleSetFore: self
                SCE_FORTH_LOCALS  COL_FORTH_LOCALS  StyleSetFore: self
                SCE_FORTH_ANS     COL_FORTH_ANS     StyleSetFore: self
                SCE_FORTH_USER1   COL_FORTH_USER1   StyleSetFore: self
                SCE_FORTH_USER2   COL_FORTH_USER2   StyleSetFore: self
                SCE_FORTH_USER3   COL_FORTH_USER3   StyleSetFore: self
                SCE_FORTH_USER4   COL_FORTH_USER4   StyleSetFore: self
                SCE_FORTH_USER5   COL_FORTH_USER5   StyleSetFore: self
                SCE_FORTH_USER6   COL_FORTH_USER6   StyleSetFore: self
                ;M
create WordChars MAXSTRING allot 0 WordChars !
s" abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" WordChars place
s" 0123456789°!§$%&/()=?`´^{[]}\+*~#,.-;:_@<>|" WordChars +place
WordChars count + dup 34 swap c! ( " ) char+ dup 39 swap c! ( ' ) char+ 0 swap c!

:M Start:       ( Parent -- )
                Start: super
                0 to FindMode
                true to CreateBackup?
                FindText$ off
                InitLexer: self
                STYLE_DEFAULT z" Fixedsys" StyleSetFont: self
                WordChars 1+ SetWordChars: self ;M

:M GetFileName: ( -- addr )
                GetName: EditFile ;M

:M SetWindowTitle: { \ Text$ -- }
                1024 LocalAlloc: Text$
                WindowTitle: parent zcount Text$ place
                s"  - " Text$ +place
                GetFileName: self count dup 0=
                if 2drop s" [NEW FILE]" then Text$ +place
                Text$ count SetText: parent ;M

:M SetFileName: ( addr len -- )
                SetName: EditFile
                SetWindowTitle: self ;M

: MessageBox    ( n a1 n1 -- n2 )
                pad place pad +NULL
                z" ScintillaEdit"
                pad count drop
                Gethandle: self Call MessageBox ;

: GetOpenFilename ( -- addr len )
                Gethandle: self Start: OpenfileDialog count ;

: GetSaveFilename ( -- addr len )
                Gethandle: self Start: SaveFileDialog count ;

: SaveText      ( -- )          \ save the Text in the control to the file
                \ get the complete text from the control
                ReleaseBuffer: EditFile
                GetTextLength: self 1+ AllocBuffer: EditFile
                GetBuffer: EditFile GetText: self

                \ adjust the Text length in the EditFile because
                \ the Scintilla-Control returns on null byte at the
                \ end of the Text. Thank's Ezra for telling me about this
                \ bug (Freitag, August 19 2005 - dbu)
                GetLength: EditFile 1- SetLength: EditFile

                \ save the text to the file
                SaveFile: EditFile
                ReleaseBuffer: EditFile

                \ and mark the text in the control as unchanged
                SetSavepoint: self ;

:M SaveFileAs:  ( -- )          \ save the file under a new name
                GetSaveFilename ?dup
                if   SetFileName: self
                     SaveText
                else drop
                then ;M

: CreateBackup  { \ from$ to$ -- } \ create a Backup of the active file (*.BAK)
                CreateBackup?
                if   max-path localAlloc: from$
                     max-path localAlloc: to$

                     GetFileName: self count from$ place from$ +null

                     GetFileName: self count to$ place
                     to$ count "minus-ext" to$ place s" .bak" to$ +place to$ +null

                     false to$ count drop from$ count drop
                     Call CopyFile ?win-error
                then ;

:M SaveFile:    ( -- )          \ save the file under it's current name
                GetFileName: self c@ 0=
                if   SaveFileAs: self
                else CreateBackup SaveText
                then ;M

:M SaveBeforeCloseing: ( -- )
                GetModify: self 0<>
                if   [ MB_YESNO MB_ICONQUESTION or ] literal
                     s" The current File has changed. Would you like to save your changes?" MessageBox
                     IDYES = if SaveFile: self then
                then ;M

:M NewFile:     ( -- )          \ open a new empty file
                SaveBeforeCloseing: self
                ClearAll: self
                EmptyUndoBuffer: self
                SetSavepoint: self
                ClearName: EditFile ;M

: SetFile       ( f -- )
                GetBuffer: EditFile ?dup
                if   over + 0 swap c! \ add 0-terminator
                     SetText: self
                then
                EmptyUndoBuffer: self
                SetSavepoint: self
                0 -1 Colourise: self ;

:M OpenNamedFile: ( addr len -- f )          \ open a file
                SaveBeforeCloseing: self
                ClearAll: self
                LoadFile: EditFile
                dup if SetFile then
                SetWindowTitle: self ;M

:M OpenFile:    ( -- )          \ open a file
                GetOpenFilename ?dup
                if   OpenNamedFile: self
                else drop
                then ;M

:M ReloadFile:  ( -- )          \ reload the current file
                GetFileName: self c@ 0<>
                if   GetModify: self 0<>
                     if   [ MB_YESNO MB_ICONQUESTION or ] literal
                          s" The current File has changed. All changes will be lost. Would you like to continue?" MessageBox
                          IDYES =
                          if   GetFileName: self count pad place
                               SetSavepoint: self NewFile: self
                               pad count LoadFile SetFile
                          then
                     then
                then ;M

:M Delete:      ( -- )          \ delete the selected text
                0 PAD ! PAD ReplaceSel: self ;M

:M RemoveSel:   ( -- )          \ remove the current selection
                -1 GetCurrentPos: self SetSel: self ;M

:M ?Selection:  ( -- f )
                GetSelectionStart: self GetSelectionEnd: self - ;M

:M ViewEOL:     ( -- )
                GetViewEOL: self not SetViewEOL: self ;M

:M SetEOL:      ( eolMode -- )
                dup ConvertEOL: self SetEOL: super ;M

:M SetOverType: ( -- )
                GetOverType: self not SetOverType: super ;M

:M ViewWhiteSpace: ( -- )
                GetWhiteSpace: self
                SCWS_INVISIBLE = if SCWS_VISIBLEALWAYS else SCWS_INVISIBLE then
                SetWhiteSpace: self ;M

:M ?Find:       ( -- f )
                FindText$ c@ 0<> ;M

:M FindText:    ( -- )
                FindText$ self Start: FindTextDlg
                case    0 of exitm            endof
                        1 of 0                endof \ ignore case
                        2 of SCFIND_MATCHCASE endof
                endcase dup to FindMode

                ?Find: self
                if   FindText$ +null
                     0 GetTextLength: self
                     FindText$ 1+ FindText: super ( nStart nEnd flag )
                     if   SetSel: self
                     then
                else drop
                then ;M

:M SearchNext:  ( -- )
                ?Find: self
                if
                     GetSelectionEnd: self SetSelectionStart: self
                     SearchAnchor: self
                     FindMode FindText$ 1+ SearchNext: super INVALID_POSITION <>
                     if ScrollCaret: super then
                then ;M

:M SearchPrev:  ( -- ) \ this doesn't work... why?
                ?Find: self
                if
                     GetSelectionEnd: self SetSelectionStart: self
                     SearchAnchor: self
                     FindMode FindText$ 1+ SearchPrev: super INVALID_POSITION <>
                     if ScrollCaret: super then
                then ;M

:M GetCurrentLine: ( -- #line )
                GetCurrentPos: self
                LineFromPosition: self ;M

:M IsBackupEnabled: ( -- f )
                CreateBackup? ;M

:M EnableBackup: ( f -- )
                to CreateBackup? ;M

:M InsertDate:  { \ $buf -- } \ replace selection with current date
                MAXSTRING LocalAlloc: $buf
                get-local-time time-buf
                >month,day,year" $buf place

\                time&date 2drop drop
\                s"  - " $buf +place
\                (.)   $buf +place s" :" $buf +place
\                2 .#" $buf +place drop
                $buf +null $buf 1+ ReplaceSel: self ;M

:M InsertDate&Time: { \ $buf -- } \ replace selection with current date and time
                MAXSTRING LocalAlloc: $buf
                get-local-time time-buf
                >month,day,year" $buf place

                time&date 3drop
                s"  - " $buf +place
                (.)   $buf +place s" :" $buf +place
                2 .#" $buf +place drop
                $buf +null $buf 1+ ReplaceSel: self ;M

: SelBounds     ( -- n1 n2 )
                GetSelectionEnd: self LineFromPosition: self
                GetSelectionStart: self LineFromPosition: self ;

: Comment?      ( #line -- ) \ check if line starts with a comment
                PositionFromLine: self
                dup GetCharAt: self [char] \ = swap
                1+ GetCharAt: self bl = and ;

:M CommentBlock: ( -- ) \ comment a block of lines
                ?Selection: self
                if   BeginUndoAction: self
                     SelBounds
                     ?do  i Comment? not
                          if   i PositionFromLine: self
                               z" \ " InsertText: self
                          then
                     loop EndUndoAction: self
                then ;M

:M UnCommentBlock: ( -- ) \ uncomment a block of lines
                ?Selection: self
                if   BeginUndoAction: self
                     SelBounds
                     ?do  i Comment?
                          if   i PositionFromLine: self
                               dup 2 + SetSel: self Delete: self
                          then
                     loop EndUndoAction: self
                then ;M

:M GotoColumn:  ( n -- )
\                GetCurrentLine: self PositionFromLine: self
                GetCurrentPos: self
                + ( 1- ) dup SetCurrentPos: self SetAnchor: self ;M

:M GetCurrentLineLength: ( -- n )
                GetCurrentLine: self
                LineLength: self ;M

:M HighlightLine: ( Anchor Pos -- )
                GetCurrentLine: self PositionFromLine: self dup>r
                   + SetCurrentPos: self
                r> + SetAnchor: self ;M

:M HighlightWord: { \ buf$ Pos Anchor -- } \ highlight the current word under cursor

                GetCurrentLineLength: self 1+ dup LocalAlloc: buf$
                buf$ GetCurLine: self
                GetCurrentLineLength: self min ( curpos )

                buf$ swap 2dup
                BEGIN   2dup bl scan dup
                WHILE   2nip
                        bl skip
                REPEAT  3drop 2 pick - dup dup>r
                /string 2dup bl scan nip - r@ + nip

                r> swap HighlightLine: self ;M

:m ~:           ( -- )
                ReleaseBuffer: EditFile ;m

Record: scn \ struct SCNotification
        int scn_hWndFrom
        int scn_idFrom
        int scn_code
        int scn_position;
        \ SCN_STYLENEEDED, SCN_MODIFIED, SCN_DWELLSTART,
        \ SCN_DWELLEND, SCN_CALLTIPCLICK,
        \ SCN_HOTSPOTCLICK, SCN_HOTSPOTDOUBLECLICK
        int scn_ch               \ SCN_CHARADDED, SCN_KEY
        int scn_modifiers        \ SCN_KEY, SCN_HOTSPOTCLICK, SCN_HOTSPOTDOUBLECLICK
        int scn_modificationType \ SCN_MODIFIED
        int scn_text             \ SCN_MODIFIED
        int scn_length           \ SCN_MODIFIED
        int scn_linesAdded       \ SCN_MODIFIED
        int scn_message          \ SCN_MACRORECORD
        int scn_wParam           \ SCN_MACRORECORD
        int scn_lParam           \ SCN_MACRORECORD
        int scn_line             \ SCN_MODIFIED
        int scn_foldLevelNow     \ SCN_MODIFIED
        int scn_foldLevelPrev    \ SCN_MODIFIED
        int scn_margin           \ SCN_MARGINCLICK
        int scn_listType         \ SCN_USERLISTSELECTION
        int scn_x                \ SCN_DWELLSTART, SCN_DWELLEND
        int scn_y                \ SCN_DWELLSTART, SCN_DWELLEND
;RecordSize: /scn

: fill-scn      ( l -- )
                scn /scn move ;

:M OnNotify:    ( h m w l -- res ) \ handle the Notifications
\ comment:
\                cr ." OnNotify: "
                fill-scn scn_code
                case \   SCN_STYLENEEDED        of ." SCN_STYLENEEDED" endof
                     \   SCN_STYLENEEDED        of ." SCN_STYLENEEDED" endof
                     \   SCN_CHARADDED          of ." SCN_CHARADDED" endof
                     \   SCN_SAVEPOINTREACHED   of ." SCN_SAVEPOINTREACHED" endof
                     \   SCN_SAVEPOINTLEFT      of ." SCN_SAVEPOINTLEFT" endof
                     \    SCN_KEY                of On_ScnKey: self endof
                     \   SCN_DOUBLECLICK        of ." SCN_DOUBLECLICK" endof
                     \   SCN_UPDATEUI           of ." SCN_UPDATEU" endof
                     \   SCN_MODIFIED           of ." SCN_MODIFIED" endof
                     \   SCN_MACRORECORD        of ." SCN_MACRORECORD" endof
                     \   SCN_MARGINCLICK        of ." SCN_MARGINCLICK" endof
                     \   SCN_NEEDSHOWN          of ." SCN_NEEDSHOWN" endof
                     \   SCN_PAINTED            of ." SCN_PAINTED" endof
                     \   SCN_USERLISTSELECTION  of ." SCN_USERLISTSELECTION" endof
                     \   SCN_URIDROPPED         of ." SCN_URIDROPPED" endof
                     \   SCN_DWELLSTART         of ." SCN_DWELLSTART" endof
                     \   SCN_DWELLEND           of ." SCN_DWELLEND" endof
                     \   SCN_ZOOM               of ." SCN_ZOOM" endof
                     \   SCN_HOTSPOTCLICK       of ." SCN_HOTSPOTCLICK" endof
                     \   SCN_HOTSPOTDOUBLECLICK of ." SCN_HOTSPOTDOUBLECLICK" endof
                     \   SCN_CALLTIPCLICK       of ." SCN_CALLTIPCLICK" endof
                endcase
\ comment;
                true ;M

:M OnCommand:   ( h m w l -- res )
comment:
                cr ." OnCommand: "
                over HIWORD
                case    SCEN_CHANGE    of ." SCEN_CHANGE" endof
                        SCEN_SETFOCUS  of ." SCEN_SETFOCUS" endof
                        SCEN_KILLFOCUS of ." SCEN_KILLFOCUS" endof
                endcase
comment;
                true ;M

;Class

MODULE


--- NEW FILE: Label.f ---
\ $Id: Label.f,v 1.1 2007/05/08 08:31:46 georgeahubert Exp $

\ *D doc\classes\
\ *> Controls

anew -Label.f

WinLibrary COMCTL32.DLL

Require controls.f

cr .( Loading Label Classes...)

INTERNAL
EXTERNAL

\ ------------------------------------------------------------------------
\ *W <a name="Label"></a>
\ *S Label class
\ ------------------------------------------------------------------------
:Class Label		<super StaticControl
\ *G Class for static controls

int style

:M ClassInit:   ( -- )
\ *G Initialise the class.
                ClassInit: super
                0 to style ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control.
                WindowStyle: super
                style or ;M

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

:M Setfont:     ( handle -- )
\ *G Set the font in the control.
                1 swap WM_SETFONT SendMessage:SelfDrop ;M

:M Enable:      ( f -- )
\ *G Enable the control.
                ID EnableDlgItem: parent ;M

:M Disable:     ( -- )
\ *G Disable the control.
                false Enable: self ;M

;Class
\ *G End of Label class

\ ------------------------------------------------------------------------
\ *W <a name="StaticImage"></a>
\ *S StaticImage class
\ ------------------------------------------------------------------------
|Class StaticImage	<Super Label
\ *G Base class for static control showing an image.
\ ** This is an internal class; don't use it directly.

:M ImageType:	( -- ImageType )
\ *G Get the image type of the control. \i ImageType \d is IMAGE_BITMAP.
		IMAGE_BITMAP ;M

:M GetImage:	( -- hImage )
\ *G Retrieve a handle to the image associated with the control.
		0 ImageType: [ self ] STM_GETIMAGE SendMessage:Self ;M

:M SetImage:	( hImage -- )
\ *G Associate a new image (icon or bitmap) with the control.
		GetImage: self over <>
		if   ImageType: [ self ] STM_SETIMAGE SendMessage:SelfDrop
		else drop
		then ;M

:M SetFont:     ( fhndl -- )
\ *G Set the font in the control.
                drop ;M

;Class
\ *G End of StaticImage class

\ ------------------------------------------------------------------------
\ *W <a name="StaticBitmap"></a>
\ *S StaticBitmap class
\ ------------------------------------------------------------------------
:Class StaticBitmap	<Super StaticImage
\ *G Static control showing a bitmap.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: SS_BITMAP.
		WindowStyle: super SS_BITMAP OR ;M

;Class
\ *G End of StaticImage class

\ ------------------------------------------------------------------------
\ *W <a name="StaticIcon"></a>
\ *S StaticIcon class
\ ------------------------------------------------------------------------
:Class StaticIcon	<Super StaticImage
\ *G Static control showing an icon.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: SS_ICON.
		WindowStyle: super SS_ICON OR ;M

:M ImageType: 	( -- ImageType )
\ *G Get the image type of the control. \i ImageType \d is IMAGE_ICON.
		IMAGE_ICON ;M

;Class
\ *G End of StaticIcon class

\ ------------------------------------------------------------------------
\ *W <a name="StaticMetafile"></a>
\ *S StaticMetafile class
\ ------------------------------------------------------------------------
:Class StaticMetafile	<Super StaticImage
\ *G Static control showing an enhanced metafile.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: SS_ENHMETAFILE.
		WindowStyle: super SS_ENHMETAFILE OR ;M

:M ImageType: 	( -- ImageType )
\ *G Get the image type of the control. \i ImageType \d is IMAGE_ENHMETAFILE.
		IMAGE_ENHMETAFILE ;M

;Class
\ *G End of StaticMetafile class

\ ------------------------------------------------------------------------
\ *W <a name="StaticFrame"></a>
\ *S StaticFrame class
\ ------------------------------------------------------------------------
:Class StaticFrame	<Super Label
\ *G Static control showing a frame.

:M BlackRect:	( -- )
\ *G Rectangle in the window frame color (default is black).
		WindowStyle: super  SS_BLACKRECT OR  SetStyle: self ;M

:M GrayRect:	( -- )
\ *G Rectangle in the screen background color (default is gray).
		WindowStyle: super  SS_GRAYRECT OR  SetStyle: self ;M

:M WhiteRect:	( -- )
\ *G Rectangle in the window background color (default is white).
		WindowStyle: super  SS_WHITERECT OR  SetStyle: self ;M

:M BlackFrame:	( -- )
\ *G Frame in the window frame color (default is black).
		WindowStyle: super  SS_BLACKFRAME OR  SetStyle: self ;M

:M GrayFrame:	( -- )
\ *G Frame in the screen background color (default is gray).
		WindowStyle: super  SS_GRAYFRAME OR  SetStyle: self ;M

:M WhiteFrame:	( -- )
\ *G Frame in the window background color (default is white).
		WindowStyle: super  SS_WHITEFRAME OR  SetStyle: self ;M

:M EtchedFrame:	( -- )
\ *G draws an etched frame (frame appears lower than background)
		WindowStyle: super  SS_ETCHEDFRAME OR  SetStyle: self ;M

:M SunkenFrame:	( -- )
\ *G Draws frame with half-sunken border.
		WindowStyle: super  SS_SUNKEN OR  SetStyle: self ;M

;Class
\ *G End of StaticFrame class

MODULE

\ *Z

--- NEW FILE: ListBox.f ---
\ $Id: ListBox.f,v 1.1 2007/05/08 08:31:46 georgeahubert Exp $

\ *D doc\classes\
\ *> Controls

anew -ListBox.f

WinLibrary COMCTL32.DLL

Require controls.f

cr .( Loading ListBox Classes...)

INTERNAL
EXTERNAL

\ ------------------------------------------------------------------------
\ *W <a name="ComboBox"></a>
\ *S ComboBox class
\ ------------------------------------------------------------------------
:Class ComboBox		<super ComboControl
\ *G ComboBox control
\ ** (enhanced Version of the ComboControl class)

int style

:M ClassInit:   ( -- )
\ *G Initialise the class.
                ClassInit: super
                0 to style ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control.
                WindowStyle: super
                style or ;M

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

:M SetDir:      ( dirz$ attrib -- )
\ *G Add the names of directories and files that match a specified string and
\ ** set of file attributes. SetDir: can also add mapped drive letters to the list.
\ *P \i attrib \d Specifies the attributes of the files or directories to be added to
\ ** the combo box. This parameter can be one or more of the following values:
\ *L
\ *| DDL_ARCHIVE    | Includes archived files. |
\ *| DDL_DIRECTORY  | Includes subdirectories, which are enclosed in square brackets ([ ]). |
\ *| DDL_DRIVES All | mapped drives are added to the list. Drives are listed in the form [-x-], where x is the drive letter. |
\ *| DDL_EXCLUSIVE  | Includes only files with the specified attributes. By default, read-write files are listed even if DDL_READWRITE is not specified. |
\ *| DDL_HIDDEN     | Includes hidden files. |
\ *| DDL_READONLY   | Includes read-only files. |
\ *| DDL_READWRITE  | Includes read-write files with no additional attributes. This is the default. |
\ *| DDL_SYSTEM     | Includes system files. |
\ *P \i dirz$ \d specifies an absolute path, relative path, or file name. An absolute path
\ ** can begin with a drive letter (for example, d:\) or a UNC name (for example, \\machinename\sharename).
\ ** If the string specifies a file name or directory that has the attributes specified by
\ ** the wParam parameter, the file name or directory is added to the list. If the file name
\ ** or directory name contains wildcard characters (? or *), all files or directories that
\ ** match the wildcard expression and have the attributes specified by the wParam parameter
\ ** are added to the list displayed in the combo box.
                CB_DIR SendMessage:SelfDrop ;M

:M AddStringTo: ( z"string" -- )
\ *G Add a string to the list box of a combo box. If the combo box does not have the
\ ** CBS_SORT style, the string is added to the end of the list. Otherwise, the string
\ ** is inserted into the list, and the list is sorted.
                0 CB_ADDSTRING SendMessage:SelfDrop ;M

:M SetSelection: ( n -- )
\ *G Select a string in the list of a combo box.
                0 swap CB_SETCURSEL SendMessage:SelfDrop ;M

:M GetSelectedString: ( -- addr cnt )
\ *G Get the selected from the combo box.
\ ** Note: The string is returned in the global \i NEW$ \d.
                0 0 CB_GETCURSEL SendMessage:Self
                new$ dup rot CB_GETLBTEXT SendMessage:Self
                ;M

:M Setfont:     ( handle -- )
\ *G Set the font in the control.
                1 swap WM_SETFONT SendMessage:SelfDrop ;M

:M InsertStringAt: ( lpszString posn -- )
\ *G Insert string at the specified position.
\ *P \i posn \d specifies the zero-based index of the position at which to insert
\ ** the string. If this parameter is -1, the string is added to the end of the list.
\ *P \i lpszString \d is a null-terminated string to be inserted.
                CB_INSERTSTRING SendMessage:Self
		CB_ERR OVER = SWAP CB_ERRSPACE = OR
		ABORT" Error adding string to combo box" ;M

:M DeleteString: ( index -- )
\ *G Delete a string.
\ *P \i index \d specifies the zero-based index of the string to delete.
		0 SWAP CB_DELETESTRING SendMessage:SelfDrop ;M

:M Clear: 	( -- )
\ *G Remove all strings from the combo box
		0 0 CB_RESETCONTENT SendMessage:SelfDrop ;M

:M Find: 	( lpszString -- index )
\ *G Search the list for an item beginning with the string (case-insensitive)
		-1 CB_FINDSTRING SendMessage:Self ;M

:M FindExact: 	( lpszString -- index )
\ *G Find the first item that matches the string exactly (case-insensitive)
		-1 CB_FINDSTRINGEXACT SendMessage:Self ;M

:M GetCount: 	( -- n )
\ *G Return count of items in list
		0 0 CB_GETCOUNT SendMessage:Self ;M

:M SelectString: ( lpszString -- index )
\ *G Select item beginning with string
		-1 CB_SELECTSTRING SendMessage:Self ;M

:M GetStringAt:	( index -- a n )
\ *G Return string of specified item.

\ TODO: Don't use HERE here !!!
		HERE SWAP CB_GETLBTEXT SendMessage:Self  HERE SWAP ;M

:M GetCurrent: 	( -- index )
\ *G return current selection item
		0 0 CB_GETCURSEL SendMessage:Self ;M

:M Enable:      ( f -- )
\ *G Enable the control.
                ID EnableDlgItem: parent ;M

:M Disable:     ( -- )
\ *G Disable the control.
                false Enable: self ;M

;Class
\ *G End of ComboBox class

\ ------------------------------------------------------------------------
\ *W <a name="ComboListBox"></a>
\ *S ComboListBox class
\ ------------------------------------------------------------------------
:Class ComboListBox	<super ComboBox
\ *G ComboBox list control

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. The default style is: CBS_DROPDOWNLIST
                WindowStyle: SUPER CBS_DROPDOWNLIST OR ;M

:M Start:       ( Parent -- )
\ *G Create the control.
\ We don't want the editcontrol in this control to be subclassed as with
\ super class. It shows the ibeam cursor so we override the start method.
                TO Parent
                z" COMBOBOX" Create-Control ;M

;Class
\ *G End of ComboListBox class

\ ------------------------------------------------------------------------
\ *W <a name="ListBox"></a>
\ *S ListBox class
\ ------------------------------------------------------------------------
:Class ListBox		<super ListControl
\ *G ListBox control (single selection)
\ ** (enhanced Version of the ListControl class)

int style

:M ClassInit:   ( -- )
\ *G Initialise the class.
                ClassInit: super
                0 to style ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control.
                WindowStyle: super
                style or ;M

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

:M SetDir:      ( dirz$ attrib -- )
\ *G Add the names of directories and files that match a specified string and
\ ** set of file attributes. SetDir: can also add mapped drive letters to the list.
\ *P \i attrib \d Specifies the attributes of the files or directories to be added to
\ ** the combo box. This parameter can be one or more of the following values:
\ *L
\ *| DDL_ARCHIVE    | Includes archived files. |
\ *| DDL_DIRECTORY  | Includes subdirectories, which are enclosed in square brackets ([ ]). |
\ *| DDL_DRIVES All | mapped drives are added to the list. Drives are listed in the form [-x-], where x is the drive letter. |
\ *| DDL_EXCLUSIVE  | Includes only files with the specified attributes. By default, read-write files are listed even if DDL_READWRITE is not specified. |
\ *| DDL_HIDDEN     | Includes hidden files. |
\ *| DDL_READONLY   | Includes read-only files. |
\ *| DDL_READWRITE  | Includes read-write files with no additional attributes. This is the default. |
\ *| DDL_SYSTEM     | Includes system files. |
\ *P \i dirz$ \d specifies an absolute path, relative path, or file name. An absolute path
\ ** can begin with a drive letter (for example, d:\) or a UNC name (for example, \\machinename\sharename).
\ ** If the string specifies a file name or directory that has the attributes specified by
\ ** the wParam parameter, the file name or directory is added to the list. If the file name
\ ** or directory name contains wildcard characters (? or *), all files or directories that
\ ** match the wildcard expression and have the attributes specified by the wParam parameter
\ ** are added to the list displayed in the combo box.
                LB_DIR SendMessage:SelfDrop ;M

:M Clear:       ( -- )
\ *G Remove all items from the list box.
                0 0 LB_RESETCONTENT SendMessage:SelfDrop ;M

:M AddStringTo: ( z"string" -- )
\ *G Add a string to a list box. If the list box does not have the LBS_SORT style,
\ ** the string is added to the end of the list. Otherwise, the string is inserted
\ ** into the list and the list is sorted.
                0 LB_ADDSTRING SendMessage:SelfDrop ;M

:M SetSelection: ( n -- )
\ *G Select a string and scroll it into view, if necessary. When the new string is
\ ** selected, the list box removes the highlight from the previously selected string.
\ *P \i n \d specifies the zero-based index of the string that is selected. If this parameter
\ ** is -1, the list box is set to have no selection.
\ *P Windows 95/98: The \i n \d parameter is limited to 16-bit values. This means list boxes
\ ** cannot contain more than 32,767 items. Although the number of items is restricted, the
\ ** total size in bytes of the items in a list box is limited only by available memory.
                0 swap LB_SETCURSEL SendMessage:SelfDrop ;M

:M GetSelection: ( -- n )
\ *G Retrieve the index of the currently selected item, if any.
\ *P The return value is the zero-based index of the currently selected item. If there is no
\ ** selection, the return value is LB_ERR.
                0 0 LB_GETCURSEL SendMessage:Self ;M

:M GetString:    ( index -- addr n )
\ *G Retrieve a string from the list box.
\ *P The return value is the length of the string, in chars, excluding the terminating null character.
\ ** If \i n \d does not specify a valid index, the return value is LB_ERR.
                new$ dup rot LB_GETTEXT SendMessage:Self  ;M

:M GetSelectedString: ( -- addr cnt )
\ *G Retrieve the currently selected string from the list box.
\ ** Note: The string is returned in the global \i NEW$ \d.
                GetSelection: self GetString: self ;M

:M GetCount:    ( -- n )
\ *G Retrieve the number of items in the list box.
                0 0 LB_GETCOUNT SendMessage:Self ;M

:M Setfont:     ( handle -- )
\ *G Set the font in the control.
                1 swap WM_SETFONT SendMessage:SelfDrop ;M

:M AddString: 	( lpszString -- )
\ *G Add a string to a list box. If the list box does not have the LBS_SORT style,
\ ** the string is added to the end of the list. Otherwise, the string is inserted
\ ** into the list and the list is sorted.
\ ** Note: This method ABORT's on error.
                0 LB_ADDSTRING SendMessage:Self
                LB_ERR OVER = SWAP LB_ERRSPACE = OR
                ABORT" Error adding string to list box"
                ;M

:M InsertString: ( lpszString index -- )
\ *G Insert a string into the list box. Unlike the AddString: method, the InsertString: method
\ ** does not cause a list with the LBS_SORT style to be sorted.
\ ** Note: This method ABORT's on error.
\ *P \i index \d specifies the zero-based index of the position at which to insert
\ ** the string. If this parameter is -1, the string is added to the end of the list.
\ *P Windows 95/98: The \i index \d parameter is limited to 16-bit values. This means list
\ ** boxes cannot contain more than 32,767 items. Although the number of items is restricted,
\ ** the total size in bytes of the items in a list box is limited only by available memory.
		LB_INSERTSTRING SendMessage:Self
		LB_ERR OVER = SWAP LB_ERRSPACE = OR
		ABORT" Error inserting string in list box"
		;M

:M DeleteString: ( index -- )
\ *G Delete a string from the list box.
\ *P \i index \d specifies the zero-based index of the string to be deleted.
\ *P Windows 95/98: The \i index \d parameter is limited to 16-bit values. This means list boxes
\ ** cannot contain more than 32,767 items. Although the number of items is restricted, the total
\ ** size in bytes of the items in a list box is limited only by available memory.
		0 SWAP LB_DELETESTRING SendMessage:SelfDrop ;M

:M Find: 	( lpszString -- index )
\ *G Find the first string in the list box that begins with the specified string.
\ ** The entire list box is searched from the beginning.
\ ** The search is case independent, so the string (\i lpszString \d) can contain any combination of
\ ** uppercase and lowercase letters.
\ *P The return value is the zero-based index of the matching item, or LB_ERR if the search was unsuccessful.
		-1 LB_FINDSTRING SendMessage:Self ;M

:M FindExact: 	( lpszString -- index )
\ *G Find the first list box string that exactly matches the specified string, except that the search
\ ** is not case sensitive.
\ ** The entire list box is searched from the beginning.
\ *P The return value is the zero-based index of the matching item, or LB_ERR if the search was unsuccessful.
	-1 LB_FINDSTRINGEXACT SendMessage:Self ;M

:M GetCurrent: 	( -- index )
\ *G Retrieve the index of the currently selected item, if any.
\ *P The return value is the zero-based index of the currently selected item. If there is no
\ ** selection, the return value is LB_ERR.
                GetSelection: self ;M

:M SelectString: ( lpszString -- index )
\ *G Search the list box for an item that begins with the characters in a specified string.
\ ** If a matching item is found, the item is selected.
\ ** The entire list box is searched from the beginning.
\ *P If the search is successful, the return value is the index of the selected item. If the
\ ** search is unsuccessful, the return value is LB_ERR and the current selection is not changed.
		-1 LB_SELECTSTRING SendMessage:Self ;M

:M GetState:	( index -- f )
\ *G Retrieve the selection state of an item.
\ ** If an item is selected, the return value is true; otherwise, it is false.
\ ** Note: This method ABORT's on error.
		0 SWAP LB_GETSEL SendMessage:Self
		LB_ERR OVER = ABORT" GetState: error occurred."
		0>
		;M

:M Enable:      ( f -- )
\ *G Enable the control.
                ID EnableDlgItem: parent ;M

:M Disable:     ( -- )
\ *G Disable the control.
                false Enable: self ;M

:M SetTabStops: ( addr cnt -- )
\ *G Set the tab-stop positions in the list box.
\ *P \i cnt \d Specifies the number of tab stops in the list box.
\ *P \i addr \d is a pointer to the first member of an array of integers containing the tab
\ ** stops. The integers represent the number of quarters of the average character width for
\ ** the font that is selected into the list box. For example, a tab stop of 4 is placed at
\ ** 1.0 character units, and a tab stop of 6 is placed at 1.5 average character units. However,
\ ** if the list box is part of a dialog box, the integers are in dialog template units. The tab
\ ** stops must be sorted in ascending order; backward tabs are not allowed.
\ *P The list box must have been created with the LBS_USETABSTOPS style.
                LB_SETTABSTOPS SendMessage:SelfDrop ;M

;Class
\ *G End of ListBox class

\ ------------------------------------------------------------------------
\ *W <a name="MultiListbox"></a>
\ *S MultiListbox class
\ ------------------------------------------------------------------------
:Class MultiListbox  	<Super Listbox
\ *G ListBox control
\ ** MultiListbox allows multiple selections to be made.
\ ** Click once on an item to select it.  Click again to deselect.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. The default style is: LBS_MULTIPLESEL
		WindowStyle: super
		LBS_MULTIPLESEL OR
		;M

:M Select:	( index -- )
\ *G Select a string in the list box.
\ *P \i index \d specifies the zero-based index of the string to set. If this parameter
\ ** is -1, the selection is added to all strings.
\ ** Note: This method ABORT's on error.
		TRUE LB_SETSEL SendMessage:Self
		LB_ERR = ABORT" Select: error occurred."
		;M

:M Unselect: 	( index -- )
\ *G Deselect a string in the list box.
\ *P \i index \d specifies the zero-based index of the string to set. If this parameter
\ ** is -1, the selection is removed from all strings.
\ ** Note: This method ABORT's on error.
		FALSE LB_SETSEL SendMessage:Self
		LB_ERR = ABORT" Unselect: error occurred."
		;M

:M GetSelCount:	( -- n )
\ *G Retrieve the total number of selected items in the list box.
		0 0 LB_GETSELCOUNT SendMessage:Self ;M

:M GetSelectedItems: ( array cnt -- count )
\ *G Fill a buffer with an array of integers that specify the item numbers of selected
\ ** items in the list box.
\ *P \i array \d is a pointer to a buffer large enough for the number of integers specified
\ ** by the \i cnt \d parameter.
\ *P \i cnt \d specifies the maximum number of selected items whose item numbers are to be placed
\ ** in the buffer. Windows 95/98: The \i cnt \d parameter is limited to 16-bit values. This means
\ ** list boxes cannot contain more than 32,767 items. Although the number of items is restricted,
\ ** the total size in bytes of the items in a list box is limited only by available memory.
		LB_GETSELITEMS SendMessage:Self ;M
;Class
\ *G End of MultiListbox class

\ *W <a name="MultiExListbox"></a>
\ *S MultiExListbox class
:Class MultiExListbox	<Super MultiListbox
\ *G ListBox control
\ ** Also allows multiple selections to be made.
\ ** The difference is that Ctrl-Click selects and unselects
\ ** individual items and Shift-Click will select a range (as will
\ ** Shift-Drag.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. The default style is: LBS_EXTENDEDSEL
      WindowStyle: super LBS_EXTENDEDSEL OR ;M

;Class
\ *G End of MultiExListbox class

\ ------------------------------------------------------------------------
\ *W <a name="DragListbox"></a>
\ *S DragListbox class
\ ------------------------------------------------------------------------
:Class DragListbox	<Super Listbox
\ *G ListBox control
\ ** Allows dragging of items in list box to re-order them
\ ** requires processing of drag list notification messages by the
\ ** application to actually do the dragging.

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. The default style is: LBS_EXTENDEDSEL
		WindowStyle: super
		LBS_EXTENDEDSEL OR
		;M

:M Start:       ( Parent -- )
\ *G Create the control.
		Start: super \ create a single-selection list box
		hWnd Call MakeDragList ?Win-Error \ convert it to a Drag-type
		;M

;Class
\ *G End of DragListbox class

MODULE

\ *Z

Index: treeview.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/lib/treeview.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** treeview.f	6 May 2007 14:09:32 -0000	1.1
--- treeview.f	8 May 2007 08:31:46 -0000	1.2
***************
*** 5,9 ****
  \               On creation needs a sensible StartSize: ( default set to size of parent )
  \               Class control does not have the definition "null-check" which is in
! \               class Window and hence Child-Window. 
  
  (( TreeView.F   A rudimentary TreeView class              by Michael Hillerström
--- 5,9 ----
  \               On creation needs a sensible StartSize: ( default set to size of parent )
  \               Class control does not have the definition "null-check" which is in
! \               class Window and hence Child-Window.
  
  (( TreeView.F   A rudimentary TreeView class              by Michael Hillerström
***************
*** 42,45 ****
--- 42,47 ----
  ))
  
+ Require control.f
+ 
  cr .( Loading TreeView Class...)
  
***************
*** 86,91 ****
  comment;
  
! Needs Window.f
! Needs Control.f
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 88,92 ----
  comment;
  
! 
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

--- NEW FILE: StatusBar.f ---
\ $Id: StatusBar.f,v 1.1 2007/05/08 08:31:46 georgeahubert Exp $

\ StatusBar.f
\ Statusbar control separated from ExControls

\ *D doc\classes\
\ *> Controls
\ *T ExControls -- More (enhanced) classes for standard windows controls.

Require control.f

cr .( Loading StatusBar Class...)

anew -StatusBar.f

WinLibrary COMCTL32.DLL

INTERNAL
EXTERNAL

\ ------------------------------------------------------------------------
\ *W <a name="Statusbar"></a>
\ *S Statusbar class
\ ------------------------------------------------------------------------
:Class Statusbar	<Super Control
\ *G Status bar control
\ *P A status bar is a horizontal window at the bottom of a parent window in
\ ** which an application can display various kinds of status information.
\ *P This status bar control has only one part to display information.

INT BorderStyle \ style of border to use
int style

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

:M Start:       ( Parent -- )
\ *G Create the control.
                to parent Z" msctls_statusbar32" create-control
                0 TRUE SB_SIMPLE SendMessage:SelfDrop
                ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: WS_CHILD WS_VISIBLE or.
		WindowStyle: super style or ;M

:M RaisedBorder: ( -- )
\ *G The text is drawn with a border to appear lower than the plane of the
\ ** window (default).
		0 TO BorderStyle ;M

:M NoBorder: 	( -- )
\ *G The text is drawn without borders.
		SBT_NOBORDERS TO BorderStyle ;M

:M SunkenBorder: ( -- )
\ *G The text is drawn with a border to appear higher than the plane of the window.
		SBT_POPOUT TO BorderStyle ;M

:M ClassInit:   ( -- )
\ *G Initialise the class.
		ClassInit: super
		RaisedBorder: self
    0 to style ;M

:M MinHeight: 	( #pixels -- )
\ *G Sets the minimum height of the status window's drawing area.
\ *P The minimum height is the sum of #pixels and twice the width, in pixels,
\ ** of the vertical border of the status window.
\ *P An application must use the Redraw: method to redraw the window.
		0 SWAP SB_SETMINHEIGHT SendMessage:SelfDrop ;M

:M GetBorders: 	( -- hWidth vWidth divWidth )
\ *G Retrieves the current widths of the horizontal and vertical borders of
\ ** the status window.
\ *P \i hWidth \d is the width of the horizontal border.
\ *P \i vWidth \d is the width of the vertical border.
\ *P \i divWidth \d is the width of the border between rectangles.

\ TODO: Don't use HERE here !!!
		HERE 0 SB_GETBORDERS SendMessage:Self ?Win-Error
		HERE DUP @  SWAP CELL+ DUP @  SWAP CELL+ @
		;M

:M Redraw: 	( -- )
\ *G Redraw the statusbar after changes (e.g. size).
		0 0 WM_SIZE SendMessage:SelfDrop ;M

:M SetText: 	( szText -- )
\ *G Sets the text in the status window.
\ *P Use \i RaisedBorder: \d, \i NoBorder: \d or \i SunkenBorder: \d to set
\ ** the the style how the text is drawn.
		255 BorderStyle OR SB_SETTEXTA SendMessage:Self ?Win-error ;M

:M Clear: 	( -- )
\ *G clears text in the status window.
		Z" " SetText: self ;M

:M Setfont:     ( handle -- )
\ *G Set the font in the control.
                1 swap WM_SETFONT SendMessage:SelfDrop ;M

:M Height:      ( -- height )
\ Get the height of the status window.
                GetWindowRect: self
                nip swap - nip ;M
;Class
\ *G End of Statusbar class

\ ------------------------------------------------------------------------
\ *W <a name="MultiStatusbar"></a>
\ *S MultiStatusbar class
\ ------------------------------------------------------------------------
:Class MultiStatusbar	<Super Statusbar
\ *G Status bar control
\ *P A status bar is a horizontal window at the bottom of a parent window in
\ ** which an application can display various kinds of status information.
\ *P This status bar control can have multiple parts to display information.

INT nParts    \ number of parts in statusbar
INT aWidths   \ address of widths table

:M Start:       ( Parent -- )
\ *G Create the control.
                Start: super
                0 FALSE SB_SIMPLE SendMessage:SelfDrop
                ;M

:M SetParts: 	( aWidths nParts -- )
\ *G Sets the number of parts in the status window and the coordinate of the right
\ ** edge of each part.
\ *P \i nParts \d Number of parts to set (cannot be greater than 256).
\ *P \i aWidths \d is a pointer to an integer array. The number of elements is
\ ** specified in nParts. Each element specifies the position, in client coordinates,
\ ** of the right edge of the corresponding part. If an element is -1, the right edge
\ ** of the corresponding part extends to the border of the window.
\ *P Note: \i aWidths \d must be valid until SetParts: is used again!
                TO nParts
		TO aWidths
		aWidths nParts SB_SETPARTS SendMessage:Self ?Win-error
		;M

:M GetParts: 	( -- aWidths nParts )
\ *G Gets the number of parts in the status window and the coordinate of the right
\ ** edge of each part.
		aWidths nParts ;M

:M SetSimple: 	( -- )
\ *G Reset the status bar to show only one part.
		0 TRUE SB_SIMPLE SendMessage:SelfDrop ;M

:M SetMulti:	( -- )
\ *G Set the status bar to show all parts set with \i SetParts: \d before.
		0 FALSE SB_SIMPLE SendMessage:SelfDrop ;M

:M SetText: 	( szText n -- )
\ *G Sets the text in the \i n'th \d part of status window.
\ *P Use \i RaisedBorder: \d, \i NoBorder: \d or \i SunkenBorder: \d to set
\ ** the the style how the text is drawn.
		BorderStyle OR SB_SETTEXTA SendMessage:Self ?Win-Error ;M

;Class
\ *G End of MultiStatusbar class

MODULE

\ *Z


--- NEW FILE: ScrollBar.f ---
\ $Id: ScrollBar.f,v 1.1 2007/05/08 08:31:46 georgeahubert Exp $

\ *D doc\classes\
\ *> Controls

anew -ScrollBar.f

WinLibrary COMCTL32.DLL

Require control.f

cr .( Loading ScrollBar Class...)

INTERNAL
EXTERNAL

\ ------------------------------------------------------------------------
\ *W <a name="ScrollBar"></a>
\ *S ScrollBar class
\ ------------------------------------------------------------------------
|Class ScrollBar	<Super Control
\ *G Scrollbar control
\ ** Note: this is an internal class. Don't use it directly.

int style
Record: ScrollInfo
    INT cbSize
    INT fMask
    int  nMin
    int  nMax
    INT nPage
    int  nPos
    int  nTrackPos
;RecordSize: sizeof(ScrollInfo)

:M ClassInit:   ( -- )
\ *G Initialise the class.
                ClassInit: super
                0 to style
                sizeof(ScrollInfo) to cbSize
                0 to nMin
                100 to nMax
                25 to nPage
                0 to npos
                ;M

:M WindowStyle: ( -- style )
\ *G Get the window style of the control.
                WindowStyle: super
                style or ;M

:M AddStyle:    ( n -- )
\ *G Set any additional style of the control. Must be done before the control
\ ** is created.
                to style ;M

: SetScrollInfo ( -- n )
                1 ScrollInfo SB_CTL hwnd Call SetScrollInfo ;

: GetScrollInfo ( -- n )
                ScrollInfo SB_CTL hwnd Call GetScrollInfo ;

:M SetRange:    ( min max -- )
                to nMax to nMin SIF_RANGE to fMask
                SetScrollInfo to npos ;M

:M GetRange:    ( -- min val )
                SIF_RANGE to fmask
                GetScrollInfo drop
                nmin nmax ;M

:M SetPosition: ( n -- prev )
                to npos SIF_POS to fmask
                SetScrollInfo to npos ;M

:M GetPosition: ( -- n )
                SIF_POS to fmask
                GetScrollInfo drop npos ;M

:M SetPage:     ( page -- )
                to npage SIF_PAGE to fmask
                SetScrollInfo drop ;M

:M GetPage:     ( -- page )
                SIF_PAGE to fmask
                GetScrollInfo drop npage ;M

:M Start:       ( Parent -- )
\ *G Create the control.
                to parent z" SCROLLBAR" create-control ;M

:M SetFont:     ( hndl -- )
\ *G Set the font in the control.
\ ** Note that this is a dummy method in this class.
                drop ;M

:M Enable:      ( f -- )
\ *G Enable the control.
                ID EnableDlgItem: parent ;M

:M Disable:     ( -- )
\ *G Disable the control.
                false Enable: self ;M

;Class

\ ------------------------------------------------------------------------
\ *W <a name="HorizScroll"></a>
\ *S HorizScroll class
\ ------------------------------------------------------------------------
:Class HorizScroll      <Super ScrollBar
\ *G Scrollbar control (vorizontal).

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: SBS_HORZ.
                WindowStyle: super SBS_HORZ or ;M

;Class
\ *G End of HorizScroll class

\ ------------------------------------------------------------------------
\ *W <a name="VertScroll"></a>
\ *S VertScroll class
\ ------------------------------------------------------------------------
:Class VertScroll	<Super ScrollBar
\ *G Scrollbar control (vertical).

:M WindowStyle: ( -- style )
\ *G Get the window style of the control. Default style is: SBS_VERT.
                WindowStyle: super SBS_VERT or ;M

;Class
\ *G End ...
 
[truncated message content]