From: Dirk B. <db...@us...> - 2006-06-06 02:49:49
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20986/src Modified Files: CHILDWND.F Window.f Log Message: window class changes: - New ivar hWndParent added as a replacement for the Parent ivar. - New methods SetParentWindow: and GetParentWindow: added - The SetParent: and ParentWindow: methods are depreacted. - some minor cleanup child-window class changes: - SetParent: method added - some minor cleanup Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** Window.f 28 May 2006 09:50:12 -0000 1.15 --- Window.f 5 Jun 2006 07:37:15 -0000 1.16 *************** *** 66,78 **** int clicking? MAXSTRING bytes WindowClassName ! int Parent - int mydialoglink \ The following is for backward compatibility. Use WinRect for new code since it will \ be early bound whereas wRect will be latebound. int wRect Rectangle WinRect ! synonym WndRect wrect ! synonym tempRect wrect :M ClassInit: ( -- ) --- 66,82 ---- int clicking? MAXSTRING bytes WindowClassName ! int Parent \ object address of the parent window ! \ Note: this ivar was moved here form the child-window class some ! \ time ago. Altough it's not realy needed in the window class I ! \ left it here in order not to brake to mutch code (Sonntag, Juni 04 2006 dbu). ! int hWndParent \ handle of the parent window (added Sonntag, Juni 04 2006 dbu) ! int mydialoglink \ The following is for backward compatibility. Use WinRect for new code since it will \ be early bound whereas wRect will be latebound. int wRect Rectangle WinRect ! synonym WndRect wrect ! synonym TempRect wrect :M ClassInit: ( -- ) *************** *** 87,90 **** --- 91,97 ---- 0 to CurrentPopup 0 to CurrentMenu + 0 to Parent \ added Sonntag, Juni 04 2006 dbu + 0 to hWndParent \ added Sonntag, Juni 04 2006 dbu + 0 to mydialoglink \ added Sonntag, Juni 04 2006 dbu 640 to Width 480 to Height *************** *** 109,113 **** \ ----------------------------------------------------------------- ! :M GetSize: ( -- w h ) \ *G Get the size (width and height) of the window. Width Height ;M --- 116,120 ---- \ ----------------------------------------------------------------- ! :M GetSize: ( --width height ) \ *G Get the size (width and height) of the window. Width Height ;M *************** *** 121,130 **** Height ;M ! :M SetSize: ( w h -- ) ! \ *G Set the size (width and height) of the window. \n \ ** Note: The window itself will not be resized. to Height to Width ;M ! :M On_Size: ( -- ) \ *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 --- 128,137 ---- Height ;M ! :M SetSize: ( width height -- ) ! \ *G Set the size of the window. \n \ ** Note: The window itself will not be resized. to Height to Width ;M ! :M On_Size: ( wParam -- ) \ *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 *************** *** 135,142 **** word-split to Height to Width ; ! :M WM_SIZE ( hndl msg wparam lparam -- res ) set-size On_Size: [ self ] 0 ;M ! :M WM_MOVE ( hwnd msg wparam lparam -- res ) EraseRect: WinRect \ make a new rectangle WinRect --- 142,149 ---- word-split to Height to Width ; ! :M WM_SIZE ( hndl msg wParam lParam -- res ) set-size On_Size: [ self ] 0 ;M ! :M WM_MOVE ( hwnd msg wParam lParam -- res ) EraseRect: WinRect \ make a new rectangle WinRect *************** *** 302,306 **** register-the-class ; ! : create-frame-window ( -- hwnd ) \ calc window rect 0 0 \ adjust x,y relative to 0,0 --- 309,313 ---- register-the-class ; ! : create-frame-window ( -- hwnd ) \ calc window rect 0 0 \ adjust x,y relative to 0,0 *************** *** 321,325 **** 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 --- 328,332 ---- 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 *************** *** 438,452 **** WindowClassName count ;M ! :M SetParent: ( Parent -- ) ! \ *G Set owner window (0 if no parent). ! \ ** Note: The parent is the object address of the parent window ! \ ** class not the window handle. ! to Parent ;M ! :M ParentWindow: ( -- Parent | 0 if no parent ) ! \ *G Get owner window. ! \ ** Note: The parent is the object address of the parent window ! \ ** class not the window handle. ! Parent ;M :M DefaultCursor: ( -- cursor-id ) --- 445,465 ---- WindowClassName count ;M ! :M SetParentWindow: ( hWndParent -- ) ! \ *G Set handle of the owner window (0 if no parent). ! to hWndParent ;M ! :M GetParentWindow: ( -- hWndParent ) ! \ *G Get the handle of the owner window (0 if no parent). ! hWndParent ;M ! ! :M SetParent: ( hWndParent -- ) ! \ *G Set handle of the owner window (0 if no parent). ! \ *P NOTE: This method is depreacted. Use SetParentWindow: instead. ! to hWndParent ;M DEPRECATED ! ! :M ParentWindow: ( -- hWndParent ) ! \ *G Get the handle of the owner window (0 if no parent). ! \ *P NOTE: This method is depreacted. Use GetParentWindow: instead. ! hWndParent ;M DEPRECATED :M DefaultCursor: ( -- cursor-id ) *************** *** 825,829 **** : GetPositionParent ( -- x y wb hb ) ! Parent dup 0> if pad 16 erase pad swap Call GetWindowRect ?win-error --- 838,842 ---- : GetPositionParent ( -- x y wb hb ) ! hWndParent dup 0> if pad 16 erase pad swap Call GetWindowRect ?win-error *************** *** 855,858 **** --- 868,872 ---- \ 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. *************** *** 864,868 **** :M GetWindowRect: ( -- left top right bottom ) \ *G The GetWindowRect method retrieves the dimensions of the bounding rectangle of the window. ! \ ** The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen. hWnd if EraseRect: WinRect --- 878,883 ---- :M GetWindowRect: ( -- left top right bottom ) \ *G The GetWindowRect method retrieves the dimensions of the bounding rectangle of the window. ! \ ** The dimensions are given in screen coordinates that are relative to the upper-left corner ! \ of the screen. hWnd if EraseRect: WinRect Index: CHILDWND.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** CHILDWND.F 14 May 2006 09:54:12 -0000 1.6 --- CHILDWND.F 5 Jun 2006 07:37:15 -0000 1.7 *************** *** 18,21 **** --- 18,36 ---- int id \ id for this child window + \ int Parent \ object address of the parent window + \ Note: this ivar was moved into the window class some time ago. + \ Altough it's not realy needed in the window class I (dbu) left + \ it there in oder not to brake to mutch code (Sonntag, Juni 04 2006 dbu). + + :M ClassInit: ( -- ) + \ *G Initialise the class. + ClassInit: super + 0 to id + ;M + + :M SetParent: ( parent -- ) + \ *G Set the object address of the parent window. + Parent ;M + :M GetParent: ( -- parent ) \ *G Get the object address of the parent window. *************** *** 23,31 **** :M SetID: ( n -- ) ! \ *G Set the ID for this child window to id ;M :M GetID: ( -- n ) ! \ *G Get the ID for this child window id ;M --- 38,46 ---- :M SetID: ( n -- ) ! \ *G Set the ID for this child window. to id ;M :M GetID: ( -- n ) ! \ *G Get the ID for this child window. id ;M *************** *** 45,73 **** : register-child-window ( -- f ) ! WndClassStyle: [ self ] to Style ! TheWndProc to WndProc ! 0 to ClsExtra ! 4 to WndExtra ! appInst to hInstance ! NULL to hIcon ! IDC_ARROW NULL Call LoadCursor to hCursor ! NULL to hbrBackground ! NULL to MenuName \ Set the window class name for this child window. Every window \ will become it's own class name and it's own window class. ! default-class-name ! WindowClassName 1+ to ClassName register-the-class ; ! : create-child-window ( -- hWnd ) ^base \ creation parameters appInst \ program instance id \ child id ! Parent conhndl = ! if conhndl ! else GetHandle: Parent \ parent window handle ! then StartSize: [ self ] swap \ height, width StartPos: [ self ] swap \ y, x starting position --- 60,97 ---- : register-child-window ( -- f ) ! \ Register the window class for this child window. ! WndClassStyle: [ self ] to Style ! TheWndProc to WndProc ! 0 to ClsExtra ! 4 to WndExtra ! appInst to hInstance ! NULL to hIcon ! IDC_ARROW NULL Call LoadCursor to hCursor ! NULL to hbrBackground ! NULL to MenuName \ Set the window class name for this child window. Every window \ will become it's own class name and it's own window class. ! default-class-name WindowClassName 1+ to ClassName register-the-class ; ! : GetParentWindow ( -- hWnd ) ! \ Get the parent window handle for this child window. ! \ If this window has no parent the window of the console is used as the parent. ! \ If no console is pressent the parent handle will be NULL. ! Parent if GetHandle: parent else conhndl then ! ! \ make shure that we have a valid window handle ! \ and tell the super class about it. ! dup call IsWindow 0= if drop NULL then ! dup SetParentWindow: super ; ! ! : create-child-window ( -- hWnd ) ! \ Create this child window. ^base \ creation parameters appInst \ program instance id \ child id ! GetParentWindow \ parent window handle StartSize: [ self ] swap \ height, width StartPos: [ self ] swap \ y, x starting position *************** *** 89,93 **** :M Start: ( Parent -- ) ! \ *G Create the child window. to Parent register-child-window drop --- 113,118 ---- :M Start: ( Parent -- ) ! \ *G Create this child window. Parent is the object address of the ! \ ** parent window. to Parent register-child-window drop |