Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / grafik / gui / lwv23 / sample01.bas < prev next >

Wrap

BASIC Source File | 1993-03-20 | 36.8 KB | 1,240 lines

'============================================================================ '============================================================================ ' sample code 01 to demonstrate techniques for using LangWin. ' hit Shift+F5 to run this code. ' follow instructions displayed in each sample window. ' you must start QuickBASIC as follows: qb /ah /L langwin ' /L langwin parameter provides access to LangWin quicklib ' /ah parameter is needed to allow dynamic arrays > 64k. ' hit F2, then select one of the demo subroutines to examine sample code ' subroutines called to display sample windows DECLARE SUB demo1 () DECLARE SUB demo2 () DECLARE SUB demo3 () DECLARE SUB demo4 () DECLARE SUB demo5 () DECLARE SUB demo6 () DECLARE FUNCTION VidType% () ' used to determine type of monitor ' must compile with qb /ah /L langwin '$DYNAMIC make all arrays dynamic DEFINT A-Z '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin. ' NOTE: LANGWIN.BI contains all definitions found ' in QB.BI, so include for QB.BI is not needed. CLEAR , , 5000 ' set stack at 5000 bytes '--------------------------------------------------------------- ' first see if EGA or VGA monitor mm = VidType IF mm <> 3 AND mm <> 4 THEN ' monitor is not EGA/VGA ' take whatever actions necessary (error messages) BEEP PRINT "LangWin needs EGA or VGA, sorry ........" END END IF '----------------------------------------------------------------- ' get attribute from current screen (row 1, col 1) ' so it can be restored upon exit OrigAttr = SCREEN(1, 1, 1) '------------------------------------------------------------------- ' if WIDTH command is used, it must be placed before call to LangWinInit ' because code in LangWinInit extracts max rows/cols from screen and saves ' in global variables. if WIDTH is used after LangWinInit, the global ' variable will not be set correctly. WIDTH 80, 25 '---------------------------------------------------------------------- ' these variables MUST be defined BEFORE call to LangWinInit. ' keep these as low as possible to conserve memory at run time. MaxWindows = 8 ' max simultaneous open windows MaxButtons = 30 ' max number of objects (incl lines with labels) active MaxTextLines = 35 ' maximum number of text lines in any scrollable win MaxTextWins = 5 ' max windows that can have scrollable text ' must be <= MaxWindows LOCATE , , 0 ' start with hidden text cursor '--------------------------------------------------------------------------- ' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE ' the call to LangWinInit. You can call SCREEN with a video page other than 0 ' (i.e., SCREEN 0,,x,x where x is a page number supported by your system). ' Code in LangWinInit will determine which video page you are using and save ' the value in a global variable for use by other LangWin routines. If you ' call SCREEN 0 after LangWinInit and change the original video page, you'll ' get unpredictable results (i.e., LangWin will write to the original video ' page). However, you can use other video pages for functions not associated ' with your LangWin windows; just be sure to set the video page back to the ' original value defined below. SCREEN 0, , 0, 0 ' LangWin ONLY supports text mode ' You MUST call the SCREEN command BEFORE LangWinInit CALL LangWinInit ' initialize (if mouse exists, it will be displayed) ' if you get "subscript out of range" error while ' in this routine, be sure you called QB with /ah. ' then try reducing the value of MaxWindows. ' check the WIDTH command; reduce number of columns, ' and/or number of rows. '----------------------------------------------------------------------- ' display "wallpaper" IF HaveMouse THEN CALL HideMouseCursor ' first hide mouse pointer CLS CALL SetColor(8, 15) FOR i = 1 TO MaxRows LOCATE i, 1 PRINT STRING$(80, 178); ' can try 176, 177, or 178 NEXT IF HaveMouse THEN CALL ShowMouseCursor ' display the mouse pointer '==================================================================== CALL demo1 ' simple window CALL demo2 ' add window with buttons CALL demo3 ' add button that causes child window(s) to be opened CALL demo4 ' window with input fields & child window CALL demo5 ' scrollable text windows & child windows CALL demo6 ' password entry technique '===================================================================== IF HaveMouse THEN HideMouseCursor ' we're done with the mouse bbb = (OrigAttr AND &HF0) \ 16 ' mask & shift to get original background fff = OrigAttr AND &HF ' mask to get original foreground PALETTE ' restore original palette CALL SetColor(fff, bbb) ' restore orig foreground/background CLS LOCATE , , 1 ' make text cursor visible END REM $STATIC ' ' one window opened; it contains info text only. ' no scrollable text, no buttons. ' only valid event is 'close' ' (window can be moved). ' SUB demo1 '================================================= ' first window: info text only (w1 contains window's number or error code) w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1) ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 BlankWin error number: "; w1 END END IF ' display some text in the window d = ShowWinText(2, 2, 0, "Close window to exit") d = ShowWinText(3, 2, 0, "(double click top/left).") d = ShowWinText(5, 2, 0, "Drag top/left corner to move.") ' put a title in window d = ShowTitle("Info Only Window", 15, 1) ' no error tests will be made for above functions '============================================================= ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' first window ' now determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close xx = CloseWindow CASE 2 ' text ' no scrollable text to select in this win ' this case could be omitted CASE 3 ' button ' no buttons in this win ' this case could be omitted END SELECT END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' this demo adds to the code developed for demo1 ' ' two windows opened: ' the first has info text only. ' the second has two buttons: ' 1) beep; 2) exit ' SUB demo2 '================================================= ' first window: info text only (w1 contains window's number or error code) w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1) ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 BlankWin error number: "; w1 END END IF ' display some text in the window d = ShowWinText(2, 2, 0, "Close window to exit") d = ShowWinText(3, 2, 0, "(double click top/left).") d = ShowWinText(5, 2, 0, "Drag top/left corner to move.") ' put a title in window d = ShowTitle("Info Only Window", 15, 1) ' no error tests will be made for above functions '============================================================= ' second window: text and buttons (w2 contains window's number or error code) w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1) ' test to see if window was successfully opened IF w2 < 0 THEN ' some code to handle the error CLS PRINT "w2 BlankWin error number: "; w2 END END IF ' display some text in the window d = ShowWinText(1, 2, 15, "Click button to exit.") d = ShowWinText(2, 2, 15, "Drag top/left to move.") ' put a title in window d = ShowTitle("Window With Buttons", 15, 6) ' no error tests will done for above functions ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1) xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus '============================================================= ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' first window ' now determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close xx = CloseWindow CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' no buttons in this win END SELECT CASE w2 ' second window ' now determine what type of event occurred in the window w2 SELECT CASE action CASE 1 ' close ' even though window has no close icon, ' ESC will generate a close event. ' we will ignore the close event ' since win has specific EXIT button. CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' determine which button was clicked ' get handle number of clicked button ButtonHandle = WinParms(CurWinPtr, 16) ' test all buttons for match SELECT CASE ButtonHandle CASE xit2 ' exit xx = CloseWindow CASE beep2 ' beep BEEP END SELECT END SELECT END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' this demo adds to the code developed for demos 1 & 2. ' ' two windows opened: ' the first has info text only. ' the second has three buttons: ' 1) beep; 2) exit; 3) open a new child (subordinate) window ' 4) sample error window ' ' only one child window can be open at a time. ' once the third button is clicked and a child window ' is open, the button is de-activated and cleared. ' after the user closes the child window, the button will be re-activated. ' ' similarly, the second button (exit) cannot be selected while a child ' window is open. ' ' in theory, if you have an event (ie button or text) that causes another ' window to be open, the user of your program could continue to click the ' button (or text) opening windows until the MaxWindows limit is reached. ' each window that is open will be given a unique window number. ' since the WinEvent loop must account for every open window number, ' this could result in long and complex code ' (although the same code segments could be used to handle ' events for different window numbers). in any case, this demo ' shows code that can be used to restrict the number of child ' windows that can be opened dynamically (ie by user selecting a button ' or text event at run time). ' ' this code also shows examples of how one can prevent a parent window ' from being closed while child (subordinate) windows are still open. ' ' if the fourth button is clicked, a modal error window is opened ' (a modal window is one that will retain focus, regardless of ' any events/clicks, until it is closed). in the example, the error ' window contains some error text, and ' requires the user to click an "OK" button before any ' more processing will be done. if the user clicks on any other ' window or button, it will be ignored ' until the "OK" button in the error window is clicked. ' in practice, the modal error window could result ' from an invalid button click (not allowed at that point), ' or an erroneous entry/selection by the user. ' SUB demo3 '================================================= ' first window: info text only (w1 contains window's number or error code) w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1) ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 BlankWin error number: "; w1 END END IF ' display some text in the window d = ShowWinText(2, 2, 0, "Close window to exit") d = ShowWinText(3, 2, 0, "(double click top/left).") d = ShowWinText(5, 2, 0, "Drag top/left corner to move.") ' put a title in window d = ShowTitle("Info Only Window", 15, 1) ' no error tests will be made for above functions '============================================================= ' second window: text and buttons (w2 contains window's number or error code) w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1) ' test to see if window was successfully opened IF w2 < 0 THEN ' some code to handle the error CLS PRINT "w2 BlankWin error number: "; w2 END END IF ' display some text in the window d = ShowWinText(1, 2, 15, "Click button to exit.") d = ShowWinText(2, 2, 15, "Drag top/left to move.") d = ShowWinText(3, 2, 15, "Click button to open new win") d = ShowWinText(4, 2, 15, "Click button to open error win") ' put a title in window d = ShowTitle("Window With Buttons", 15, 6) ' no error tests will done for above functions ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. beep2 = MakePushButton(7, 10, 6, "BEEP", 15, 3, 1) xit2 = MakePushButton(10, 10, 6, "EXIT", 15, 4, 1) new2 = MakePushButton(10, 20, 9, "New Win", 15, 2, 1) errorb = MakePushButton(7, 20, 7, "ERROR", 15, 5, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus '============================================================= ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' first window ' now determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close xx = CloseWindow CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' no buttons in this win END SELECT CASE w2 ' second window ' now determine what type of event occurred in the window w2 SELECT CASE action CASE 1 ' close ' even though window has no close icon, ' ESC will generate a close event. ' i'll choose to ignore the close event ' since this win has specific EXIT button. ' so, there will be no call to CloseWindow here CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' determine which button was clicked ' get handle number of clicked button ButtonHandle = WinParms(CurWinPtr, 16) ' test all buttons for match SELECT CASE ButtonHandle CASE xit2 ' exit xx = CloseWindow CASE beep2 ' beep BEEP CASE new2 ' open a new child window ' first deactivate (clear) the "new win" & "exit" buttons. ' this code should be placed before child window is opened ' to insure that window with buttons is active ' (thus the FocusSw parm can be 0) d = DeactivateButton(new2, 0) d = DeactivateButton(xit2, 0) ' open a child window w3a = BlankWin(3, 46, 10, 74, 6, 15, 1, 0, 1, 1) ' test to see if window was successfully opened IF w3a < 0 THEN ' some code to handle the error CLS PRINT "w3a BlankWin error number: "; w3a END END IF ' put some text into the window d = ShowWinText(1, 2, 15, "Child WIndow") CASE errorb ' error button ' open a modal error window ' that is, no other window is processed until ' this modal window is closed erwin = BlankWin(10, 6, 19, 36, 5, 15, 1, 0, 0, 2) ' test to see if window was successfully opened IF erwin < 0 THEN ' some code to handle the error CLS PRINT "erwin BlankWin error number: "; erwin END END IF ' put some text into the window d = ShowWinText(2, 3, 14, "Sample Error Window") d = ShowWinText(4, 3, 15, "All events ignored until") d = ShowWinText(5, 3, 15, "you click OK to continue") ok3 = MakePushButton(7, 10, 4, "OK", 15, 3, 1) END SELECT ' end of select for button in window w2 END SELECT ' end of select for window w2 CASE w3a ' determine what type of event occurred in the window w3a SELECT CASE action CASE 1 ' close xx = CloseWindow ' close the window ' re-activate new-win and exit buttons ' and leave focus in window containing the buttons d = ActivateButton(new2, 0) d = ActivateButton(xit2, 0) CASE 2 ' text ' no scrollable text to select in this win CASE 3 ' button ' no buttons in this win END SELECT CASE erwin ' the error window ' only valid action in this window a button click, ' and only valid button is the ok button to close ' so i'll just close the window if anything happens. xx = CloseWindow END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' ' open a plain window with input fields and two buttons: EXIT & SHOW. ' ' user updates input field and clicks on "SHOW" button to display fields ' in a new window. while this child window is open, ' neither the SHOW or EXIT buttons are active (in addition, the ' contents of these buttons are cleared to remind user they are ' not active). ' ' when sub window is closed, the EXIT and SHOW buttons are again displayed ' and will be active. ' SUB demo4 ' open a plain window (no scrollable text, close icon) w1 = BlankWin(3, 3, 21, 60, 9, 15, 2, 0, 1, 1) ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 BlankWin error: "; w1 END END IF ' display some text in the window d = ShowWinText(2, 2, 15, "Name:") d = ShowWinText(4, 2, 15, "Address:") d = ShowWinText(6, 2, 15, "City:") d = ShowWinText(8, 2, 15, "State:") d = ShowWinText(10, 2, 15, "Zip Code:") d = ShowWinText(12, 5, 14, "Enter data, then click on SHOW.") d = ShowWinText(13, 2, 14, "(CANNOT close this window if SHOW window is open.)") d = ShowWinText(14, 2, 14, "(CANNOT click on SHOW if SHOW window is already open.)") ' make input fields ' save the handles in variables. ' these will be used later to extract contents of input fields. nam = MakeInputField(2, 12, 25, "", 14, 1) addr = MakeInputField(4, 12, 25, "", 14, 1) city = MakeInputField(6, 12, 25, "", 14, 1) state = MakeInputField(8, 12, 25, "", 14, 1) zip = MakeInputField(10, 12, 25, "", 14, 1) ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. sho = MakePushButton(16, 20, 6, "SHOW", 15, 4, 1) xit = MakePushButton(16, 10, 6, "EXIT", 15, 4, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit' put handle of exit button into data structure CALL ChangeButtonFocus(xit, 0) ' reverse video the button to give it focus ' put a title in window d = ShowTitle("Window With Input Fields", 15, 4) ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' main window ' now determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close ' before we can close main window (w1), ' make sure child window (w2) is not open. IF NOT IsWinOpen(w2, wh) THEN xx = CloseWindow CASE 2 ' scrollable text ' there is no scrollable text, ignore this event CASE 3 ' button click ' lets see which button was clicked (if we had more than 1 button) ' get handle number of clicked button ButtonHandle = WinParms(CurWinPtr, 16) ' test all buttons for match SELECT CASE ButtonHandle CASE xit ' exit xx = CloseWindow CASE sho ' show button ' first, clear the show and exit buttons to ' deactivate them. ' this code should be placed before child window is opened ' to insure that window with buttons is active ' (thus the FocusSw parm can be 0) d = DeactivateButton(sho, 0) d = DeactivateButton(xit, 0) ' open a child window and display all input fields ' contents of all fields are in ButtonsText(handle). ' just use handle of each input field ' (returned by MakeInputField) to extract field contents. w2 = BlankWin(5, 43, 15, 73, 4, 15, 1, 0, 1, 1) ' see if win opened successfully IF w2 < 0 THEN ' code to handle failure of window to open CLS PRINT "w2 BlankWin error code: "; w2 END END IF ' display title and contents of input fields d = ShowWinText(2, 2, 15, ButtonsText(nam)) d = ShowWinText(3, 2, 15, ButtonsText(addr)) d = ShowWinText(4, 2, 15, ButtonsText(city)) d = ShowWinText(5, 2, 15, ButtonsText(state)) d = ShowWinText(6, 2, 15, ButtonsText(zip)) d = ShowWinText(8, 2, 11, "CANNOT click on SHOW") d = ShowWinText(9, 2, 11, "while this window is open.") d = ShowTitle("INPUT FIELDS", 15, 1) END SELECT END SELECT CASE w2 ' child window ' now determine what type of event occurred in the window w2 SELECT CASE action CASE 1 ' close xx = CloseWindow ' close sub window (w2) ' now redisplay show and exit buttons ' and leave focus in window containing the buttons d = ActivateButton(sho, 0) d = ActivateButton(xit, 0) CASE 2 ' text ' no scrollable text to select in this win ' this case could be omitted CASE 3 ' button ' no buttons in this win ' this case could be omitted END SELECT END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' open two windows with scrollable text and buttons ' ' user clicks on a line in the scrollable text; ' a child window will be opened and the selected text line displayed ' in an input field. ' ' only one child window for each original scrollable text window ' will be allowed. ' ' clicking on a new line in scrollable text while child window is open ' will cause new line to be displayed in the child window's input field. ' ' closing scrollable text window while a child window is open ' will first cause child window to be closed. ' SUB demo5 ' create a string array to hold scrollable text DIM Text(1 TO 30) AS STRING ' create some scrollable text ' entire array not filled, trailing null entries will not be displayed FOR i = 1 TO 25 Text(i) = "Window 1 - Line " + STR$(i) NEXT ' open a window with scrollable text w1 = OpenScrollWindow(3, 3, 21, 25, 3, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1) ERASE Text ' to save space ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 OpenScrollWindow error: "; w1 END END IF ' put a vertical line in window and some text d = MakeHorizLine(15, 2) d = MakeHorizLine(3, 2) d = ShowWinText(2, 3, 14, "Double click text") ' no checking for error return codes was done for above calls ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. xit1 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit1' put handle of exit button into data structure CALL ChangeButtonFocus(xit1, 0) ' reverse video the button to give it focus ' put a title in window d = ShowTitle("First Window", 15, 4) '---------------------------------------------------------- ' re-define array for scrollable text (different size) REDIM Text(1 TO 20) AS STRING FOR i = 1 TO 20 Text(i) = "Window 2 - Line " + STR$(i) NEXT ' open a window with scrollable text w2 = OpenScrollWindow(5, 13, 23, 35, 9, 15, 2, 15, Text(), 4, 2, 14, 20, 0, 1) ERASE Text ' to save space ' test to see if window was successfully opened IF w2 < 0 THEN ' some code to handle the error CLS PRINT "w2 OpenScrollWindow error: "; w2 END END IF ' put a vertical line in window and some text d = MakeHorizLine(15, 2) d = MakeHorizLine(3, 2) d = ShowWinText(2, 3, 14, "Double click text") ' no checking for error return codes was done for above calls ' make buttons. ' save handle numbers in variables. ' these will be used later to determine which button was clicked. xit2 = MakePushButton(16, 7, 6, "EXIT", 15, 4, 1) ' give the exit button focus (if ENTER is hit, EXIT button will be pushed) WinParms(CurWinPtr, 16) = xit2' put handle of exit button into data structure CALL ChangeButtonFocus(xit2, 0) ' reverse video the button to give it focus ' put a title in window d = ShowTitle("Second Window", 15, 4) '------------------------------------------------------------ ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' first window ' determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close ' first see if a child window (w1s) is open. ' if it is, IsWinOpen will return handle. IF NOT IsWinOpen(w1s, Han) THEN xx = CloseWindow ' sub win not open, close scrollable win ELSE ' sub win is open zz = CurWinPtr ' save handle of current scrollable win CALL NewFocusWindow(Han) ' make sub win current xx = CloseWindow ' close it CALL NewFocusWindow(zz) ' make scrollable win current xx = CloseWindow ' close it END IF CASE 2 ' text ' save pointer to selected text line TextLine = WinParms(CurWinPtr, 15) ' save index in SaveText array where text is saved ArrayIndex = WinParms(CurWinPtr, 18) ' if no child win already open, ' then open one and display selected text ' IsWinOpen returns handle of window number if it's open IF NOT IsWinOpen(w1s, Han) THEN ' open a blank window w1s = BlankWin(5, 43, 10, 73, 4, 15, 1, 0, 1, 1) ' see if win opened successfully IF w1s < 0 THEN ' code to handle failure of window to open END END IF ' display title d = ShowTitle("TEXT SELECTED - Win 1", 15, 1) ' show the text selected in the new window t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed w1f = MakeInputField(2, 2, 25, t$, 0, 7) ' if child win is open, update data in it ELSE ' use handle returned by IsWinOpen to make sub win current CALL NewFocusWindow(Han) ' show the text selected in the new window ' put text into input field ButtonsText(w1f) = SaveText(ArrayIndex, TextLine) ' redisplay the input field CALL ReShowInputField(w1f) END IF ' give focus back to window with text CALL NewFocusWindow(w1) CASE 3 ' button ' take advantage of fact that there is only one possible button ' (which is EXIT) ' first see if a child window (w1s) is open. ' if it is, IsWinOpen will return handle. IF NOT IsWinOpen(w1s, Han) THEN xx = CloseWindow ' sub win not open, close scrollable win ELSE ' sub win is open zz = CurWinPtr ' save handle of current scrollable win CALL NewFocusWindow(Han) ' make sub win current xx = CloseWindow ' close it CALL NewFocusWindow(zz) ' make scrollable win current xx = CloseWindow ' close it END IF END SELECT CASE w2 ' second window ' determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close ' first see if a child window (w2s) is open. ' if it is, IsWinOpen will return handle. IF NOT IsWinOpen(w2s, Han) THEN xx = CloseWindow ' sub win not open, close scrollable win ELSE ' sub win is open zz = CurWinPtr ' save handle of current scrollable win CALL NewFocusWindow(Han) ' make sub win current xx = CloseWindow ' close it CALL NewFocusWindow(zz) ' make scrollable win current xx = CloseWindow ' close it END IF CASE 2 ' text ' save pointer to selected text line TextLine = WinParms(CurWinPtr, 15) ' save index in SaveText array where text is saved ArrayIndex = WinParms(CurWinPtr, 18) ' if no child win already open, ' then open one and display selected text ' IsWinOpen returns handle of window number if it's open IF NOT IsWinOpen(w2s, Han) THEN ' open a blank window w2s = BlankWin(15, 43, 20, 73, 5, 15, 1, 0, 1, 1) ' see if win opened successfully IF w2s < 0 THEN ' code to handle failure of window to open END END IF ' display title d = ShowTitle("TEXT SELECTED - Win 2", 15, 1) ' show the text selected in the new window t$ = SaveText(ArrayIndex, TextLine)' clicked line to be displayed w2f = MakeInputField(2, 2, 25, t$, 0, 7) ' if child win is open, update data in it ELSE ' use handle returned by IsWinOpen to make sub win current CALL NewFocusWindow(Han) ' show the text selected in the new window ' put text into input field ButtonsText(w2f) = SaveText(ArrayIndex, TextLine) ' redisplay the input field CALL ReShowInputField(w2f) END IF ' give focus back to window with text CALL NewFocusWindow(w2) CASE 3 ' button ' take advantage of fact that there is only one possible button ' (which is EXIT) ' first see if a child window (w2s) is open. ' if it is, IsWinOpen will return handle. IF NOT IsWinOpen(w2s, Han) THEN xx = CloseWindow ' sub win not open, close scrollable win ELSE ' sub win is open zz = CurWinPtr ' save handle of current scrollable win CALL NewFocusWindow(Han) ' make sub win current xx = CloseWindow ' close it CALL NewFocusWindow(zz) ' make scrollable win current xx = CloseWindow ' close it END IF END SELECT CASE w1s, w2s ' child windows ' to simplify things, i'll handle both child windows ' with same code. to further simplify, i'll only allow a close event. SELECT CASE action CASE 1 ' close xx = CloseWindow END SELECT END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ' show an example of using input field for password entry. ' as text is entered, only * is displayed, but actual text is ' stored in the ButtonsText data structure. ' ' after entering password, click on button. ' a modal window will be opened and text from ButtonsText data structure ' displayed (your program would access this text to verify password). ' ' SUB demo6 ' open a plain window (no scrollable text, close icon) w1 = BlankWin(3, 3, 15, 43, 9, 15, 2, 0, 1, 1) ' test to see if window was successfully opened IF w1 < 0 THEN ' some code to handle the error CLS PRINT "w1 BlankWin error: "; w1 END END IF ' display some text in the window d = ShowWinText(2, 2, 14, "Select field; enter password;") d = ShowWinText(3, 2, 14, "and click on SHOW button.") d = ShowWinText(5, 2, 15, "Password:") passwd = MakeInputField(5, 12, -8, "", 14, 1) sho = MakePushButton(7, 5, 6, "SHOW", 15, 4, 1) xit = MakePushButton(7, 22, 6, "EXIT", 15, 4, 1) ' put a title in window d = ShowTitle("Password Entry Window", 15, 4) ' MAIN LOOP ' as long as any win is open ' wait for an event in any window, then process it DO WHILE AnyWinOpen ' wait for an event ' win number (wn) and event code (action) returned wn = WinEvent(action) ' test window number to see which window was current when event occurred SELECT CASE wn CASE w1 ' main window ' now determine what type of event occurred in the window w1 SELECT CASE action CASE 1 ' close xx = CloseWindow CASE 2 ' scrollable text ' there is no scrollable text, ignore this event CASE 3 ' button click SELECT CASE WinParms(CurWinPtr, 16) CASE xit xx = CloseWindow CASE sho ' first, deactivate clear the show & exit buttons to ' this code should be placed before child window is opened ' to insure that main window with buttons is active ' (thus the FocusSw parm in DeactivateButton can be 0) d = DeactivateButton(sho, 0) d = DeactivateButton(xit, 0) ' open a modal child window and display the actual password ' contents are in ButtonsText(passwd). ' instead of opening a window, ' you could use contents of ButtonsText(passwd) ' to verify the password. w2 = BlankWin(5, 33, 11, 60, 4, 15, 1, 0, 1, 2) ' see if win opened successfully IF w2 < 0 THEN ' code to handle failure of window to open CLS PRINT "w2 BlankWin error code: "; w2 END END IF ' display title and contents of input fields d = ShowWinText(2, 2, 14, "Password:") d = ShowWinText(2, 12, 15, ButtonsText(passwd)) d = ShowWinText(5, 2, 14, "Close to continue.") d = ShowTitle("PASSWORD", 15, 1) END SELECT ' end of section for buttons END SELECT ' end of section for main window CASE w2 ' child window with password ' now determine what type of event occurred in the window w2 SELECT CASE action CASE 1 ' close xx = CloseWindow ' close sub window (w2) ' now redisplay show and exit buttons ' and leave focus in window containing the buttons d = ActivateButton(sho, 0) d = ActivateButton(xit, 0) CASE 2 ' text ' no scrollable text to select in this win ' this case could be omitted CASE 3 ' button ' no buttons in this win ' this case could be omitted END SELECT END SELECT LOOP LOCATE 25, 1 CALL SetColor(15, 4) PRINT "HIT ANY KEY TO CONTINUE DEMO ..."; SLEEP LOCATE 25, 1 CALL SetColor(8, 15) PRINT STRING$(80, 178); END SUB ' ===================================================== ' returns type of video display ' ' return values: ' 1: black/white (could be EGA/VGA with monochrome) ' 2: CGA (with color) ' 3: EGA (with color) ' 4: VGA (with color) ' 5: MCGA (with color) ' 99: other ' FUNCTION VidType ' quick & dirty, check &h463 DEF SEG = 0 IF PEEK(&H463) = &HB4 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF DEF SEG ' first try int 10h, function 1Ah InRegs.ax = &H1A00 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.ax AND &HFF) = &H1A THEN ' see if int 10h, funct 1Ah supported code = (OutRegs.bx AND &HFF) ' get display code SELECT CASE code CASE 1 ' MDA VidType = 1 CASE 2 ' CGA VidType = 2 CASE 4 ' EGA color VidType = 3 CASE 5 ' EGA b/w VidType = 1 CASE 7 ' VGA b/w VidType = 1 CASE 8 ' VGA color VidType = 4 CASE 10 ' MCGA color VidType = 5 CASE 11 ' MCGA b/w VidType = 1 CASE ELSE VidType = 99 ' other END SELECT EXIT FUNCTION ELSE ' now try int 10h, function 12h, sub-function 10h InRegs.ax = &H1200 InRegs.bx = &H10 CALL INTERRUPTX(&H10, InRegs, OutRegs) IF (OutRegs.bx AND &HFF00) = 1 THEN ' see if monochrome VidType = 1 EXIT FUNCTION END IF IF (OutRegs.bx AND &HFF) <> &H10 THEN ' see if BL reg changed VidType = 3 ' EGA (not sure why it couldn't be VGA too!) EXIT FUNCTION END IF VidType = 99 ' other (probably CGA or MDA) END IF END FUNCTION