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

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

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

Modified Files:
	Window.f 
Log Message:
Makes centering of windows possible. A number of sources need to be changed, since the int Parent is now in the Generic-Window

Index: Window.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Window.f	5 Sep 2005 15:51:46 -0000	1.5
--- Window.f	25 Sep 2005 14:14:34 -0000	1.6
***************
*** 119,122 ****
--- 119,138 ----
                  THEN    0 ;
  
+ : GetDeskTopSize ( -- w h )
+    0 pad 0 spi_getworkarea Call SystemParametersInfo DROP
+    pad 8 + 2@ swap
+ ;
+ 
+ : MidPoint ( x y w h - mx my )     rot  + 2/  -rot  + 2/  swap  ;
+ 
+ : CenterAroundMidpoint { mx my w h } ( mx my w h - xl yl )
+         GetDeskTopSize 40 -
+         my h 2/  - 0 max
+         swap h - min
+         mx w 2/  - 0 max
+         rot w - min
+         swap
+  ;
+ 
  \ ------------------------------------------------------------
  
***************
*** 151,154 ****
--- 167,171 ----
      WinDC dc                    \ The window's device context
   16 cells bytes &ps             \ pointer to paint structure
+  int Parent
  
  int mydialoglink
***************
*** 245,253 ****
  :M StartSize:   ( -- width height ) Width Height ;M     \ override to change
  
- :M StartPos:    ( -- left  top )
-                 OriginX
-                 OriginY
-                 ;M
- 
  :M SetOrigin:   ( x y -- )
                  screen-size 100 - rot min 0max to OriginY
--- 262,265 ----
***************
*** 362,366 ****
          4                                                       to wndExtra
          appInst                                                 to hInstance
! 	DefaultIcon:   [ self ]                                 to hIcon
          DefaultCursor: [ self ] NULL Call LoadCursor            to hCursor
          WHITE_BRUSH                  Call GetStockObject        to hbrBackground
--- 374,378 ----
          4                                                       to wndExtra
          appInst                                                 to hInstance
!         DefaultIcon:   [ self ]                                 to hIcon
          DefaultCursor: [ self ] NULL Call LoadCursor            to hCursor
          WHITE_BRUSH                  Call GetStockObject        to hbrBackground
***************
*** 377,383 ****
  : create-frame-window  ( -- hwnd )
  
! 	\ calc window rect
          0 0                                     \ adjust x,y relative to 0,0
          StartSize:     [ self ]                 \ width, height
          SetRect: WinRect
  
--- 389,396 ----
  : create-frame-window  ( -- hwnd )
  
!         \ calc window rect
          0 0                                     \ adjust x,y relative to 0,0
          StartSize:     [ self ]                 \ width, height
+         2dup to Height to Width                 \ Save Height Width
          SetRect: WinRect
  
***************
*** 388,392 ****
          call AdjustWindowRectEx ?win-error      \ adjust the window
  
! 	\ create the window
          ^base                                   \ creation parameters
          appInst                                 \ program instance
--- 401,405 ----
          call AdjustWindowRectEx ?win-error      \ adjust the window
  
!         \ create the window
          ^base                                   \ creation parameters
          appInst                                 \ program instance
***************
*** 413,418 ****
                  ;M
  
! :M ParentWindow: ( -- parent )          \ return the parent, or 0 = no parent
!                 0
                  ;M
  
--- 426,435 ----
                  ;M
  
! :M ParentWindow:  ( -- hwndparent | 0 if no parent )
!                  Parent
!                 ;M
! 
! :M SetParent:  ( hwndParent -- ) \ set owner window
!                 to Parent
                  ;M
  
***************
*** 533,536 ****
--- 550,574 ----
                  ;M
  
+ :M GetPositionParent: ( -- x y wb hb )   \ return upper-left corner
+       Parent dup 0>
+         if      pad 16 erase
+                 pad swap Call GetWindowRect  ?win-error
+                 pad 2@ swap pad 8 + 2@ swap
+          else   drop 0 0 GetDeskTopSize  \ take the desktop when there is no parent.
+          then
+       ;M
+ 
+ :M CenterWindow: ( -- x y )
+                 GetPositionParent: Self
+                 MidPoint
+                 GetSize: self
+                 CenterAroundMidpoint
+  ;M
+ 
+ :M StartPos:    ( -- left  top )
+                 OriginX
+                 OriginY
+                 ;M
+ 
  :M On_Done:     ( -- )
                  ;M
***************
*** 570,574 ****
                  On_Init: [ self ]
                  0
! 		;M
  
  :M WM_DESTROY
--- 608,612 ----
                  On_Init: [ self ]
                  0
!                 ;M
  
  :M WM_DESTROY
***************
*** 827,830 ****
                  Call SendMessage drop ;
  
! : LoadIconFile	( adr len -- hIcon ) \ load an icon from a ico-file
! 		asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ;
--- 865,869 ----
                  Call SendMessage drop ;
  
! : LoadIconFile  ( adr len -- hIcon ) \ load an icon from a ico-file
!         asciiz >r LR_LOADFROMFILE 0 0 IMAGE_ICON r> NULL call LoadImage ;
! \s