\ File: Examples.f \ Author: Jeff Kelm \ Created: 26-Oct-1998 \ Updated: 24-Feb-1999 \ Testing the class libraries NEEDS BasicWin.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Define menu item ID values \ CreateNewID CONSTANT IDM_NEW CreateNewID CONSTANT IDM_OPEN CreateNewID CONSTANT IDM_SAVE CreateNewID CONSTANT IDM_SAVEAS CreateNewID CONSTANT IDM_PGSETUP CreateNewID CONSTANT IDM_PRINT CreateNewID CONSTANT IDM_EXIT CreateNewID CONSTANT IDM_UNDO CreateNewID CONSTANT IDM_CUT CreateNewID CONSTANT IDM_COPY CreateNewID CONSTANT IDM_PASTE CreateNewID CONSTANT IDM_DEL CreateNewID CONSTANT IDM_ALL CreateNewID CONSTANT IDM_FIND CreateNewID CONSTANT IDM_NEXT CreateNewID CONSTANT IDM_REPL CreateNewID CONSTANT IDM_TOPICS CreateNewID CONSTANT IDM_ABOUT \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Create an application window \ NEEDS ApplWin.f ApplicationWindow wnd Create: wnd COLOR_BTNFACE 1+ GCL_HBRBACKGROUND GetHandle: wnd Call SetClassLong ?WinError Z" Application Window" SetText: wnd 640 480 SetSize: wnd \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Create a semi-standard window menubar \ NEEDS Menubar.f PopupMenu FileMenu \ standard File menu Create: FileMenu IDM_NEW Z" &New" AddItem: FileMenu IDM_OPEN Z" &Open..." AddItem: FileMenu IDM_SAVE Z" &Save" AddItem: FileMenu Seperator: FileMenu IDM_PRINT Z" &Print" AddItem: FileMenu Seperator: FileMenu IDM_EXIT Z" E&xit" AddItem: FileMenu PopupMenu EditMenu \ standard Edit menu Create: EditMenu IDM_CUT Z" Cu&t\tCtrl+X" AddItem: EditMenu IDM_COPY Z" &Copy\tCtrl+C" AddItem: EditMenu IDM_PASTE Z" &Paste\tCtrl+V" AddItem: EditMenu PopupMenu HelpMenu \ standard Help menu Create: HelpMenu IDM_ABOUT Z" &About App..." AddItem: HelpMenu Menubar appMenu \ create the application menubar Create: appMenu GetHandle: FileMenu Z" &File" AddMenu: appMenu GetHandle: EditMenu Z" &Edit" AddMenu: appMenu GetHandle: HelpMenu Z" &Help" AddMenu: appMenu GetHandle: AppMenu SetMenu: wnd \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Toolbar Definition \ NEEDS Toolbar.f :Object tBar rel @ \ get control id CASE IDM_NEW OF Z" New" ENDOF IDM_OPEN OF Z" Open" ENDOF IDM_SAVE OF Z" Save" ENDOF IDM_CUT OF Z" Cut" ENDOF IDM_COPY OF Z" Copy" ENDOF IDM_PASTE OF Z" Paste" ENDOF IDM_PRINT OF Z" Print" ENDOF IDM_ABOUT OF Z" About" ENDOF DEFAULTOF Z" Undef" ENDOF ENDCASE rel>abs SWAP 3 CELLS + abs>rel ! ;M ;Object GetHandle: wnd Create: tbar \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ create a statusbar \ NEEDS Statbar.f Statusbar sBar GetHandle: wnd Create: sbar Z" Status information goes here" SetText: sbar \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Create a slider (trackbar) control NEEDS trackbar.f Trackbar slider GetHandle: wnd Create: slider TBS_AUTOTICKS TBS_TOP OR TBS_ENABLESELRANGE OR +Style: slider WS_TABSTOP +Style: slider 10 50 SetPosition: slider \ sets position of UL corner 200 40 SetSize: slider \ sets size of slider rect. 10 SetPageSize: slider \ sets increment for PgUp/PgDn 0 10 SetTickFreq: slider \ sets the tick increment 0 100 FALSE SetRange: slider \ sets range of slider 10 SetValue: slider \ sets slider to value 5 65 TRUE SetSel: slider \ sets colored range in channel \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Create a progress bar \ NEEDS progbar.f Progressbar progbar GetHandle: sbar Create: progbar \ put progress bar into status window 250 5 SetPosition: progbar 250 10 SetSize: progbar 0 20 SetRange: progbar 1 SetStep: progbar \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Define some buttons \ NEEDS Buttons.f PushButton btn1 GetHandle: wnd Create: btn1 WS_TABSTOP +Style: btn1 100 120 SetPosition: btn1 75 25 SetSize: btn1 Z" Step it" SetText: btn1 GetID: btn1 CONSTANT IDM_STEP DefPushButton btn2 GetHandle: wnd Create: btn2 WS_TABSTOP +Style: btn2 200 120 SetPosition: btn2 75 25 SetSize: btn2 Z" Clear" SetText: btn2 GetID: btn2 CONSTANT IDM_DEFPB CheckBox btn3 GetHandle: wnd Create: btn3 100 150 SetPosition: btn3 75 25 SetSize: btn3 Z" Check#1" SetText: btn3 GetID: btn3 CONSTANT IDM_CHECK1 CheckBox btn4 GetHandle: wnd Create: btn4 200 150 SetPosition: btn4 75 25 SetSize: btn4 Z" Check#2" SetText: btn4 GetID: btn4 CONSTANT IDM_CHECK2 GroupBox btn5 GetHandle: wnd Create: btn5 80 90 SetPosition: btn5 220 100 SetSize: btn5 Z" A Group Box" SetText: btn5 \ these don't handle grouping properly yet RadioButton btna GetHandle: wnd Create: btna WS_TABSTOP +Style: btna WS_GROUP +Style: btna ( end previous group and start another) 400 30 SetPosition: btna Z" BtnA" SetText: btna RadioButton btnb getHandle: wnd Create: btnb 400 60 SetPosition: btnb Z" BtnB" SetText: btnb RadioButton btnc GetHandle: wnd Create: btnc 400 90 SetPosition: btnc Z" BtnC" SetText: btnc 0 BST_CHECKED BM_SETCHECK SendMessage: btna DROP RadioButton btnd GetHandle: wnd Create: btnd WS_TABSTOP +Style: btnd 500 30 SetPosition: btnd Z" BtnD" SetText: btnd RadioButton btne getHandle: wnd Create: btne 500 60 SetPosition: btne Z" BtnE" SetText: btne RadioButton btnf GetHandle: wnd Create: btnf 500 90 SetPosition: btnf Z" BtnF" SetText: btnf \ 0 BST_CHECKED BM_SETCHECK SendMessage: btne DROP IconButton ib1 GetHandle: wnd Create: ib1 \ WS_GROUP +Style: ib1 ( end previous group) IDI_WINLOGO NULL Call LoadIcon SetImage: ib1 300 50 SetPosition: ib1 32 32 SetSize: ib1 GetID: ib1 CONSTANT IDM_MSLOGO BitmapButton ib2 GetHandle: wnd Create: ib2 Z" Spell.bmp" GetBmpResource SetImage: ib2 350 50 SetPosition: ib2 32 32 SetSize: ib2 GetID: ib2 CONSTANT IDM_SPELL \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Some combo boxes \ NEEDS Combobox.f SimpleCombo cbox1 GetHandle: wnd Create: cbox1 400 210 SetPosition: cbox1 100 75 SetSize: cbox1 Z" Testing0" AddString: cbox1 Z" Testing1" AddString: cbox1 Z" Testing2" AddString: cbox1 Z" Testing3" AddString: cbox1 Z" Testing4" AddString: cbox1 DropdownCombo cbox2 GetHandle: wnd Create: cbox2 400 150 SetPosition: cbox2 100 75 SetSize: cbox2 Z" Testing0" AddString: cbox2 Z" Testing1" AddString: cbox2 Z" Testing2" AddString: cbox2 Z" Testing3" AddString: cbox2 Z" Testing4" AddString: cbox2 DropdownListCombo cbox3 GetHandle: wnd Create: cbox3 400 180 SetPosition: cbox3 100 75 SetSize: cbox3 Z" Testing0" AddString: cbox3 Z" Testing1" AddString: cbox3 Z" Testing2" AddString: cbox3 Z" Testing3" AddString: cbox3 Z" Testing4" AddString: cbox3 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Some List Boxes \ NEEDS Listbox.f Listbox lbox1 GetHandle: wnd Create: lbox1 25 240 SetPosition: lbox1 100 100 SetSize: lbox1 Z" Item 0" AddString: lbox1 Z" Item 1" AddString: lbox1 Z" Item 2" AddString: lbox1 Z" Item 3" AddString: lbox1 Z" Item 4" AddString: lbox1 Z" Item 5" AddString: lbox1 2 Select: lbox1 MultiListbox lbox2 GetHandle: wnd Create: lbox2 150 240 SetPosition: lbox2 100 100 SetSize: lbox2 Z" Item 0" AddString: lbox2 Z" Item 1" AddString: lbox2 Z" Item 2" AddString: lbox2 Z" Item 3" AddString: lbox2 Z" Item 4" AddString: lbox2 Z" Item 5" AddString: lbox2 1 Select: lbox2 3 Select: lbox2 MultiExListbox lbox3 GetHandle: wnd Create: lbox3 275 240 SetPosition: lbox3 100 100 SetSize: lbox3 Z" Item 0" AddString: lbox3 Z" Item 1" AddString: lbox3 Z" Item 2" AddString: lbox3 Z" Item 3" AddString: lbox3 Z" Item 4" AddString: lbox3 Z" Item 5" AddString: lbox3 0 Select: lbox3 3 Select: lbox3 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Some Static controls \ NEEDS Static.f CenterTextbox swin1 GetHandle: wnd Create: swin1 25 220 SetPosition: swin1 100 20 SetSize: swin1 Z" Listbox" SetText: swin1 CenterTextbox swin2 GetHandle: wnd Create: swin2 150 220 SetPosition: swin2 100 20 SetSize: swin2 Z" MultiListbox" SetText: swin2 CenterTextbox swin3 GetHandle: wnd Create: swin3 275 220 SetPosition: swin3 100 20 SetSize: swin3 Z" MultiExListbox" SetText: swin3 StaticIcon icon1 GetHandle: wnd Create: icon1 IDI_ASTERISK NULL Call LoadIcon SetImage: icon1 400 300 SetPosition: icon1 StaticBitmap bitmap1 GetHandle: wnd Create: bitmap1 Z" Spell.bmp" GetBmpResource SetImage: bitmap1 16 16 SetSize: bitmap1 450 300 SetPosition: bitmap1 StaticFrame swin4 GetHandle: wnd Create: swin4 398 298 SetPosition: swin4 36 36 SetSize: swin4 BlackFrame: swin4 StaticFrame swin5 GetHandle: wnd Create: swin5 448 298 SetPosition: swin5 20 20 SetSize: swin5 EtchedFrame: swin5 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ An up/down (spinner) control \ NEEDS UpDown.f NEEDS EditControl.f UpDownControl ud1 \ the up/down control GetHandle: wnd Create: ud1 EditControl buddy1 \ an edit control to act as a buddy window GetHandle: wnd Create: buddy1 \ (anything that accepts Get/PutText: 50 20 SetSize: buddy1 \ messages will work, e.g., Static Text Box) 500 300 SetPosition: buddy1 GetHandle: buddy1 SetBuddy: ud1 \ assign up/down control to the buddy window 0 100 SetRange: ud1 10 SetValue: ud1 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\ Define the application window procedure \ 0 VALUE hdc \ window device context handle CREATE ps 64 ALLOT ( paintstruct ) \ Default "Not Implemented" function for menu items : MenuFunc MB_OK Z" Command" rel>abs Z" Not implemented in this sample." rel>abs GetHandle: wnd Call MessageBox DROP ; : ShowTrack ( -- ) \ update status window with trackbar value GetValue: slider S" Slider position: " TEMP$ PLACE S>D (D.) TEMP$ +PLACE TEMP$ +NULL TEMP$ SetText: sbar ; \ This performs the actual window functions specific to our application : (MainWndProc) { hWnd msg wParam lParam -- result } msg CASE WM_PAINT OF ps rel>abs hWnd Call BeginPaint DUP TO hdc ?WinError TRANSPARENT hdc Call SetBkMode DROP S" Hi there!" SWAP rel>abs 200 200 hdc Call TextOut ?WinError ps rel>abs hWnd Call EndPaint DROP 0 ENDOF WM_SIZE OF Autosize: tbar Redraw: sbar 0 ENDOF WM_COMMAND OF \ ( hWndToolbar idButton WM_COMMAND hWnd) wParam LOWORD CASE IDM_NEW OF MenuFunc ENDOF IDM_OPEN OF MenuFunc ENDOF IDM_SAVE OF MenuFunc ENDOF IDM_CUT OF MenuFunc ENDOF IDM_COPY OF MenuFunc ENDOF IDM_PASTE OF MenuFunc ENDOF IDM_PRINT OF MenuFunc ENDOF IDM_EXIT OF MenuFunc ENDOF IDM_ABOUT OF MenuFunc ENDOF IDM_STEP OF StepIt: progbar ENDOF IDM_CHECK1 OF 0 0 BM_GETCHECK SendMessage: btn3 IF Z" Check box 1 Checked" ELSE Z" Check box 1 Unchecked" THEN SetText: sbar ENDOF IDM_CHECK2 OF 0 0 BM_GETCHECK SendMessage: btn4 IF Z" Check box 2 Checked" ELSE Z" Check box 2 Unchecked" THEN SetText: sbar ENDOF IDM_MSLOGO OF Z" M$ $ucks!" SetText: wnd ENDOF IDM_SPELL OF Z" Application Window" SetText: wnd ENDOF IDM_DEFPB OF 0 SetValue: progbar ENDOF GetID: Buddy1 OF wparam HIWORD EN_CHANGE = IF Z" Modified" SetText: wnd THEN ENDOF ENDCASE 0 ENDOF WM_NOTIFY OF \ ( ^LPNMHDR idButton WM_NOTIFY hWnd) lparam 2 CELLS + abs>rel @ \ fetch code from NMHDR structure CASE TTN_NEEDTEXT OF lparam SetTooltipText: tbar ENDOF UDN_DELTAPOS OF FALSE ENDOF DEFAULTOF TRUE ENDOF ENDCASE ENDOF WM_HSCROLL OF wParam LOWORD CASE TB_THUMBTRACK OF ShowTrack ENDOF TB_TOP OF ShowTrack ENDOF TB_BOTTOM OF ShowTrack ENDOF TB_LINEDOWN OF ShowTrack ENDOF TB_LINEUP OF ShowTrack ENDOF TB_PAGEDOWN OF ShowTrack ENDOF TB_PAGEUP OF ShowTrack ENDOF ENDCASE 0 ENDOF DEFAULTOF lParam wParam msg hWnd Call DefWindowProc ENDOF ENDCASE ; 4 callback MainWndProc (MainWndProc) \ set the window procedure MainWndProc rel>abs GWL_WNDPROC SetWindowLong: wnd Show: wnd : CLEANUP Destroy: wnd Unregister-Class ;