home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / POPBOX.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  2KB  |  70 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'PARM.INC'
  4.  
  5. DECLARE SUB PopBox (t, l, b, r, wide, msg$(), parm())
  6.  
  7.  
  8. 'External procedures:
  9.  
  10. DECLARE SUB Box (t, l, b, r, b$)
  11. DECLARE FUNCTION Istr$ (i)
  12. DECLARE FUNCTION PadC$ (t$, l)
  13. DECLARE FUNCTION PadL$ (t$, l)
  14. DECLARE FUNCTION PadR$ (t$, l)
  15. DECLARE FUNCTION VPage (p)
  16. DECLARE SUB WipeArea (t, l, b, r)
  17.  
  18. SUB PopBox (t, l, b, r, wide, msg$(), parm())
  19. '****************************************************************************
  20. 'This function is used by other pop-up box functions to zap the box onto the
  21. ' screen.  The procedure that calls this function must have its parm(3 & 4)
  22. ' arguments set up like so:
  23. '
  24. '    parm(3) = box border type 1-4
  25. '    parm(4) = message justification  <0=Left  0=Center  >0=Right
  26. '
  27. 'See EditBox(), PickBox(), and Progress() for examples of use.  ListBox() is
  28. ' not included because it doesn't have a msg$() array.
  29. '
  30. '****************************************************************************
  31.  
  32. workpage = VPage(0)                     'Allocate a non-critical video page.
  33. PCOPY 0, workpage                       'Copy the screen to the scratch page.
  34. SCREEN , , workpage, 0                  'Draw on the work page until ready.
  35.  
  36. COLOR parm(FGWB), parm(BGWB)            'Draw the outline
  37. Box t, l, b, r, Istr$(parm(3))
  38.  
  39. COLOR parm(FGWT), parm(BGWT)            'Print the text.
  40. WipeArea t + 1, l + 1, b - 1, r - 1
  41. y = t
  42. FOR x = LBOUND(msg$) TO UBOUND(msg$)
  43.      y = y + 1
  44.      LOCATE y, l + 1
  45.      SELECT CASE parm(4)                'Justify the text.
  46.           CASE IS < 0
  47.                PRINT PadR$(msg$(x), wide)
  48.           CASE 0
  49.                PRINT PadC$(msg$(x), wide)
  50.           CASE ELSE
  51.                PRINT PadL$(msg$(x), wide)
  52.      END SELECT
  53. NEXT x
  54.  
  55. COLOR 0, 0                              'Print the shadow
  56. y = r + 1
  57. FOR x = (t + 1) TO b
  58.      LOCATE x, y: PRINT " ";
  59. NEXT x
  60. LOCATE b + 1, l + 1: PRINT SPACE$(wide + 2);
  61.  
  62. PCOPY workpage, 0                       'Pop the box onto the screen.
  63. SCREEN , , 0, 0                         'Draw on screen 0 again.
  64. x = VPage(workpage)                     'Release the scratch video page.
  65.  
  66. COLOR parm(FGWT), parm(BGWT)            'Reset the colors to window text.
  67.  
  68. END SUB
  69.  
  70.