home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / EDITBOX.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  5KB  |  132 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'PARM.INC'
  4. ' $INCLUDE: 'SETCURS.INC'
  5. ' $INCLUDE: 'TRUEFALS.INC'
  6.  
  7. DECLARE FUNCTION EditBox$ (msg$(), orig$, parm())
  8. DECLARE FUNCTION EditBox2$ (msg$, orig$, parm())
  9.  
  10. 'External procedures:
  11.  
  12. DECLARE SUB BoxCalc (t, l, b, r, tall, wide)
  13. DECLARE FUNCTION EdStr$ (o$, parm())
  14. DECLARE FUNCTION GetKey$ (parm())
  15. DECLARE SUB PopBox (t, l, b, r, wide, msg$(), parm())
  16. DECLARE SUB RestScreen (f$)
  17. DECLARE SUB SaveScreen (f$)
  18. DECLARE SUB SetView (t, b, parm())
  19. DECLARE FUNCTION TempName$ (p$)
  20. DECLARE FUNCTION VPage (p)
  21.  
  22. FUNCTION EditBox$ (msg$(), orig$, parm())
  23. '****************************************************************************
  24. 'Basically, it's EdStr$() in a pop-up box.  Send an array of text to show
  25. ' along with the string to be edited, and the return values are the same as
  26. ' EdStr$().
  27. '
  28. '    parm(1) = top left row  0=Center
  29. '    parm(2) = top left column  0=Center
  30. '    parm(3) = box border type 1-4.  See SUB Panes() for numeric boxtypes.
  31. '    parm(4) = message justification  <0=Left  0=Center  >0=Right
  32. '    parm(5) = maximum length of the string to be edited  1-77
  33. '    parm(6) = initial insert/overwrite mode (Use the SETCURS.INC constants)
  34. '    parm(7) = initial character position within the edit string.
  35. '    parm(8) = restrict input? (See EDSTR.INC)
  36. '
  37. 'Due to the width of the box & shadow, EditBox$() effectively limits the
  38. ' maximum length of the EdStr$() to 77 characters.
  39. '
  40. 'If a combination of any of the above parameters causes a portion of the box
  41. ' to exceed the screen boundaries, a run-time error will occur.
  42. '
  43. 'See function EdStr$() for more detailed information.
  44. '
  45. '****************************************************************************
  46.  
  47. '                     *** Preliminary Calculations ***
  48.  
  49. REDIM temp(1 TO MAXPARM)                'Make a duplicate parm() array to
  50. FOR x = MINPARM TO MAXPARM              'pass to EdStr$().
  51.      temp(x) = parm(x)
  52. NEXT x
  53. temp(3) = parm(5)                       'Copy the appropriate parm() values
  54. temp(4) = parm(6)                       'to the temp array in the proper
  55. temp(5) = parm(7)                       'positions for EdStr$().  Everything
  56. temp(10) = parm(8)                      'else is zero.
  57.  
  58. wide = 0: tall = 0                      'Find out how wide and tall to make
  59. FOR x = LBOUND(msg$) TO UBOUND(msg$)    'the box.  Use either the longest
  60.      l = LEN(msg$(x))                   'message or the maxlen of EdStr$().
  61.      IF l > wide THEN wide = l
  62.      tall = tall + 1
  63. NEXT x
  64. IF parm(5) > wide THEN wide = parm(5)
  65. tall = tall + 2                         'Allow for a blank line & EdStr$().
  66.  
  67. row1 = parm(1)                          'Calculate where to place the box.
  68. col1 = parm(2)
  69. BoxCalc row1, col1, row2, col2, tall, wide
  70.  
  71. temp(1) = row2 - 1                      'Calculate the row & column where the
  72. IF parm(5) = wide THEN                  'EdStr$() will be located.
  73.      temp(2) = col1 + 1
  74. ELSE
  75.      temp(2) = col1 + 1 + ((wide - parm(5)) \ 2)
  76. END IF
  77.  
  78. '                          *** Draw the Box ***
  79.  
  80. oldrow = CSRLIN                         'Save the current cursor location
  81. oldcol = POS(0)
  82. savepage = VPage(0)                     'Allocate a video page to save the
  83. IF savepage = 0 THEN                    'current screen on.  If unable to get
  84.      savefile$ = TempName$("")          'one, we'll have to use the slower
  85.      SaveScreen savefile$               'method of saving it to an actual
  86. ELSE                                    'file.
  87.      PCOPY 0, savepage
  88. END IF
  89.  
  90. PopBox row1, col1, row2, col2, wide, msg$(), parm()
  91.  
  92.  
  93. '                    *** Let EdStr$() do its thing! ***
  94.  
  95. COLOR parm(FGWS), parm(BGWS)
  96. EditBox$ = EdStr$(orig$, temp())
  97.  
  98. '                     *** Clean up after ourselves ***
  99.  
  100. ERASE temp                              'Nuke the temporary array.
  101. IF savepage = 0 THEN                    'Restore the previous screen.
  102.      RestScreen savefile$
  103.      KILL savefile$
  104. ELSE
  105.      PCOPY savepage, 0
  106.      x = VPage(savepage)
  107. END IF
  108. SetView -1, -1, parm()                  'Restore the previous viewport.
  109. COLOR parm(FGN), parm(BGN)              'Set the colors back to normal.
  110. LOCATE oldrow, oldcol                   'Put the cursor where it was.
  111.  
  112. END FUNCTION
  113.  
  114. FUNCTION EditBox2$ (msg$, orig$, parm())
  115. '****************************************************************************
  116. 'Exactly the same as EditBox$(), but you pass a single text string as a
  117. ' message instead of an array.  Just saving you a little coding.
  118. '
  119. 'See EditBox$() for all the details.
  120. '
  121. '****************************************************************************
  122.  
  123. REDIM msg$(1 TO 1)
  124. msg$(1) = msg$
  125.  
  126. EditBox2$ = EditBox$(msg$(), orig$, parm())
  127.  
  128. ERASE msg$
  129.  
  130. END FUNCTION
  131.  
  132.