Update of /cvsroot/win32forth/win32forth-stc/demos
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14462
Added Files:
WINHELLO.F
Log Message:
Jos: I could not resist to test this demo! It is great that we can do windows in the ST-version!
--- NEW FILE: WINHELLO.F ---
\ WINHELLO.F Simple Windows Hello World by Tom Zimmer
\ See also HELLO.F for a similar example that doesn't use objects
false value CreateTurnkey? \ set to TRUE if you want to create a turnkey application
needs window.f
\ Define an object "HelloWindow" that is a super object of class "Window"
:Object HelloWindow <Super Window
int counter \ a local variable for a counter
:M StartSize: ( -- w h ) \ the screen origin of our window
170 90
;M
:M StartPos: ( -- x y ) \ the width and height of our window
200 100
;M
:M WindowTitle: ( -- Zstring ) \ window caption
z" Hello World"
;M
:M On_EraseBackground: ( hwnd msg wparam lparam -- res )
\ let the On_Paint: Method redraw the background
4drop 0 ;M
:M On_Paint: { \ temp$ -- } \ all window refreshing is done by On_Paint:
\ draw background only if needed
ps_fErase
if
\ cr ." erase background"
ps_left ps_top ps_right ps_bottom
black FillArea: dc
then
\ check if our drawing area is visible or not
0 0 170 90 SetRect: wRect
AddrOf: wRect GetHandle: dc call RectVisible
if
\ cr ." visible"
\ let's draw...
black SetBkColor: dc
ltgreen SetTextColor: dc
MAXSTRING LocalAlloc: temp$
s" Repainted " temp$ place
counter (.) temp$ +place
s" times" temp$ +place
20 ( x ) 50 ( y ) temp$ count TextOut: dc
20 ( x ) 20 ( y ) s" Hello World" TextOut: dc
\ else cr ." invisible"
then ;M
:M Paint: ( -- )
\ Note: The Paint: method of the window class invalidates the
\ complete client rectangle. Since we only draw in a smal part
\ of the window only the the part of the window in whitch we
\ are going to draw is marked as invalid.
0 0 170 90 SetRect: wRect
1 AddrOf: wRect hWnd Call InvalidateRect ?win-error
;M
:M WM_TIMER ( h m w l -- res ) \ handle the WM_TIMER events
1 +to counter \ bump the counter
Paint: self \ refresh the window
0 ;M
:M On_Init: ( -- ) \ things to do at the start of window creation
On_Init: super \ do anything superclass needs
0 to counter \ then initialize counter is zero
0 200 1 hWnd Call SetTimer drop \ init timer to a 200 ms rate
;M
:M On_Done: ( -- ) \ things to do before program termination
1 hWnd Call KillTimer drop \ destroy the timer, we are done
On_Done: super \ then do things superclass needs
CreateTurnkey? if bye then \ terminate application
;M
;Object
CreateTurnkey? [IF]
: DEMO ( -- ) \ start running the demo program
Start: HelloWindow ;
' DEMO turnkey WinHello \ create WinHello.exe
[ELSE]
: DEMO ( -- ) \ start running the demo program
Start: HelloWindow ;
: UNDEMO ( -- ) \ close the demo window
Close: HelloWindow ;
cr .( Type: DEMO to start, and: UNDEMO to stop) cr
[THEN]
demo
|
