home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / QBPANEL.ZIP / QBPANEL.BAS < prev   
Encoding:
BASIC Source File  |  1987-02-17  |  8.0 KB  |  193 lines
  1.  
  2. '***************  "PANEL" SUB-PROGRAMS for QuickBASIC!!! *********************
  3. '  Not worthy of applause or money, these were written in a hurry to solve a
  4. 'problem.  You may find some of it handy (especially instring!).  I tried to
  5. 'generalize, but I know there are many improvements that could be made.
  6.  
  7. common shared promptfg%,promptbg%,highfg%,fieldfg%,fieldbg%
  8. '   the colors set by "call panelcolor(..."
  9.  
  10. sub panelcolor( color1%,color2%,color3%,color4%,color5%) static
  11. '  this subprogram is called to set up the colors for an input panel
  12.    promptfg% = color1%
  13.    promptbg% = color2%
  14.    highfg% = color3%
  15.    fieldfg% = color4%
  16.    fieldbg% = color5%
  17. end sub
  18.  
  19. sub promptdisplay(screen$(2), quantity%) static
  20. ' this subroutine will display all the prompts from the two-dimensional
  21. 'string array defined at the start of the program.
  22. 'NOTE : "quantity" must be the size of the first dimension (in other
  23. 'words, in the demo, it is actually quantity minus one!)
  24.    color promptfg%,promptbg%
  25.    for num = 0 to quantity%
  26.        locate val(screen$(num,1)),val(screen$(num,2))
  27.        print screen$(num,0);
  28.    next
  29. end sub
  30.  
  31.  
  32. sub fielddisplay(screen$(2), quantity%) static
  33. ' this subroutine will display all the input fields from the two-dimensional
  34. 'string array defined at the start of the program.
  35. 'NOTE : "quantity" must be the size of the first dimension (in other
  36. 'words, in the demo, it is actually quantity minus one!)
  37.    color fieldfg%,fieldbg%
  38.    for num = 0 to quantity%
  39.        locate val(screen$(num,1)),val(screen$(num,2)) + len(screen$(num,0))+1
  40.        print screen$(num,4);spc(val(screen$(num,3))-len(screen$(num,4)));
  41.    next
  42. end sub
  43.  
  44.  
  45. sub fieldentry(screen$(2),quantity%) static
  46. '   This subprogram will handle the entry of strings into all the fields
  47. 'of the two-dimensional string array that makes up the info-input screen.
  48. '
  49.       color promptfg%,promptbg%
  50.       num = 0
  51.       while (num < quantity%+1) AND (num > -1)
  52.             locate val(screen$(num,1)), val(screen$(num,2))   ' first, highlight the prompt
  53.             color highfg%
  54.             print screen$(num,0);
  55.             locate val(screen$(num,1)), val(screen$(num,2))+len(screen$(num,0))+1
  56.             color fieldfg%,fieldbg%
  57. getstring:  mykey$ = "Y"         ' we DO want function keys
  58.             call instring( screen$(num,4), cint(val(screen$(num,3))), mykey$)
  59.             locate val(screen$(num,1)),val(screen$(num,2))  ' un-highlight the prompt
  60.             color promptfg%,promptbg%
  61.             print screen$(num,0);
  62.             if len(mykey$) = 2 then     ' must be a function key
  63.                if (right$(mykey$,1) = chr$(72)) then
  64.                   if num > 0 then
  65.                         num = num - 1
  66.                   else  num = quantity%
  67.                   end if
  68.                elseif (right$(mykey$,1) = chr$(80)) then
  69.                   if num < quantity% then
  70.                         num = num + 1
  71.                   else  num = 0
  72.                   end if
  73.                else
  74.                    goto getstring    ' must not be a legal function key!
  75.                end if
  76.             elseif mykey$ = chr$(13) then
  77.                   if num < quantity% then
  78.                         num = num + 1
  79.                   else  num = 0
  80.                   end if
  81.             elseif mykey$ = chr$(27) then
  82.                   num = quantity%+1    '(FORCE THE EXIT)
  83.             end if
  84.       wend
  85. end sub
  86.  
  87.  
  88. sub instring( strg$, limit%, lastkey$) static
  89. '   This subprogram will serve as a replacement for BASICA's Input command
  90. 'for strings.  The parameters are :  strg$ = string for user input/editting
  91. '                                    limit = max. number of characters allowed
  92. '                                    lastkey$ = for instring to return the
  93. '                                               last key pressed (only if
  94. '                                               lastkey$ contains "Y" on entry)
  95. '    Note that if strg$ contains a string on entry, the user may edit the
  96. 'string using simple editing functions (cursor movement, DEL, BKSP).
  97. '    Also, unlike BASIC's "Input", all normal characters are legal.
  98. 'When this subprogram returns, the cursor will be ON, and positioned at the
  99. 'last location at which anything was typed.
  100. '    If lastkey$ contains the letter "Y" upon entry, this subprogram will
  101. 'exit when the following keys are hit: return, up arrow, down arrow, HOME,
  102. 'END, and escape.  The key used to exit will be returned to the caller in
  103. 'Lastkey$ so that the caller may take appropriate action (go to the next
  104. 'field, quit the screen, etc.)
  105.  
  106. ' IMPORTANT: The second parameter to this subprogram MUST be an integer!!!!
  107. 'If it is not an integer, you may have a catastrophic crash!  If you can
  108. 'think of a way that this suprogram can determine the type of variable passed,
  109. 'you could add that code. (And please let me know!)
  110.  
  111. if lastkey$ = "Y" then     ' should we leave on function keys?
  112.    functs = 1
  113. else
  114.    functs = 0              ' 0 = FALSE
  115. end if
  116.  
  117. startcol = pos(0)        ' column in which we start
  118. print strg$; spc(limit% - len( strg$));     ' print the string and clear all
  119.                                            ' needed space
  120.  
  121. if limit% > len(strg$) then    ' current position will be at end of string+1,
  122.    curpos = len(strg$)+1      ' unless field is full
  123. else
  124.    curpos = 1
  125. end if
  126.  
  127. locate ,startcol+curpos-1,1      'start at end of string, and turn on cursor!!
  128. tmp$ = ""
  129.  
  130. while tmp$ <> chr$(13)      ' the main loop waits for a carriage return
  131.       tmp$ = ""
  132.       while len(tmp$) = 0    ' len will be 1 for characters, 2 for function keys
  133.             tmp$ = inkey$
  134.       wend
  135.       if len(tmp$) = 2 then       ' function key code
  136.          if functs then
  137.             if right$(tmp$,1) = chr$(75) then           ' left cursor?
  138.                if curpos > 1 then
  139.                   curpos = curpos -1
  140.                end if
  141.             elseif right$(tmp$,1) = chr$(77) then       ' right cursor?
  142.                    if curpos < len( strg$) + 1 then   ' dont move more than 1 past end
  143.                       curpos = curpos + 1
  144.                    end if
  145.             elseif right$(tmp$,1) = chr$(71) then       ' HOME key?
  146.                 curpos = 1
  147.             elseif right$(tmp$,1) = chr$(79) then       ' END key?
  148.                 curpos = len(strg$)+1
  149.             elseif right$(tmp$,1) = chr$(83) then     ' DEL key?
  150.               if (len(strg$) > 0) and (curpos <= len(strg$)) then
  151.                 strg$ = left$(strg$, curpos-1) + right$(strg$,len(strg$)-curpos)
  152.               end if
  153.             elseif (right$(tmp$,1) = chr$(72)) or (right$(tmp$,1) = chr$(80)) then
  154.                 lastkey$ = tmp$         ' alternate exit keys (up & down)
  155.                 tmp$ = chr$(13)
  156.             end if
  157.          end if
  158.  
  159. '***  now, the non-function key area!
  160.  
  161.       elseif (tmp$ > chr$(31)) and (tmp$ < chr$(127)) then    ' good characters?
  162.          if len(strg$) < limit% then    ' not too many characters?
  163.             strg$ = left$(strg$,curpos-1) + tmp$ + right$(strg$,len(strg$)-curpos+1)
  164.             if curpos < limit% then
  165.                curpos = curpos + 1       ' don't position the cursor outside the field
  166.             end if
  167.          end if
  168.       elseif tmp$ = chr$(13) then        ' carriage return
  169.             lastkey$ = tmp$
  170.       elseif tmp$ = chr$(27) then        ' Escape key
  171.             lastkey$ = tmp$
  172.             tmp$ = chr$(13)         ' (FORCE THE EXIT)
  173.       elseif tmp$ = chr$(8)  then        ' backspace/delete
  174.             if curpos > 1 then   ' dont do it if you are on the first char.
  175.                if curpos = 2 then
  176.                   strg$ = right$(strg$,len(strg$)-1)  ' special circum.'s
  177.                elseif curpos = len(strg$)+1 then
  178.                   strg$ = left$(strg$,len(strg$)-1)   ' more circum.'s
  179.                else
  180.                   strg$ = left$(strg$,curpos-2) + right$(strg$,len(strg$)-curpos+1)
  181.                end if
  182.                curpos = curpos-1
  183.             end if
  184.       end if
  185.  
  186.       locate ,startcol
  187.       print strg$; spc(limit% - len( strg$));
  188.       locate ,startcol+curpos-1
  189. wend
  190.  
  191. end sub
  192.  
  193.