Menu
▾
▴
win32forth-cvs
|
From: Dirk B. <db...@us...> - 2005-12-31 11:13:05
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26368/src Modified Files: CONTROL.F CONTROLS.F Dialog.f Log Message: More documentation added. Index: CONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROLS.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** CONTROLS.F 29 Aug 2005 15:56:27 -0000 1.4 --- CONTROLS.F 31 Dec 2005 11:12:44 -0000 1.5 *************** *** 14,20 **** --- 14,27 ---- \ Win32Forth system + \ *D doc\classes\ + \ *! Controls + \ *T Controls -- Classes for standrad windows controls. + cr .( Loading Low Level Controls...) + \ *W <a name="EditControl"></a> + \ *S EditControl class :Class EditControl <Super CONTROL + \ *G Class for text edit controls. \ pointers to filter function to allow key capturing. *************** *** 39,48 **** ;M ! :M StartSize: ( width height ) ! 100 ! 25 ! ;M :M WindowStyle: ( -- Style ) WindowStyle: SUPER [ WS_BORDER WS_TABSTOP OR ES_AUTOHSCROLL OR ] literal OR \ allow horizontal scrolling --- 46,55 ---- ;M ! :M StartSize: ( -- width height ) ! \ *G Get the start size of the control ! 100 25 ;M :M WindowStyle: ( -- Style ) + \ *G Get the window style of the control WindowStyle: SUPER [ WS_BORDER WS_TABSTOP OR ES_AUTOHSCROLL OR ] literal OR \ allow horizontal scrolling *************** *** 50,53 **** --- 57,61 ---- :M Start: ( Parent -- ) + \ *G Create the control. TO Parent z" EDIT" Create-Control *************** *** 57,73 **** \ Return or F3, or whatever. ! :M SetWmChar: ( pWmChar -- ) \ install the WM_CHAR filter function ! to pWmChar ! ;M ! :M SetWmKeyDown: ( pWmKeyDown -- ) \ install the WM_KEYDOWN filter function ! to pWmKeyDown ! ;M ! :M SetWmKillFocus: ( pWmKillFocus -- ) \ install the WM_KILLFOCUS filter function ! to pWmKillFocus ! ;M ! :M SubClass: ( hWnd Parent -- ) \ subclass this control to parent to hWnd --- 65,82 ---- \ Return or F3, or whatever. ! :M SetWmChar: ( pWmChar -- ) ! \ *G install the WM_CHAR filter function ! to pWmChar ;M ! :M SetWmKeyDown: ( pWmKeyDown -- ) ! \ *G install the WM_KEYDOWN filter function ! to pWmKeyDown ;M ! :M SetWmKillFocus: ( pWmKillFocus -- ) ! \ *G install the WM_KILLFOCUS filter function ! to pWmKillFocus ;M ! :M SubClass: ( hWnd Parent -- ) ! \ *G Subclass this control to parent to hWnd *************** *** 75,89 **** ;M ! : ?pexecute ( hwnd msg wparm lparm pfunction -- result ) ! -IF self swap execute ! -IF DROP ! old-wndproc CallWindowProc ! THEN ! ELSE drop old-wndproc CallWindowProc THEN ; ! :M WM_CHAR ( h m w l -- res ) \ normal & control chars ! pWmChar ?pexecute ! ;M (( --- 84,97 ---- ;M ! : ?pexecute ( hwnd msg wparm lparm pfunction -- result ) ! -IF self swap execute ! -IF DROP ! old-wndproc CallWindowProc ! THEN ! ELSE drop old-wndproc CallWindowProc THEN ; ! :M WM_CHAR ( h m w l -- res ) \ normal & control chars ! pWmChar ?pexecute ;M (( *************** *** 100,109 **** :M WM_KEYDOWN ( h m w l -- res ) \ normal & control chars ! pWmKeyDown ?pexecute ! ;M :M WM_KILLFOCUS ( h m w l -- res ) \ Allow intervention on kill focus ! pWmKillFocus ?pexecute ! ;M :M WM_SETCURSOR { hndl msg wparam lparam -- res } --- 108,115 ---- :M WM_KEYDOWN ( h m w l -- res ) \ normal & control chars ! pWmKeyDown ?pexecute ;M :M WM_KILLFOCUS ( h m w l -- res ) \ Allow intervention on kill focus ! pWmKillFocus ?pexecute ;M :M WM_SETCURSOR { hndl msg wparam lparam -- res } *************** *** 111,134 **** AddrOf: WinRect GetClientRect: self hWnd get-mouse-xy Top: WinRect Bottom: WinRect between ! over Left: WinRect Right: WinRect between and ! IF ibeam-cursor ! 1 ! ELSE DROP ! hndl msg wparam lparam DefaultWindowProc ! THEN ! ;M ;Class ! :Class ComboControl <Super CONTROL \ an editable combo box EditControl ComboEdit ! :M StartSize: ( width height ) ! 100 ! 100 ! ;M :M WindowStyle: ( -- Style ) WindowStyle: SUPER [ CBS_DROPDOWN WS_VSCROLL OR WS_TABSTOP OR WS_VISIBLE OR ES_AUTOHSCROLL OR ] literal OR --- 117,143 ---- AddrOf: WinRect GetClientRect: self hWnd get-mouse-xy Top: WinRect Bottom: WinRect between ! over Left: WinRect Right: WinRect between and ! IF ibeam-cursor ! 1 ! ELSE DROP ! hndl msg wparam lparam DefaultWindowProc ! THEN ;M ;Class + \ *G End of EditControl class ! \ *W <a name="ComboControl"></a> ! \ *S ComboControl class ! :Class ComboControl <Super CONTROL ! \ *G Class for editable combo box controls. EditControl ComboEdit ! :M StartSize: ( -- width height ) ! \ *G Get the start size of the control ! 100 100 ;M :M WindowStyle: ( -- Style ) + \ *G Get the window style of the control WindowStyle: SUPER [ CBS_DROPDOWN WS_VSCROLL OR WS_TABSTOP OR WS_VISIBLE OR ES_AUTOHSCROLL OR ] literal OR *************** *** 138,154 **** \ Return or F3, or whatever. ! :M SetWmChar: ( pWmChar -- ) \ install the WM_CHAR filter function ! SetWmChar: ComboEdit ! ;M ! :M SetWmKeyDown: ( pWmKeyDown -- ) \ install the WM_KEYDOWN filter function ! SetWmKeyDown: ComboEdit ! ;M ! :M SetWmKillFocus: ( pWmKillFocus -- ) \ install the WM_KILLFOCUS filter function ! SetWmKillFocus: ComboEdit ! ;M :M InsertString: ( adr len -- ) hWnd NULL = \ must have a valid handle IF 2drop \ just discard if not running --- 147,164 ---- \ Return or F3, or whatever. ! :M SetWmChar: ( pWmChar -- ) ! \ *G install the WM_CHAR filter function for the EditControl of the combo box. ! SetWmChar: ComboEdit ;M ! :M SetWmKeyDown: ( pWmKeyDown -- ) ! \ *G install the WM_KEYDOWN filter function for the EditControl of the combo box. ! SetWmKeyDown: ComboEdit ;M ! :M SetWmKillFocus: ( pWmKillFocus -- ) ! \ *G install the WM_KILLFOCUS filter function for the EditControl of the combo box. ! SetWmKillFocus: ComboEdit ;M :M InsertString: ( adr len -- ) + \ *G Insert a string into the combo box hWnd NULL = \ must have a valid handle IF 2drop \ just discard if not running *************** *** 169,176 **** ;M - \ Use: GetText: to get the current combo box string - \ Use: GetString: to get indexed items out of the combo box string list - :M GetString: ( adr index -- ) swap dup>r 1+ swap CB_GETLBTEXT --- 179,185 ---- ;M :M GetString: ( adr index -- ) + \ *G Use: GetString: to get indexed items out of the combo box string list + \ ** Use: GetText: to get the current combo box string swap dup>r 1+ swap CB_GETLBTEXT *************** *** 178,184 **** ;M - \ Use: GetCount: to get the count of items in the combo box string list - :M GetCount: ( -- n1 ) \ n1 = count of items 0 0 CB_GETCOUNT GetID: self SendDlgItemMessage: parent 0 max --- 187,192 ---- ;M :M GetCount: ( -- n1 ) \ n1 = count of items + \ *G Use: GetCount: to get the count of items in the combo box string list 0 0 CB_GETCOUNT GetID: self SendDlgItemMessage: parent 0 max *************** *** 186,189 **** --- 194,198 ---- :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" COMBOBOX" Create-Control *************** *** 197,215 **** ;M - ;Class ! :Class ComboListControl <Super ComboControl \ select only combo box :M WindowStyle: ( -- Style ) ! WindowStyle: SUPER ! CBS_DROPDOWNLIST OR ! ;M ;Class ! :Class ListControl <Super CONTROL \ a list box :M WindowStyle: ( -- Style ) WindowStyle: SUPER [ WS_VSCROLL LBS_NOTIFY OR LBS_NOINTEGRALHEIGHT OR WS_TABSTOP OR ] literal OR --- 206,231 ---- ;M ;Class + \ *G End of ComboControl class ! \ *W <a name="ComboListControl"></a> ! \ *S ComboListControl class ! :Class ComboListControl <Super ComboControl ! \ *G Class for select only combo box controls. :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control ! WindowStyle: SUPER CBS_DROPDOWNLIST OR ;M ;Class + \ *G End of ComboListControl class ! \ *W <a name="ListControl"></a> ! \ *S ListControl class ! :Class ListControl <Super CONTROL ! \ *G Class for list box controls. :M WindowStyle: ( -- Style ) + \ *G Get the window style of the control WindowStyle: SUPER [ WS_VSCROLL LBS_NOTIFY OR LBS_NOINTEGRALHEIGHT OR WS_TABSTOP OR ] literal OR *************** *** 217,249 **** :M Start: ( Parent -- ) TO Parent z" LISTBOX" Create-Control ;M ;Class :Class GroupControl <Super CONTROL :M WindowStyle: ( -- Style ) ! WindowStyle: SUPER ! BS_GROUPBOX OR ! ;M :M Start: ( Parent -- ) TO Parent z" BUTTON" Create-Control ;M ;Class :Class StaticControl <Super CONTROL :M Start: ( Parent -- ) TO Parent z" STATIC" Create-Control ;M ;Class :Class CheckControl <Super CONTROL :M WindowStyle: ( -- style ) WindowStyle: SUPER [ BS_AUTOCHECKBOX WS_TABSTOP OR ] literal OR --- 233,280 ---- :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" LISTBOX" Create-Control ;M ;Class + \ *G End of ListControlControl class + \ *W <a name="GroupControl"></a> + \ *S GroupControl control class :Class GroupControl <Super CONTROL + \ *G Class for group controls. :M WindowStyle: ( -- Style ) ! \ *G Get the window style of the control ! WindowStyle: SUPER BS_GROUPBOX OR ;M :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" BUTTON" Create-Control ;M ;Class + \ *G End of GroupControl class + \ *W <a name="StaticControl"></a> + \ *S StaticControl control class :Class StaticControl <Super CONTROL + \ *G Class for static controls. :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" STATIC" Create-Control ;M ;Class + \ *G End of StaticControl class + \ *W <a name="CheckControl"></a> + \ *S CheckControl control class :Class CheckControl <Super CONTROL + \ *G Class for check box controls. :M WindowStyle: ( -- style ) + \ *G Get the window style of the control WindowStyle: SUPER [ BS_AUTOCHECKBOX WS_TABSTOP OR ] literal OR *************** *** 251,254 **** --- 282,286 ---- :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" BUTTON" Create-Control *************** *** 256,263 **** --- 288,300 ---- ;Class + \ *G End of CheckControl class + \ *W <a name="RadioControl"></a> + \ *S RadioControl control class :Class RadioControl <Super CONTROL + \ *G Class for radio button controls. :M WindowStyle: ( -- style ) + \ *G Get the window style of the control WindowStyle: SUPER [ BS_AUTORADIOBUTTON WS_TABSTOP OR ] literal OR *************** *** 265,268 **** --- 302,306 ---- :M Start: ( Parent -- ) + \ *G Create the control TO Parent z" BUTTON" Create-Control *************** *** 270,275 **** --- 308,317 ---- ;Class + \ *G End of RadioControl class + \ *W <a name="ButtonControl"></a> + \ *S ButtonControl control class :Class ButtonControl <Super CONTROL + \ *G Class for push button controls. int buttonfunc *************** *** 281,288 **** :M SetFunc: ( cfa -- ) ! to buttonfunc ! ;M :M WindowStyle: ( -- style ) WindowStyle: SUPER [ BS_PUSHBUTTON WS_TABSTOP OR ] literal OR --- 323,332 ---- :M SetFunc: ( cfa -- ) ! \ *G Set the button function. This function es executed when the ! \ ** button is pressed whith a click with the left mouse button ! to buttonfunc ;M :M WindowStyle: ( -- style ) + \ *G Get the window style of the control WindowStyle: SUPER [ BS_PUSHBUTTON WS_TABSTOP OR ] literal OR *************** *** 290,293 **** --- 334,338 ---- :M Start: ( Parent -- ) + \ *G Create the control to Parent z" BUTTON" Create-Control *************** *** 296,300 **** :M WM_LBUTTONUP ( h m w l -- res ) hWnd get-mouse-xy hWnd in-button? ! if buttonfunc execute then old-wndproc CallWindowProc --- 341,345 ---- :M WM_LBUTTONUP ( h m w l -- res ) hWnd get-mouse-xy hWnd in-button? ! if buttonfunc execute then old-wndproc CallWindowProc *************** *** 302,305 **** --- 347,351 ---- ;Class + \ *G End of ButtonControl class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 307,312 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! :CLASS DialogWindow <Super Window :M ClassInit: ( -- ) --- 353,360 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ *W <a name="DialogWindow"></a> ! \ *S Dialog Window Class :CLASS DialogWindow <Super Window + \ *G Base class for windows that contains controls. :M ClassInit: ( -- ) *************** *** 319,322 **** --- 367,373 ---- ;Class + \ *G End of DialogWindow class + + \ *Z \s ********* SAMPLE Follows ********* SAMPLE Follows ********* Index: Dialog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dialog.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Dialog.f 26 Dec 2005 09:28:23 -0000 1.3 --- Dialog.f 31 Dec 2005 11:12:44 -0000 1.4 *************** *** 7,37 **** cr .( Loading Dialog Box...) ! \ -------------------- Load Dialog Resource File -------------------- ! ! (( ! The .RES file structure is a series of records. Each record contains ! a header and a data field. The structure of a header is as follows: ! ! offset length ! 0 4 length of data field ! 4 4 length of header ! 10 2 record type ! 14 2 dialog ID number (for dialogs) ! )) ! ! \ Given the address of a header in a resource file, return true if this ! \ is the header for a dialog resource. I'm only guessing here. : dialogID? ( hdr ID -- f ) over 14 + w@ = \ does ID match swap 10 + w@ 5 = and ; \ is this also a dialog - \ Find dialog template given address and length of resource file in memory. - : ?dlgerr ( ior -- ) abort" Error loading dialog resource" ; \ April 18th, 1996 tjz switched to LONG count from WORD count : find-dialog-ID ( id addr -- address-of-template-header ) swap >r lcount --- 7,32 ---- cr .( Loading Dialog Box...) ! \ *S Load Dialog Resource File ! \ *P The .RES file structure is a series of records. Each record contains ! \ ** a header and a data field. The structure of a header is as follows: ! \ *L ! \ *| offset | length | | ! \ *| 0 | 4 | length of data field | ! \ *| 4 | 4 | length of header | ! \ *| 10 | 2 | record type | ! \ *| 14 | 2 | dialog ID number (for dialogs) | : dialogID? ( hdr ID -- f ) + \ *G Given the address of a header in a resource file, return true if this + \ ** is the header for a dialog resource. I'm only guessing here. over 14 + w@ = \ does ID match swap 10 + w@ 5 = and ; \ is this also a dialog : ?dlgerr ( ior -- ) abort" Error loading dialog resource" ; \ April 18th, 1996 tjz switched to LONG count from WORD count : find-dialog-ID ( id addr -- address-of-template-header ) + \ *G Find dialog template given address and length of resource file in memory. swap >r lcount *************** *** 60,74 **** r> close-file ?dlgerr ; - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ Load template from dialog resource to here and allot memory - \ Usage: load-dialog dialog - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - - \ create ld-buf maxstring allot \ needs to be long enough to hold a path too - - \ changed to work with blanks in file name \ January 31st, 2004 - 20:38 dbu : load-dialog ( -<filename-without-an-extension>- ) { \ ld-buf -- } maxstring localalloc: ld-buf --- 55,63 ---- r> close-file ?dlgerr ; \ changed to work with blanks in file name \ January 31st, 2004 - 20:38 dbu : load-dialog ( -<filename-without-an-extension>- ) + \ *G Load template from dialog resource (*.res) to here and allot memory. \n + \ ** Usage: load-dialog dialog { \ ld-buf -- } maxstring localalloc: ld-buf *************** *** 89,96 **** in-application ! \ -------------------- Dialog Class -------------------- ! :CLASS Dialog <SUPER Dialog&Control \ generic-window ! : (DialogProc) ( hwnd msg wparam lparam -- res ) --- 78,88 ---- in-application ! \ *W <a name="Dialog"></a> ! \ *S Dialog Class :CLASS Dialog <SUPER Dialog&Control \ generic-window ! \ *G Dialog class. \n ! \ ** To use this class you have to create a ressource file (*.res) whitch must contain ! \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog ! \ ** resource you should use ForthForm to create your dialog windows instead. : (DialogProc) ( hwnd msg wparam lparam -- res ) *************** *** 151,158 **** --- 143,152 ---- :M Start: ( parent -- flag ) + \ *G Open the dialog GetTemplate: [ self ] run-dialog ;M :M EndDialog: ( return-value -- ) + \ *G Close the dialog hwnd Call EndDialog drop ;M *************** *** 166,171 **** :M WM_INITDIALOG swap On_Init: [ self ] ;M ! :M On_Init: ( hwndfocus -- f ) drop 1 ;M ! \ -------------------- Process Commands from Controls -------------------- --- 160,166 ---- :M WM_INITDIALOG swap On_Init: [ self ] ;M ! :M On_Init: ( hwndfocus -- f ) ! \ *G Init the dialog ! drop 1 ;M \ -------------------- Process Commands from Controls -------------------- *************** *** 176,179 **** --- 171,175 ---- :M On_Command: ( hCtrl code ID -- f ) + \ *G Process Commands from Controls case *************** *** 191,194 **** --- 187,191 ---- ;Class + \ *G End of Dialog class \ December 11th, 2003 jeh, In order to use ModelessDialog you must extend the *************** *** 198,202 **** --- 195,205 ---- \ not required, only the GetTemplate method is required. + \ *W <a name="ModelessDialog"></a> + \ *S Modless Dialog class :Class ModelessDialog <SUPER Dialog + \ *G Modless Dialog class \n + \ ** To use this class you have to create a ressource file (*.res) whitch must contain + \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog + \ ** resource you should use ForthForm to create your dialog windows instead. int hTemplate *************** *** 209,212 **** --- 212,216 ---- :M WindowStyle: ( -- n1 ) + \ *G Get the window style of the dialog. GetTemplate: [ self ] dup if dup cell+ @ + @ *************** *** 215,218 **** --- 219,223 ---- :M ExWindowStyle: ( -- n1 ) + \ *G Get the extended window style of the dialog. GetTemplate: [ self ] dup if dup cell+ @ + cell+ @ *************** *** 221,224 **** --- 226,230 ---- :M Origin: ( -- x y ) + \ *G Get the origin (upper left corner) of the dialog. GetTemplate: [ self ] ?dup if dup cell+ @ + 2 cells+ 2 + @ word-split *************** *** 250,253 **** --- 256,260 ---- :M Start: ( parent -- ) + \ *G Open the dialog hTemplate 0= if GetTemplate: [ self ] *************** *** 259,262 **** --- 266,270 ---- :M EndDialog: ( n1 -- ) + \ *G Close the dialog drop DestroyWindow: self *************** *** 276,283 **** ;Class \ *Z - - - - --- 284,288 ---- ;Class + \ *G End of ModlessDialog class \ *Z Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** CONTROL.F 26 Dec 2005 09:28:23 -0000 1.5 --- CONTROL.F 31 Dec 2005 11:12:44 -0000 1.6 *************** *** 46,49 **** --- 46,53 ---- \ -------------------- Control Class -------------------- + \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). + \ Since we have a mutch better toolbar class in Win32Forth for some time now, I + \ (dbu) didn't spend the time to see how this works. And so I didn't document it. + INTERNAL \ definitions accessible while defining a buttonbar *************** *** 62,66 **** EXTERNAL \ definitions always accessible ! TRUE value info-flag \ are we displaying tool tips FALSE value mouse-is-down? --- 66,70 ---- EXTERNAL \ definitions always accessible ! TRUE value info-flag \ are we displaying tool tips FALSE value mouse-is-down? *************** *** 80,84 **** between and ; ! :Class Control <Super Dialog&Control \ Generic-Window \ The following definition must directly precede old-wndproc to work correctly --- 84,93 ---- between and ; ! \ *W <a name="Control"></a> ! \ *S Generic Control class ! :Class Control <Super Dialog&Control ! \ *G Generic control class. \n ! \ ** Since Control is a generic class it should not be used to create ! \ ** any instances. \ The following definition must directly precede old-wndproc to work correctly *************** *** 97,101 **** int timering? \ are we opening a popup info window int timerclosed? \ has popup been closed ! int auto-close? \ does info window automatically close after a time? max-binfo 1+ bytes binfo --- 106,110 ---- int timering? \ are we opening a popup info window int timerclosed? \ has popup been closed ! int auto-close? \ does info window automatically close after a time? max-binfo 1+ bytes binfo *************** *** 124,135 **** \ -------------------- SubClassing -------------------- ! \ : subclass ( -- ) ! \ 0xE8909090 thunk ! ( call ) ! \ subclass-entry thunk 2 cells+ - thunk cell+ ! ( offset ) ! \ thunk 2 cells+ dup ! ( relocate offset ) ! \ thunk GWL_WNDPROC hWnd Call SetWindowLong ! \ to old-wndproc ; ! ! : subclass ( -- ) (controllock) code-here \ for SetWindowLong to pick up --- 133,137 ---- \ -------------------- SubClassing -------------------- ! : subclass ( -- ) (controllock) code-here \ for SetWindowLong to pick up *************** *** 155,188 **** :M GetParent: ( -- parent ) ! parent ! ;M :M GetHandleOfParent: ( -- handleofparent ) ! handleofparent ! ;M :M SetID: ( id -- ) ! to id ! ;M :M GetID: ( -- id ) ! id ! ;M :M ExWindowStyle: ( -- exstyle ) 0 ;M :M WindowStyle: ( -- style ) [ WS_CHILD WS_VISIBLE or ] literal ;M ! :M StartSize: ( -- width height ) 0 0 ;M \ override to change ! :M StartPos: ( -- left top ) 0 0 ;M \ override to change ! \ this pointer to a structure, depends on what kind of window you are ! \ creating, so we just default it to NULL :M CreateStruct: ( -- CreateStrucPointer ) ! NULL ! ;M : create-control ( z"classname" -- ) --- 157,198 ---- :M GetParent: ( -- parent ) ! \ *G Get the parent window of this control. ! parent ;M :M GetHandleOfParent: ( -- handleofparent ) ! \ *G Get the window handle of the parent window of this control. ! handleofparent ;M :M SetID: ( id -- ) ! \ *G Set the ID of this control. Normaly you don't need to do this, because ! \ ** every control get's an unique ID when it's created. ! to id ;M :M GetID: ( -- id ) ! \ *G Get the ID of this control ! id ;M :M ExWindowStyle: ( -- exstyle ) + \ *G Get the extended window style of this control 0 ;M :M WindowStyle: ( -- style ) + \ *G Get the window style of this control [ WS_CHILD WS_VISIBLE or ] literal ;M ! :M StartSize: ( -- width height ) ! \ *G Get the start size of this control. \n ! \ ** Override this method to change it. ! 0 0 ;M \ ! :M StartPos: ( -- left top ) ! \ *G Get the start position of this control. \n ! \ ** Override this method to change it. ! 0 0 ;M :M CreateStruct: ( -- CreateStrucPointer ) ! \ *G This pointer to a structure, depends on what kind of window you are ! \ ** creating, so we just default it to NULL. ! NULL ;M : create-control ( z"classname" -- ) *************** *** 204,207 **** --- 214,221 ---- ; + \ Support for displaying tool tips; used by the oldstyle buttonbars (e.g. in WinEd). + \ Since we have a mutch better toolbar class in Win32Forth for some time now, I + \ (dbu) didn't spend the time to see how this works. And so I didn't document it. + 1 constant INFO_START_TIMER \ timer constant 2 constant INFO_END_TIMER \ timer constant *************** *** 217,230 **** :M BInfo: ( -- a1 ) \ return the counted string of button info ! binfo ! ;M ! :M SetAutoClose: ( flag -- ) \ set the state of the automatic infor close feature ! to auto-close? ! ;M :M GetAutoClose: ( -- flag ) ! auto-close? ! ;M :M WM_TIMER ( h m w l -- res ) --- 231,241 ---- :M BInfo: ( -- a1 ) \ return the counted string of button info ! binfo ;M ! :M SetAutoClose: ( flag -- ) \ set the state of the automatic info close feature ! to auto-close? ;M :M GetAutoClose: ( -- flag ) ! auto-close? ;M :M WM_TIMER ( h m w l -- res ) *************** *** 266,271 **** :M amForground?: ( -- f1 ) ! TRUE ! ;M :M On_MouseMove: ( h m w -- ) --- 277,281 ---- :M amForground?: ( -- f1 ) ! TRUE ;M :M On_MouseMove: ( h m w -- ) *************** *** 297,300 **** --- 307,311 ---- ;Class + \ *G End of Control class module |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X