Update of /cvsroot/win32forth/win32forth/Templates
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19673/Templates
Added Files:
MinimalWindow.f PopupWindow.f
Log Message:
Jos: A start for the templates.
--- NEW FILE: PopupWindow.f ---
anew -PopupWindow.f
\ Needed in a listview or treeview when you would like to have a popup menu.
\ The popup window could be activated when there is a right click on an item.
defer ClosePopupWindow ' noop is ClosePopupWindow
POPUPBAR PopupOnItem \ Define the Popup bar for a window here.
POPUP " "
MENUITEM "Some action (Not yet defined)" ClosePopupWindow noop ;
ENDBAR
: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
--- NEW FILE: MinimalWindow.f ---
Needs NoConsole.f
Needs Resources.f
Anew -MinimalWindow.f \ With a start of a menubar
false value turnkey?
:Object MinimalWindow <Super Window
:M On_Init: ( -- ) On_Init: super ;M
:M ClassInit: ( -- ) ClassInit: super ;M
:M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M
:M ParentWindow: ( -- hwndParent | 0=NoParent ) parent ;M
:M SetParent: ( hwndparent -- ) to parent ;M
:M WindowHasMenu: ( -- f ) true ;M
:M WindowTitle: ( -- ztitle ) z" Minimal window" ;M
:M StartSize: ( -- width height ) screen-size >r 2/ r> 2/ ;M
:M StartPos: ( -- x y ) CenterWindow: Self ;M
:M Close: ( -- ) Close: super ;M
:M On_Done: ( -- )
Close: self
0 call PostQuitMessage drop
On_Done: super 0
;M
:M msgBox: ( z$menu z$text - ) swap MB_OK MessageBox: Self drop ;M
;Object
MENUBAR ApplicationBar
POPUP "File"
MENUITEM "Exit" Close: MinimalWindow ;
POPUP "Help"
MENUITEM "Info"
z" Info"
z" A template for a \nminimal window."
msgBox: MinimalWindow ;
ENDBAR
: Minimal
start: MinimalWindow
ApplicationBar SetMenuBar: MinimalWindow
turnkey?
IF MessageLoop bye
THEN
;
turnkey? [if]
NoConsoleIO NoConsoleInImage
' Minimal turnkey MinimalWindow.exe
s" WIN32FOR.ICO" s" MinimalWindow.exe" AddAppIcon
1 pause-seconds bye
[else] Minimal
[then]
\s
|
