Update of /cvsroot/win32forth/win32forth-stc/demos
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22727/win32forth-stc/demos
Added Files:
ControlDemo.f
Log Message:
gah:Added demo for controls (from Controls.f)
--- NEW FILE: ControlDemo.f ---
\ $Id: ControlDemo.f,v 1.1 2007/05/03 08:49:21 georgeahubert Exp $
\ Moved to it's own file to make it easier to load (at least til copy/paste works
Require Controls.f
\ ********* SAMPLE Follows ********* SAMPLE Follows *********
0 value check1
:OBJECT EditSample <Super DialogWindow
EditControl Edit_1 \ an edit window
StaticControl Text_1 \ a static text window
ButtonControl Button_1 \ a button
ButtonControl Button_2 \ another button
CheckControl Check_1 \ a check box
RadioControl Radio_1 \ a radio button
RadioControl Radio_2 \ another radio button
: CloseSample ( -- )
Close: [ self ] ;
:M ExWindowStyle: ( -- style )
ExWindowStyle: SUPER
;M
:M WindowStyle: ( -- style )
WindowStyle: SUPER
[ WS_BORDER WS_OVERLAPPED OR ] literal or
;M
:M WindowTitle: ( -- title )
z" " ;M
:M StartSize: ( -- width height )
200 100 ;M
:M StartPos: ( -- x y )
3 3 ;M
:M On_Init: ( -- )
On_Init: super
self Start: Check_1
4 25 60 20 Move: Check_1
s" Hello" SetText: Check_1
self Start: Radio_1
80 25 80 20 Move: Radio_1
s" Hello2" SetText: Radio_1
GetStyle: Radio_1 \ get the default style
WS_GROUP OR
SetStyle: Radio_1 \ Start a group
self Start: Radio_2
80 45 120 20 Move: Radio_2
s" Hello Again" SetText: Radio_2
self Start: Text_1 \ start up static text
GetStyle: Text_1 \ get the default style
[ WS_GROUP SS_CENTER OR WS_BORDER OR ] literal OR \ start a group and centre
SetStyle: Text_1 \ and border to style
4 4 192 20 Move: Text_1 \ position the window
s" Sample Text" SetText: Text_1 \ set the window message
self Start: Edit_1
3 72 60 25 Move: Edit_1
s" 000,00" SetText: Edit_1
IDOK SetID: Button_1
self Start: Button_1
110 72 36 25 Move: Button_1
s" OK" SetText: Button_1
GetStyle: Button_1
BS_DEFPUSHBUTTON OR
SetStyle: Button_1
self Start: Button_2
150 72 45 25 Move: Button_2
s" Beep" SetText: Button_2
['] beep SetFunc: Button_2
;M
:M On_Paint: ( -- ) \ screen redraw procedure
0 0 width height LTGRAY FillArea: dc
;M
:M Close: ( -- )
GetText: Edit_1 cr type cr
Close: SUPER ;M
:M WM_COMMAND ( hwnd msg wparam lparam -- res )
over LOWORD ( ID )
case
IDOK of Close: self endof
GetID: Check_1 of GetID: Check_1
IsDlgButtonChecked: self to check1 beep endof
endcase
0 ;M
;OBJECT
: demo ( -- )
Start: EditSample ;
|
