home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / PDXOS2-1.ZIP / SAMPLE / POPUP.SC < prev    next >
Encoding:
Text File  |  1988-12-29  |  10.8 KB  |  239 lines

  1. ; Contains Licensed Material Copyright (C) 1987 Ansa Software -- MJP
  2.  
  3. ; This procedure creates and fills the arrays POPUPLIST, POPUPSTART, POPUPLEN,
  4. ; and POPUPNUMBER, with information from (and about) the specified tables.
  5. ; These arrays are then used by the procedure Popup to cause a popup menu to
  6. ; be created.  The procedure also reads in the Popup procedures themselves.
  7. ;
  8. ; This procedure must be called once before the Popup procedure is invoked
  9. ; (generally at the beginning of the main program) while sysmode()="Main".  It
  10. ; is called by executing the command:  SetPopup(Tables), where Tables is a
  11. ; string in the form:
  12. ;                      Table1, Table2, ... , TableN   (N<=10)
  13. ;
  14. ; The information in each of the tables specified by "Tables" will be used to
  15. ; define a seperate pop-up menu.  NOTE:  If the information in the tables is
  16. ; static (not subject to change), then the need to call this procedure at run-
  17. ; time may be eliminated.  To do this, simply call this procedure once, and
  18. ; follow the procedure call with the command:  SAVEVARS POPUPLIST,POPUPSTART,
  19. ; POPUPLEN,POPUPNUMBER.  Then simply read in the values of these arrays into
  20. ; your program.  Last, remember to read in the procedures Popup, PopDraw, and
  21. ; PopRedraw from the toolkit library.
  22. ;
  23. Proc SetPopup(Tables)
  24.    Private;Tables,            ;List of tables for which to define popup menus
  25.            TempName,          ;Array which stores the names of each table
  26.            NumMenus,          ;Number of tables specified in "Tables" parameter
  27.            NumItems,          ;Number of items in current table
  28.            CurrTable,         ;Current table being looked at
  29.            X                  ;Loop index
  30.    Array TempName[10]
  31.    Array PopupStart[10]       ;Stores pointer to beginning of item list
  32.    Array PopupNumber[10]      ;Stores number of items in menu list
  33.    Array PopupLen[10]         ;Stores length of longest menu choice
  34.    NumMenus=0
  35.    NumItems=0
  36.    Tables=Tables+","
  37.    While match(Tables,"..,..",CurrTable,Tables)    ;Process each table name
  38.       If not istable(CurrTable)
  39.          Then Quit "Table "+CurrTable+" does not exist."
  40.       Endif
  41.       NumMenus=NumMenus+1                          ;Update which menu this is
  42.       TempName[NumMenus]=CurrTable
  43.       PopupStart[NumMenus]=NumItems                ;NumItems is a running total
  44.       NumItems=NumItems+nrecords(CurrTable)
  45.    Endwhile
  46.    If NumItems<>0
  47.       Then Array PopupList[NumItems]  ;Stores all line items from data tables
  48.    Endif
  49.    For X from 1 to NumMenus
  50.       If isempty(TempName[X])
  51.          Then PopupNumber[X]=0
  52.          Else View TempName[X]
  53.               Right
  54.               PopupNumber[X]=0
  55.               PopupLen[X]=0
  56.               Scan
  57.                  PopupLen[X]=max(PopupLen[X],len([])+4)      ;Update max width
  58.                  PopupNumber[X]=PopupNumber[X]+1
  59.                  PopupList[PopupNumber[X]+PopupStart[X]]=[]  ;Store line item
  60.               Endscan
  61.               PopupLen[X]=max(PopupLen[X],10)
  62.               ClearImage
  63.       Endif
  64.    Endfor
  65.    If not isassigned(TKLibName)
  66.       Then TKLibName=sdir()+"Toolkit"
  67.    Endif
  68.    If isfile(TKLibName+".LIB")
  69.       Then Readlib TKLibName Popup,PopDraw,PopRedraw
  70.       Else Message "Library "+TKLibName+" does not exist."
  71.            Debug
  72.    Endif
  73. Endproc
  74.  
  75. ; This procedure creates a pop-up window.  It is intended to be used during
  76. ; data entry (or edit), but can be used in virtually any mode.
  77. ;
  78. ; Within the popup window are menu choices which can be selected by moving the
  79. ; cursor using Up, Down, PgUp, PgDn, Home, and End.  The information for the
  80. ; procedure is contained in four array variables (PopupList, PopupStart,
  81. ; PopupLen, and PopupNumber) which are set by the SetPopup procedure.
  82. ;
  83. ; Popup takes the following arguments:
  84. ;   R--   Row position of the upper left corner where menu is to be drawn.
  85. ;   C--   Column position of the upper left corner where menu is to be drawn.
  86. ;   Num-- Number of pop-up menu.  This corresponds to the position of the
  87. ;         table name in the arguement passed to the SetPopup procedure.  (For
  88. ;         example, if we say:  SetPopup("x,y,z"), then to create a menu
  89. ;         with information from the table "y" we say:  Popup(R,C,2,Size).)
  90. ;   Size- Vertical size of the menu.  This is the number of selections that
  91. ;         will be displayed at one time.  Choices will scroll up and down to
  92. ;         reveal other choices.  It is recommended that 8088-class computers
  93. ;         only provide menus with as many choices as will fit on the screen,
  94. ;         and set Size equal to 9999 to disable scrolling.
  95. ;
  96. Proc Popup(R,C,Num,Size)
  97.    Private;R,       ;Row position of popup window
  98.           ;C,       ;Column position of popup window
  99.           ;Num,     ;Popup menu number
  100.           ;Size,    ;Number of choices to be displayed at one time
  101.            Char,    ;Last key that was pressed
  102.            MenuPos, ;Current position within menu
  103.            Choice,  ;Current menu selection
  104.            X        ;Counter
  105.    If PopupNumber[Num]=0
  106.       Then Return ""
  107.    Endif
  108.    If Size>PopupNumber[Num]
  109.       Then Size=PopupNumber[Num]
  110.    Endif
  111.    Echo Off
  112.    Cursor Off
  113.    @0,0
  114.    ?? "Highlight the appropriate selection using the cursor movement keys."
  115.    Clear Eol
  116.    ? "Press [Enter] to accept, [Esc] to cancel menu selection."
  117.    Clear Eol
  118.    ;Draw menu box
  119.    @R,C
  120.    ?? "╔",fill("═",PopupLen[Num]-2),"╗"
  121.    @R+1,C
  122.    ?? "║ CHOOSE:",spaces(PopupLen[Num]-10),"║"
  123.    @R+2,C
  124.    ?? "╟",fill("─",PopupLen[Num]-2),"╢"
  125.    For X from 1 to Size
  126.       @R+2+X,C
  127.       ?? "║ ",substr(strval(PopupList[PopupStart[Num]+X])+
  128.               spaces(PopupLen[Num]),1,PopupLen[Num]-3),"║"
  129.    Endfor
  130.    @R+3+Size,C
  131.    ?? "╚",fill("═",PopupLen[Num]-2),"╝"
  132.    If Size<>PopupNumber[Num]      ;Is there more data that can't be displayed?
  133.       Then @R+2+Size,C+1
  134.            ?? ""                 ;Show that more items exist below
  135.    Endif
  136.    MenuPos=1
  137.    Choice=1
  138.    While True
  139.       Style Reverse               ;Highlight current selection
  140.       PopDraw()
  141.       Style
  142.       Char=getchar()
  143.       Switch
  144.          Case Char=-72:                          ;Key was [Up]
  145.             If Choice=1                          ;Are we already at the top?
  146.                Then Beep
  147.                Else If MenuPos>1                 ;Can we move within the menu?
  148.                        Then PopDraw()            ; Yes- Blank current selection
  149.                             MenuPos=MenuPos-1    ;      Move window position
  150.                        Else PopRedraw(Choice-2)  ; No-  Redraw entire menu
  151.                     Endif
  152.                     Choice=Choice-1              ;Select new choice
  153.             Endif
  154.          Case Char=-80:                          ;Key was [Down]
  155.             If Choice=PopupNumber[Num]           ;Are we already at the bottom?
  156.                Then Beep
  157.                Else If MenuPos<Size              ;Can we move within the menu?
  158.                        Then PopDraw()            ; Yes- Blank current selection
  159.                             MenuPos=MenuPos+1    ;      Move window position
  160.                        Else PopRedraw(Choice-Size+1); No-  Redraw entire menu
  161.                     Endif
  162.                     Choice=Choice+1              ;Select new choice
  163.             Endif
  164.          Case Char=-71:                          ;Key was [Home]
  165.             If MenuPos=Choice                    ;Is first selection on screen?
  166.                Then PopDraw()                    ; Yes- Blank current selection
  167.                Else PopRedraw(0)                 ; No-  Redraw menu from start
  168.             Endif
  169.             MenuPos=1                            ;Position at first item
  170.             Choice=1                             ;Select first item
  171.          Case Char=-79:                          ;Key was [End]
  172.             If Choice+Size-MenuPos=PopupNumber[Num];Is last selection on screen?
  173.                Then PopDraw()                    ; Yes- Blank current selection
  174.                Else PopRedraw(PopupNumber[Num]-Size); No-  Redraw end of menu
  175.             Endif
  176.             MenuPos=Size                         ;Position at bottom of menu
  177.             Choice=PopupNumber[Num]              ;Select last item
  178.          Case Char=-73:                          ;Key was [PgUp]
  179.             If MenuPos=Choice                    ;Are we within first screen?
  180.                Then Beep                         ; Yes- Disallow PgUp
  181.                Else If Choice-MenuPos-Size>0
  182.                        Then Choice=Choice-MenuPos-Size+1
  183.                        Else Choice=1
  184.                     Endif
  185.                     PopRedraw(Choice-1)          ; No-  Redraw previous page
  186.                     MenuPos=1                    ;   Position on that item
  187.             Endif
  188.          Case Char=-81:                          ;Key was [PgDn]
  189.             If Choice+Size-MenuPos=PopupNumber[Num];Are we within last screen?
  190.                Then Beep                           ; Yes- Disallow PgDn
  191.                Else If PopupNumber[Num]-Size<Choice+Size-MenuPos
  192.                        Then Choice=PopupNumber[Num]-Size+1
  193.                        Else Choice=Choice+Size-MenuPos+1
  194.                     Endif
  195.                     PopRedraw(Choice-1)            ; No- Redraw next page
  196.                     MenuPos=1                      ;     Position on that item
  197.             Endif
  198.          Case Char=13:                             ;Key was [Enter]
  199.             Cursor Normal
  200.             Return PopupList[PopupStart[Num]+Choice]       ;Return selection
  201.          Case Char=27:                             ;Key was [Esc]
  202.             Cursor Normal
  203.             Return ""
  204.          Otherwise:                                ;Illegal key
  205.             Beep
  206.       Endswitch
  207.    Endwhile
  208. Endproc
  209.  
  210. ; This procedure is used by the Popup procedure.  It positions the cursor and
  211. ; redraws current menu item (in either inverse or normal text).
  212. ;
  213. Proc PopDraw()
  214.    @MenuPos+R+2,C+2
  215.    ?? PopupList[PopupStart[Num]+Choice]
  216. Endproc
  217.  
  218. ; This procedure is used by the PopUp procedure.  It redraws the entire
  219. ; contents of the popup window.
  220. ;
  221. Proc PopRedraw(Start)
  222. ;Private Start           ;Location within PopupList to begin redraw
  223.    For Z from 1 to Size            ;Redraw all information in the menu box
  224.       @R+Z+2,C+2
  225.       ?? substr(strval(PopupList[PopupStart[Num]+Start+Z])+
  226.          spaces(PopupLen[Num]),1,PopupLen[Num]-3)
  227.    Endfor
  228.    @R+3,C+1
  229.    If Start=0          ;Are there records above?
  230.       Then ?? " "      ; No- Remove up arrow
  231.       Else ?? ""      ; Yes- Place up arrow to signify more records
  232.    Endif
  233.    @R+Size+2,C+1
  234.    If Start+Size=PopupNumber[Num]  ;Are there records below?
  235.       Then ?? " "                  ; No- Remove down arrow
  236.       Else ?? ""                  ; Yes- Place down arrow to signify more
  237.    Endif
  238. Endproc
  239.