home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / DISPMSG.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  4.7 KB  |  123 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : DISPMSG.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : DISPLAY MESSAGE SUBROUTINE
  9. '
  10. '****************************************************************************
  11. '  This program and those associated with it were written for use with Quick-
  12. '  Windows Advanced (Version 1.5+).  Possesion of this program entitles you
  13. '  to certain priviliges.  They are:
  14. '
  15. '     1. You may compile, use, or modify this program in any way you choose
  16. '        provided you do not sell or give away the source code to this prog-
  17. '        ram or any of it's companions to anyone for any reason.  You may,
  18. '        however, sell the resulting executable program as you see fit.
  19. '
  20. '     2. You may modify, enhance or change these programs as you see fit. I
  21. '        as that you keep a copy of the original code and that you notify
  22. '        me of any improvements you make.  I like to think that the code is
  23. '        bug free and cannot be improved upon, but I'm sure someone will
  24. '        find a way to make it better.  If it's you, I'm looking forward to
  25. '        seeing your changes.  I can be reached at:
  26. '
  27. '              Tim Beck                      Tim Beck (C/O Debbie Beck)
  28. '              19419 Franz Road              8030 Fairchild Avenue
  29. '              Houston, Texas  77084         Canoga Park, California 91306
  30. '              (713) 639-3079                (818) 998-0588
  31. '
  32. '     3. This code has been tested and re-tested in a variety of applications
  33. '        and although I have not found any bugs, doesn't mean none exist. So,
  34. '        this program along with it's companions comes with NO WARRANTY,
  35. '        either expressed or implied.  I'm sorry if there are problems, but
  36. '        I can't be responsible for your work.  I've tried to provide a safe
  37. '        and efficient programming enviroment and I hope you find it helpful
  38. '        for you.  I do, however, need to cover my butt!
  39. '
  40. '  I have enjoyed creating this library of programs and have found them to be
  41. '  a great time saver.  I hope you agree.
  42. '
  43. '                                                            Tim Beck //
  44. '
  45. '****************************************************************************
  46.    DECLARE SUB CLOSE.WINDOW (wid%)
  47.    DECLARE SUB MAXWID (M.Item%, msg$(), max.wid%)
  48.    DECLARE FUNCTION FreeWind% ()
  49.    DECLARE FUNCTION Show$ (Show.String$, Show.Len%)
  50.   
  51.    DECLARE SUB DISPLAY.MSG (Row%, Col%, items%, msg$(), Hdr$, Get.Item%, selected%, flag%)
  52.  
  53.    '------------------------------------------------------------------------
  54.    '  Display a Message at a specified position on the Screen
  55.    '  Optionally get a response from the Message
  56.    '
  57.    '  Row%, Col%  = Top Left Row and Column of Message Box
  58.    '  items%      = Number of Items (Message Lines)
  59.    '  msg$()      = Message Lines
  60.    '  Hdr$        = Message Box Header
  61.    '  Get.Item%   = Get Item or Display Message Flag (0 = Display Message only)
  62.    '  selected%   = Number of Item Selected
  63.    '  Flag%       = Error Flag%
  64.    '
  65.  
  66.    REM $INCLUDE: 'STDCOM.INC'
  67.  
  68.    TIMER OFF    'Enables Event Trapping
  69.  
  70. '   ON ERROR GOTO ErrorTrap
  71.  
  72. ErrorTrap:
  73.  
  74. '   RESUME
  75.  
  76. SUB DISPLAY.MSG (Row%, Col%, items%, msg$(), Hdr$, Get.Item%, selected%, flag%) STATIC
  77.  
  78.    flag% = 1
  79.  
  80.    Style% = Sh.Flag% + EX.Flag%
  81.   
  82.    IF Row% = 0 THEN
  83.       Row% = 1
  84.    END IF
  85.    IF Col% = 0 THEN
  86.       Col% = 1
  87.    END IF
  88.    IF selected% = 0 THEN
  89.       selected% = 1
  90.    END IF
  91.  
  92.    wid% = FreeWind%
  93.    sav% = wid%                      'In case of error, wid% will be returned
  94.                                     'negative, sav restores original value
  95.    idx% = ((wid% - 1) * 2000)       'each window is allotted 2000 characters
  96.  
  97.    CALL MAXWID(items%, msg$(), max.wid%)
  98.    IF Get.Item% = 0 THEN
  99.       msg$ = ""
  100.       FOR M% = 0 TO items% - 1
  101.          msg$ = msg$ + " " + Show$(msg$(M%), max.wid%)
  102.          IF M% < items% THEN
  103.             msg$ = msg$ + "~"
  104.          END IF
  105.       NEXT M%
  106.       CALL MESSAGEBOX(" OK ", 17, S.attr%, msg$, items%, max.wid% + 2, S.attr%, selected%, msg.array%())
  107.    ELSE
  108.       IF items% < 10 THEN
  109.          hgt% = items%
  110.       ELSE
  111.          hgt% = 10
  112.       END IF
  113.       CALL WOPENI(Col%, Row%, Col% + max.wid% + 3, Row% + hgt% + 1, Style%, S.attr%, Hdr$, w.array%(), idx%, wid%)
  114.       IF wid% <= 0 THEN
  115.          wid% = sav%
  116.       END IF
  117.       CALL POPMENUV(wid%, 0, 0, max.wid% + 2, hgt%, S.attr%, S.attr%, selected%, items%, 2, kb%, flag%, msg$())
  118.       CALL CLOSE.WINDOW(wid%)
  119.    END IF
  120.  
  121. END SUB
  122.  
  123.