Update of /cvsroot/win32forth/win32forth/apps/Player4
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9098/apps/Player4
Modified Files:
PLAYER4.F
Log Message:
Jos: Added the splitter object of Rod
Index: PLAYER4.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v
retrieving revision 1.46
retrieving revision 1.47
diff -C2 -d -r1.46 -r1.47
*** PLAYER4.F 8 May 2006 17:33:57 -0000 1.46
--- PLAYER4.F 13 May 2006 21:43:17 -0000 1.47
***************
*** 54,59 ****
needs Resources.f
needs multiopen.f
! needs view.f
!
: invert-check ( check - ) dup c@ not swap c! RefreshWindow ;
--- 54,58 ----
needs Resources.f
needs multiopen.f
! needs view.f
: invert-check ( check - ) dup c@ not swap c! RefreshWindow ;
***************
*** 165,184 ****
;
\ -----------------------------------------------------------------------------
\ Define the Main Window
\ -----------------------------------------------------------------------------
:Object MainWindow <super TrayWindow
!
0 value toolbarH \ set to height of toolbar if any
0 value statusbarH \ set to height of status bar if any
0 value clicked
:M WindowTitle: ( -- Zstring ) \ window caption
z" Player 4th" ;M
- :M ClassInit: ( -- )
- ClassInit: super
- ;M
-
:M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window
LoadAppIcon ;M
--- 164,199 ----
;
+
+ :Object Splitter <Super child-window
+
+ :M WindowStyle: ( -- style ) \ return the window style
+ WindowStyle: super
+ WS_DISABLED or
+ WS_CLIPSIBLINGS or
+ ;M
+
+ :M On_Paint: ( -- ) \ screen redraw method
+ 0 0 Width Height LTGRAY FillArea: dc
+ ;M
+
+ ;Object
+
+ defer OnPosition ( window -- ) ' drop is OnPosition \ called when window panes are repositioned
+ defer OnInit ( window -- ) ' drop is OnInit \ called during window On_init method
+
\ -----------------------------------------------------------------------------
\ Define the Main Window
\ -----------------------------------------------------------------------------
:Object MainWindow <super TrayWindow
! 3 value thickness
0 value toolbarH \ set to height of toolbar if any
0 value statusbarH \ set to height of status bar if any
0 value clicked
+ int dragging?
+ int mousedown?
:M WindowTitle: ( -- Zstring ) \ window caption
z" Player 4th" ;M
:M DefaultIcon: ( -- hIcon ) \ return the default icon handle for window
LoadAppIcon ;M
***************
*** 186,193 ****
:M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M
! : position-windows ( -- ) \ auto adjust windows
! 0 toolbarH SeparatorX @ 1- Height toolbarH - statusbarH - dup>r Move: Catalog
! SeparatorX @ 2+ toolbarH Width 2 pick - r> Move: Player4W
! ;
:noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y )
--- 201,222 ----
:M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M
! : position-windows ( -- )
! 0 toolbarH SeparatorX @ Height Move: Catalog
! SeparatorX @ thickness + toolbarH Width SeparatorX @ thickness + - Height Move: Player4W
! self OnPosition ;
!
! : InSplitter? ( -- f1 ) \ is cursor on splitter window
! hWnd get-mouse-xy
! 0 height within
! swap SeparatorX @ dup thickness + within and ;
!
! :M WM_SETCURSOR ( h m w l -- )
! hWnd get-mouse-xy
! toolbarH dup Height + within
! swap 0 width within and
! IF InSplitter? IF SIZEWE-CURSOR ELSE arrow-cursor THEN 1
! ELSE DefWindowProc: self
! THEN
! ;M
:noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y )
***************
*** 229,253 ****
on_mousemove ;M
! : dosizing ( -- )
! clicked 0= ?exit
! drawline
! \ a minimum width of 4 pixels for windows are set, but it can be changed
! mousex 2 cells < mousex width 2 cells - > or
! if position-windows
! false to clicked
! release-dc
! hwnd Call ReleaseCapture ?win-error
! else mousex SeparatorX !
! drawline
! then ;
! : on_unclicked ( -- )
! clicked 0= ?exit
! drawline
! mousex SeparatorX !
position-windows
! release-dc
! false to clicked
! hwnd Call ReleaseCapture ?win-error ;
:M StartSize: ( -- w h )
--- 258,299 ----
on_mousemove ;M
! \ mouse click routines for Main Window to track the Splitter movement
!
! : DoSizing ( -- )
! mousedown? dragging? or 0= ?EXIT
! mousex ( 1+ ) width min thickness 2/ - SeparatorX !
position-windows
! WINPAUSE ;
!
! : On_clicked ( -- )
! mousedown? 0= IF hWnd Call SetCapture drop THEN
! true to mousedown?
! InSplitter? to dragging?
! DoSizing ;
!
! : On_unclicked ( -- )
! mousedown? IF Call ReleaseCapture drop THEN
! false to mousedown?
! false to dragging? ;
!
! : On_DblClick ( -- )
! false to mousedown?
! InSplitter? 0= ?EXIT
! SeparatorX @ 8 >
! IF 0 thickness 2/ - SeparatorX !
! ELSE 132 Width 2/ min SeparatorX !
! THEN
! position-windows
! ;
!
! :M Classinit: ( -- )
! ClassInit: super \ init super class
! \ TestBar to CurrentMenu
! ['] On_clicked SetClickFunc: self
! ['] On_unclicked SetUnClickFunc: self
! ['] DoSizing SetTrackFunc: self
! ['] On_DblClick SetDblClickFunc: self
! ;M
:M StartSize: ( -- w h )
|
