Update of /cvsroot/win32forth/win32forth/Templates
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26003/Templates
Modified Files:
PopupWindow.f
Log Message:
Jos: Needed some changes for the treeview
Index: PopupWindow.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/Templates/PopupWindow.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** PopupWindow.f 20 May 2006 15:09:37 -0000 1.1
--- PopupWindow.f 21 May 2006 14:17:34 -0000 1.2
***************
*** 13,59 ****
:Object PopupWindow <super Window
- int focus
-
- :M ClassInit: ( -- )
- ClassInit: super
- PopupOnItem 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: PopupOnItem
! StartPopup
! then
! ;M
! ;Object
! \ Disable the following line in an application
! screen-size >r 2/ r> 2/ Start: PopupWindow \ to show how it looks
! (( A window of an application could defermine mousex mousey
! as follows:
! hWnd get-mouse-xy
! GetWindowRect: Self 2drop
! rot + >r + r> \ mousex mousey
! Start: PopupWindow \ then start the PopupWindow ))
\s
--- 13,48 ----
:Object PopupWindow <super Window
: StartPopup ( -- ) 0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ;
! :noname ( - ) Close: Self ; is ClosePopupWindow
! : CleanupClose ( h_m w_l - res ) 2drop ClosePopupWindow ;
!
! :M ClassInit: ( -- ) ClassInit: super PopupOnItem SetPopupBar: Self ;M
:M WindowStyle: ( -- style ) WS_POPUP ;M
! :M StartSize: ( -- width height ) 1 1 ;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 SetParent: ( HwndParent -- ) to parent ;M
! :M On_Paint: ( -- ) hwnd start: PopupOnItem StartPopup ;M
! :M Start: ( mousex mousey HwndParent -- )
! SetParent: Self
! to mousey to mousex
! Start: super
! ;M
! ;Object
! \ screen-size >r 2/ r> 2/ 0 Start: PopupWindow \ to show how it looks
! (( Use from an other window:
! : StartPopupWindow ( -- )
! hWnd get-mouse-xy
! GetWindowRect: Self 2drop
! rot + >r + r> Hwnd Start: PopupWindow
! ; ))
\s
|
