[Win32forth-cvs] win32forth/apps/Player4 Mediatree.f,1.29,1.30 PopupWindow.f,1.4,1.5

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/apps/Player4
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29467

Modified Files:
	Mediatree.f PopupWindow.f 
Log Message:
Jos: Optimized PopupWindow.f and made the popup menu less aggressive.

Index: PopupWindow.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PopupWindow.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** PopupWindow.f	19 Apr 2006 12:39:20 -0000	1.4
--- PopupWindow.f	12 May 2006 20:06:57 -0000	1.5
***************
*** 1,13 ****
  anew  -PopupWindow.f

- defer GetPositionCatalog
- 
  \ -----------------------------------------------------------------------------
  \       Define the Popup bar for the mediatree in a new window
  \ -----------------------------------------------------------------------------

! 0 value _hwnd
! 
! defer ClosePopupWindow            ' noop is ClosePopupWindow

  POPUPBAR PopupOnRecord
--- 1,9 ----
  anew  -PopupWindow.f

  \ -----------------------------------------------------------------------------
  \       Define the Popup bar for the mediatree in a new window
  \ -----------------------------------------------------------------------------

! defer    ClosePopupWindow            ' noop is ClosePopupWindow

  POPUPBAR PopupOnRecord
***************
*** 15,53 ****
         MENUITEM  "Play file"         ClosePopupWindow PlaySelectedFromTreeView ;
         MENUITEM  "Request record"    ClosePopupWindow RequestRecord ;
-        MENUITEM  "Exit menu"         ClosePopupWindow ;
  ENDBAR

! :Object PopupWindow                <super  Window
  int  focus

! ColorObject FrmColor      \ the background color
! :M ClassInit:     ( -- )  ClassInit: super PopupOnRecord
!                           SetPopupBar: Self true to Focus
                           ;M

! \ Needs the rbuttondown to do it right
! : StartPopup   ( -- ) 0 WM_RBUTTONDOWN GetHandle: self   Call PostMessage drop ;

  :M WindowStyle:   ( -- style )          WS_POPUP                ;M
! :M StartSize:     ( -- width height )   70 30                   ;M
  :M StartPos:      ( -- x y )            mousex  mousey          ;M
! :M WM_LBUTTONDOWN ( h m w l -- res )    2drop 0 close: Self     ;M
! :M On_KillFocus: ( h m w l -- )         2drop focus  if  SetFocus: self  then ;M
! 
! :M On_Paint:    ( -- )
!                 focus
!                 if      hwnd to _hwnd
!                         0 0 GetSize: self Addr: FrmColor FillArea: dc
!                         _hwnd start: PopupOnRecord
!                         StartPopup
!                 then
!                 ;M

! :M On_Done:     ( h m w l -- res )      On_Done: super 0        ;M

! :noname  ( - )  false to focus
!                 _hwnd  call DestroyWindow drop
!                 ; is ClosePopupWindow
  ;Object

! \ start: PopupWindow
--- 11,45 ----
         MENUITEM  "Play file"         ClosePopupWindow PlaySelectedFromTreeView ;
         MENUITEM  "Request record"    ClosePopupWindow RequestRecord ;
  ENDBAR

! :Object    PopupWindow    <super  Window
! 
  int  focus

! :M ClassInit:     ( -- )  ClassInit: super      PopupOnRecord
!                           SetPopupBar: Self     true to Focus
                           ;M

! \ The popupmenu needs a rbuttondown to do it right
! : StartPopup    ( -- )  0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ;
! : CleanupClose  ( h_m w_l - res )       2drop 0 close: Self     ;

  :M WindowStyle:   ( -- style )          WS_POPUP                ;M
! :M StartSize:     ( -- width height )   3 3                     ;M
  :M StartPos:      ( -- x y )            mousex  mousey          ;M
! :M WM_LBUTTONDOWN ( h m w l -- res )    CleanupClose            ;M
! :M On_KillFocus:  ( h m w l -- res )    CleanupClose            ;M
! :M On_Done:       ( h m w l -- res )    On_Done: super 0        ;M
! :M Start:         ( mousex mousey -- )  to mousey to mousex   Start: super  ;M

! :noname  ( - )   false to focus
!                  hwnd  call DestroyWindow drop
!        ; is ClosePopupWindow

! :M On_Paint:    ( -- )
!                 focus   if   hwnd start: PopupOnRecord   StartPopup   then   ;M
  ;Object

! \ mousex mousey  start: PopupWindow   \ Start needs mousex mousey
! 
! \s

Index: Mediatree.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -d -r1.29 -r1.30
*** Mediatree.f	12 Apr 2006 19:44:24 -0000	1.29
--- Mediatree.f	12 May 2006 20:06:57 -0000	1.30
***************
*** 10,13 ****
--- 10,14 ----

  0 value hItem-last-selected
+ defer GetPositionCatalog

  :Class MediaTree <super TreeViewControl
***************
*** 214,218 ****
            if   hWnd dup get-mouse-xy
                 GetPositionCatalog
!                rot + to mousey  + to mousex
                 Start: PopupWindow
            then
--- 215,219 ----
            if   hWnd dup get-mouse-xy
                 GetPositionCatalog
!                rot + >r + r>
                 Start: PopupWindow
            then
***************
*** 303,307 ****
          wait-cursor

!         SW_HIDE Show: self \ hideing the window makes the refresh about 2times faster

          EnableNotify? false to EnableNotify?
--- 304,308 ----
          wait-cursor

!        \ SW_HIDE Show: self \ hideing the window makes the refresh about 2times faster

          EnableNotify? false to EnableNotify?