Menu
▾
▴
[Win32forth-cvs] win32forth/src Class.f,1.13,1.14 Window.f,1.8,1.9
|
From: George H. <geo...@us...> - 2006-01-25 11:11:11
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15558/win32forth/src Modified Files: Class.f Window.f Log Message: gah: Some optimizations and documenting Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Window.f 24 Dec 2005 11:57:59 -0000 1.8 --- Window.f 25 Jan 2006 11:10:53 -0000 1.9 *************** *** 40,47 **** :CLASS Window <SUPER Generic-Window ! \ *G Class for window objects. \ The following synonyms replace the original global rectangle object ! \ and dotted notations for it for backward compatibility: see Generic.f synonym WndRect.addrof wRect.addrof synonym WndRect.left wRect.left --- 40,47 ---- :CLASS Window <SUPER Generic-Window ! \ *G Base class for window objects. \ The following synonyms replace the original global rectangle object ! \ and dotted notations for it, for backward compatibility: see Generic.f synonym WndRect.addrof wRect.addrof synonym WndRect.left wRect.left *************** *** 76,80 **** :M ClassInit: ( -- ) ! \ *G Init the class ClassInit: super 0 to OriginX --- 76,80 ---- :M ClassInit: ( -- ) ! \ *G Initialise the class. ClassInit: super 0 to OriginX *************** *** 106,110 **** \ ----------------------------------------------------------------- ! \ *N Window sizeing \ ----------------------------------------------------------------- --- 106,110 ---- \ ----------------------------------------------------------------- ! \ *N Window sizing \ ----------------------------------------------------------------- *************** *** 129,133 **** \ *G User windows should override the On_Size: method. When this method is \ ** called, the variables Width and Height will have already been set. \n ! \ ** default does nothing ;M --- 129,133 ---- \ *G User windows should override the On_Size: method. When this method is \ ** called, the variables Width and Height will have already been set. \n ! \ ** Default does nothing ;M *************** *** 140,144 **** :M WM_MOVE ( hwnd msg wparam lparam -- res ) EraseRect: WinRect \ make a new rectangle ! AddrOf: WinRect hWnd Call GetWindowRect \ adjust the window if Left: WinRect to OriginX --- 140,144 ---- :M WM_MOVE ( hwnd msg wparam lparam -- res ) EraseRect: WinRect \ make a new rectangle ! WinRect hWnd Call GetWindowRect \ adjust the window if Left: WinRect to OriginX *************** *** 148,156 **** :M MinSize: ( -- width height ) ! \ *G To change the minimum window size, override the MinSize: method. 10 10 ;M :M MaxSize: ( -- width height ) ! \ *G To change the maximum window size, override the MaxSize: method. 8192 8192 ;M --- 148,156 ---- :M MinSize: ( -- width height ) ! \ *G To change the minimum window size, override the MinSize: method. Default is 10 by 10. 10 10 ;M :M MaxSize: ( -- width height ) ! \ *G To change the maximum window size, override the MaxSize: method. Default is 8192 by 8192. 8192 8192 ;M *************** *** 182,187 **** AddrOf: WinRect \ make a new rectangle Call AdjustWindowRectEx ?win-error \ adjust the window ! Bottom: WinRect Top: WinRect - \ adjusted height ! Right: WinRect Left: WinRect - \ adjusted width ; --- 182,187 ---- AddrOf: WinRect \ make a new rectangle Call AdjustWindowRectEx ?win-error \ adjust the window ! Height: WinRect \ adjusted height ! Width: WinRect \ adjusted width ; *************** *** 300,305 **** NULL LoadMenu: [ self ] \ menu ParentWindow: [ self ] \ parent window handle ! Bottom: WinRect Top: WinRect - \ adjusted height ! Right: WinRect Left: WinRect - \ adjusted width StartPos: [ self ] swap \ y, x starting position WindowStyle: [ self ] \ the window style --- 300,305 ---- NULL LoadMenu: [ self ] \ menu ParentWindow: [ self ] \ parent window handle ! Height: WinRect \ adjusted height ! Width: WinRect \ adjusted width StartPos: [ self ] swap \ y, x starting position WindowStyle: [ self ] \ the window style *************** *** 329,337 **** :M On_Init: ( -- ) ! \ *G Thing's to do during creation of the window. ;M :M On_Done: ( -- ) ! \ *G Thing's to do when the window will be destroyed. ;M --- 329,337 ---- :M On_Init: ( -- ) ! \ *G Thing's to do during creation of the window. Default does nothing. ;M :M On_Done: ( -- ) ! \ *G Thing's to do when the window will be destroyed. Default does nothing. ;M *************** *** 348,355 **** \ ** ;M \ ** ! \ ** An application window will need the following methods, which cause the \ ** program to terminate when the user closes the main application window. ! \ ** Don't un-comment these out here, copy them into your application window ! \ ** Object or Class, and them un-comment them out. \ ** \ ** :M WM_CLOSE ( h m w l -- res ) --- 348,356 ---- \ ** ;M \ ** ! \ ** ! \ ** The main application window will need the following methods, which cause the \ ** program to terminate when the user closes the main application window. ! \ ** Don't uncomment these out here, copy them into your application window ! \ ** Object or Class, and then uncomment them out. \ ** \ ** :M WM_CLOSE ( h m w l -- res ) *************** *** 361,364 **** --- 362,373 ---- \ ** On_Done: super \ cleanup the super class \ ** 0 ;M + \ ** + \ ** For multi-tasking applications the main window of each task should define + \ ** the following method, to quit the message loop and exit the task. + \ ** + \ ** :M On_Done: ( h m w l -- res ) + \ ** 0 call PostQuitMessage drop \ terminate application + \ ** On_Done: super \ cleanup the super class + \ ** 0 ;M :M WM_CLOSE ( hwnd msg wparam lparam -- res ) *************** *** 384,406 **** :M GetClassName: ( -- adr len ) ! \ *G Get the window class name WindowClassName count ;M :M SetParent: ( hwndParent -- ) ! \ *G Set owner window (0 if no parent) to Parent ;M :M ParentWindow: ( -- hwndparent | 0 if no parent ) ! \ *G Get owner window Parent ;M :M DefaultCursor: ( -- cursor-id ) \ *G User windows should override the DefaultCursor: method to ! \ ** set the default cursor for window IDC_ARROW ;M :M DefaultIcon: ( -- hIcon ) \ *G User windows should override the WindowStyle: method to ! \ ** set the default icon handle for window. 101 appInst Call LoadIcon dup 0= if drop 100 z" w32fConsole.dll" Call GetModuleHandle Call LoadIcon --- 393,415 ---- :M GetClassName: ( -- adr len ) ! \ *G Get the window class name. WindowClassName count ;M :M SetParent: ( hwndParent -- ) ! \ *G Set owner window (0 if no parent). to Parent ;M :M ParentWindow: ( -- hwndparent | 0 if no parent ) ! \ *G Get owner window. Parent ;M :M DefaultCursor: ( -- cursor-id ) \ *G User windows should override the DefaultCursor: method to ! \ ** set the default cursor for window. Default is IDC_ARROW. IDC_ARROW ;M :M DefaultIcon: ( -- hIcon ) \ *G User windows should override the WindowStyle: method to ! \ ** set the default icon handle for window. Default is the W32F icon. 101 appInst Call LoadIcon dup 0= if drop 100 z" w32fConsole.dll" Call GetModuleHandle Call LoadIcon *************** *** 409,423 **** :M WindowStyle: ( -- style ) \ *G User windows should override the WindowStyle: method to ! \ ** set the window style. WS_OVERLAPPEDWINDOW ;M :M ExWindowStyle: ( -- extended_style ) \ *G User windows should override the ExWindowStyle: method to ! \ ** set the extended window style. 0 ;M :M WindowTitle: ( -- Zstring ) \ *G User windows should override the WindowTitle: method to ! \ ** set the window caption. z" Window" ;M --- 418,432 ---- :M WindowStyle: ( -- style ) \ *G User windows should override the WindowStyle: method to ! \ ** set the window style. Default is WS_OVERLAPPEDWINDOW. WS_OVERLAPPEDWINDOW ;M :M ExWindowStyle: ( -- extended_style ) \ *G User windows should override the ExWindowStyle: method to ! \ ** set the extended window style. Default is null. 0 ;M :M WindowTitle: ( -- Zstring ) \ *G User windows should override the WindowTitle: method to ! \ ** set the window caption. Default is Window. z" Window" ;M *************** *** 449,453 **** \ *G User windows should override the On_EraseBackground: method to handle \ ** WM_ERASEBKGND messages. \n ! \ ** Default does nothing DefWindowProc: [ self ] ;M --- 458,462 ---- \ *G User windows should override the On_EraseBackground: method to handle \ ** WM_ERASEBKGND messages. \n ! \ ** Default does nothing. DefWindowProc: [ self ] ;M *************** *** 462,466 **** \ ** be drawn and use ps_left, ps_top, ps_right and ps_bottom to see whitch part of \ ** the window should be painted. \n ! \ ** Default does nothing ;M --- 471,475 ---- \ ** be drawn and use ps_left, ps_top, ps_right and ps_bottom to see whitch part of \ ** the window should be painted. \n ! \ ** Default does nothing. ;M *************** *** 502,506 **** :M WindowHasMenu: ( -- flag ) ! \ *G Override this method if your window has a menu FALSE ;M --- 511,516 ---- :M WindowHasMenu: ( -- flag ) ! \ *G Flag is true if the window has a menu. Override this method if your window has a ! \ ** menu. Default is false. FALSE ;M *************** *** 515,519 **** :M MoveCursor: ( gx gy -- ) ! \ *G Move the caret 1+ \ correct for single pixel start offset have-focus? --- 525,529 ---- :M MoveCursor: ( gx gy -- ) ! \ *G Move the caret. 1+ \ correct for single pixel start offset have-focus? *************** *** 528,532 **** :M MakeCursor: ( gx gy width height -- ) ! \ *G Create the caret have-focus? cursor-on? 0= and if 2dup to c-height to c-width --- 538,542 ---- :M MakeCursor: ( gx gy width height -- ) ! \ *G Create the caret. have-focus? cursor-on? 0= and if 2dup to c-height to c-width *************** *** 542,546 **** :M DestroyCursor: ( -- ) ! \ *G Destroy the caret have-focus? cursor-on? and hWnd 0<> and --- 552,556 ---- :M DestroyCursor: ( -- ) ! \ *G Destroy the caret. have-focus? cursor-on? and hWnd 0<> and *************** *** 552,556 **** :M ShowCursor: ( -- ) ! \ *G Show the caret cursor-on? 0= if c-x c-y c-width c-height MakeCursor: self --- 562,566 ---- :M ShowCursor: ( -- ) ! \ *G Show the caret. cursor-on? 0= if c-x c-y c-width c-height MakeCursor: self *************** *** 559,563 **** :M HideCursor: ( -- ) ! \ *G Hide the caret cursor-on? if DestroyCursor: self --- 569,573 ---- :M HideCursor: ( -- ) ! \ *G Hide the caret. cursor-on? if DestroyCursor: self *************** *** 591,595 **** :M PushKey: ( c1 -- ) ! \ *G override to process keys yoruself pushkey ;M --- 601,605 ---- :M PushKey: ( c1 -- ) ! \ *G override to process keys yoruself. pushkey ;M *************** *** 789,794 **** :M CenterWindow: ( -- x y ) ! \ *G Calc the position of the window to center it in the middle of it's parent window. ! \ ** Whe the windows has no parent it will be placed in the middle of the primary display \ ** monitor. GetPositionParent --- 799,804 ---- :M CenterWindow: ( -- x y ) ! \ *G Calculate the position of the window to center it in the middle of it's parent window. ! \ ** When the windows has no parent it will be placed in the middle of the primary display \ ** monitor. GetPositionParent *************** *** 799,802 **** --- 809,814 ---- \ I (dbu) think the methods should be in the base class, but... + \ the rectangle winrect was moved to after the ints width are height since their offsets + \ are hard-coded in the file lib\RegistrySupport.f (gah). The same applies to parent. :M Enable: ( f1 -- ) *************** *** 809,813 **** hWnd if EraseRect: WinRect ! AddrOf: WinRect hWnd Call GetWindowRect ?win-error Left: WinRect Top: WinRect Right: WinRect Bottom: WinRect --- 821,825 ---- hWnd if EraseRect: WinRect ! WinRect hWnd Call GetWindowRect ?win-error Left: WinRect Top: WinRect Right: WinRect Bottom: WinRect *************** *** 816,820 **** :M SetTitle: { adr len \ temp$ -- } ! \ *G Set the window title MAXSTRING LocalAlloc: temp$ adr len "CLIP" temp$ place --- 828,832 ---- :M SetTitle: { adr len \ temp$ -- } ! \ *G Set the window title. MAXSTRING LocalAlloc: temp$ adr len "CLIP" temp$ place *************** *** 840,855 **** ;CLASS ! \ *G End of window class : find-window ( z"a1 -- hWnd ) \ w32f ! \ *G Find a window 0 swap Call FindWindow ; : send-window ( lParam wParam Message_ID hWnd -- ) \ w32f ! \ *G Send a message to a window Call SendMessage drop ; : LoadIconFile ( adr len -- hIcon ) \ w32f ! \ *G load an icon from a icon file asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ; --- 852,867 ---- ;CLASS ! \ *G End of window class. : find-window ( z"a1 -- hWnd ) \ w32f ! \ *G Find a window. 0 swap Call FindWindow ; : send-window ( lParam wParam Message_ID hWnd -- ) \ w32f ! \ *G Send a message to a window. Call SendMessage drop ; : LoadIconFile ( adr len -- hIcon ) \ w32f ! \ *G Load an icon from a icon file. asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ; Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** Class.f 24 Jan 2006 09:13:22 -0000 1.13 --- Class.f 25 Jan 2006 11:10:53 -0000 1.14 *************** *** 1213,1216 **** --- 1213,1217 ---- :Class Rectangle <Super Object + \ *G Class for rectangles for passing to the OS. Record: AddrOf *************** *** 1221,1237 **** ;Record - :M EraseRect: ( -- ) - 0 to Left - 0 to Top - 0 to Right - 0 to Bottom - ;M - - :M ClassInit: ( -- ) - ClassInit: super - EraseRect: self - ;M - :M SetRect: ( left top right bottom -- ) to Bottom to Right --- 1222,1227 ---- ;Record :M SetRect: ( left top right bottom -- ) + \ *G Set coordinates to Bottom to Right *************** *** 1240,1243 **** --- 1230,1242 ---- ;M + :M EraseRect: ( -- ) + \ *G Set all coordinates to zero. + 0 0 0 0 SetRect: self ;M + + :M ClassInit: ( -- ) + \ *G Initialise the object. The coordinates are set to zero. + ClassInit: super + EraseRect: self ;M + :M AddrOf: ( -- n1 ) AddrOf ;M :M Addr: ( -- n1 ) AddrOf ;M *************** *** 1247,1252 **** :M Bottom: ( -- n1 ) Bottom ;M ! :M Width: ( -- n1 ) right left - ;M ! :M Height: ( -- n1 ) bottom top - ;M :M .Rect: ( -- ) --- 1246,1253 ---- :M Bottom: ( -- n1 ) Bottom ;M ! :M Width: ( -- n1 ) ! right left - ;M ! :M Height: ( -- n1 ) ! bottom top - ;M \ cordinates are relative to the top of the screen. :M .Rect: ( -- ) *************** *** 1267,1270 **** --- 1268,1272 ---- : .CLASSES ( -- ) \ W32F Class \ *G Display all classes in the system. + \ Should really be in classdbg. cr \ classes are really vocabularies voc-link @ |
