\ File: Examples.f \ Author: Jeff Kelm \ Created: 26-Oct-1998 \ Updated: 01-Jun-1999 \ Testing the class libraries Comment: Revision History (most recent first) 19990601 - Deleted Unregister-Class from Cleanup since it is now done in the Destroy: method 19990423 - Added TBSTYLE_FLAT style to toolbar to give flat appearence. - Changed progress bar to smooth type. - Added a MonthCalendar control (changed size & position of appl window). 19990224 - Added some examples of static frames 19990128 - Changed "modified" to check EN_CHANGE notification (changed when clicked in window, not just when a change was made). 19990127 - Added a "modified" test to edit control when user makes changes. 19990126 - Added an Up/Down control to examples. Needed to change WM_NOTIFY to allow automatic changes in buddy window. - Increased default example window size to 640x480 to make room for the added controls (up/down and listboxs getting cut-off at bottom). 19981218 - Changed StaticWindow to CenterTextbox for labels above list boxes 19981216 - Changed ( y x) stack arguments to ( x y) per changes in BaseWindow 19981208 - Added listbox examples - changed SetTitle: to SetText: in wnd creation 19981207 - Added WS_TABSTOP style to several controls to test out tabbing between controls 19981204 - removed WS_GROUP styles from radio buttons, all one group now, but they work correctly within that group. - Changed Get/SetPosition: to Get/SetValue: in trackbar - Added more notification actions for trackbar changes. - WM_HSCROLL message returns 0 now to indicate message processed. - Changed some functions of buttons (CANCEL now resets progress bar and CHECK now resets the M$ message). 19981202 - Added second checkbox - Changed slider to use SetStyle: method - Changed progbar to use new SetPosition: and SetSize: methods 19981201 - DROP added to consume BM_SETCHECK message output - set background mode to TRANSPARENT in WM_PAINT so TextOut has correct background color (was black text on white background). - moved Show: wnd to after WndProc defined, so PAINT does what it should the first time (Hi There! wasn't showing up until a resize). 19981124 - Added a grouping of radio buttons 19981120 - Use the new TooltipToolbar class - Add several more button examples - Change background color of main window 19981117 - General cosmetic updates - Changed to call BasicWin.f - Changed BaseChildWindow to BaseWindow for 'btn' Comment; 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 750 450 SetSize: wnd 30 20 SetPosition: 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 TBSTYLE_FLAT +Style: 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 SmoothProgressbar 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 PBS_SMOOTH +Style: 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 :Class GroupStart 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 ;