home *** CD-ROM | disk | FTP | other *** search
- ; Copyright (c) 1988, 1989 Borland International. All Rights Reserved.
- ;
- ; General permission to re-distribute all or part of this script is granted,
- ; provided that this statement, including the above copyright notice, is not
- ; removed. You may add your own copyright notice to secure copyright
- ; protection for new matter that you add to this script, but Borland
- ; International will not support, nor assume any legal responsibility for,
- ; material added or changes made to this script.
- ;
- ; Revs.: DCY 12/15/88
- ; ****************************************************************************
- ; SetPopup2 initializes variables required by Popup2 from data stored in a
- ; table. It requires a table name and a field name from which to read menu
- ; item information. Basically, it views and scans the given table, defining
- ; menu items as elements within an array. It also determines the widest
- ; element of the array (not necessarily the width of the field), assigning it
- ; to another variable also required by Popup2.
- ;
- Proc SetPopup2(PopTbl,Fld)
- ; Private;PopTbl, ;Source table for items of menu
- ;Fld, ;Source field for items of menu
- ; Global ;Item, ;Array of items of menu
- ;Width ;Width of widest item
-
- Array Item[NRecords(PopTbl)] ;Dimension Item array. One item per record
- View PopTbl ; in PopTbl.
- MoveTo Field Fld
- Width = 0
- If Search("A",FieldType()) = 0 ;If field is non-alphanumeric, convert it
- Then Scan ; to a string value before assigning it
- Item[[#]] = Strval([])
- Width = Max(Len(Item[[#]]),Width) ;Update max. width
- Endscan
- Else Scan
- Item[[#]] = []
- Width = Max(Len([]),Width)
- Endscan
- Endif
-
- Endproc
-
- ; Popup2 displays a similar popup-style menu to that of Popup. However, it
- ; does have some enhancements and restrictions compared to Popup. For
- ; example, with Popup2, a user can move to a selection by just pressing the
- ; first letter of a selection. It there are no selections which begin with
- ; that first letter below the current menu position, Popup2 sounds a beep.
- ; You can also instruct Popup2 to highlight a specific menu item when it
- ; first displays a menu. Popup2 also allows you to specify a title for the
- ; menu box as well as a custom top-two line prompt. Lastly, it includes color
- ; support (you can define your own color set, see the code below).
- ;
- ; Unlike Popup, however, Popup2 stores only one menu item list in its menu
- ; item array (named Item). You can either use SetPopup2 to fill the Item
- ; array from records in a table or you can define and fill the array
- ; yourself. If you do so, you must assign the variable Width a value equal
- ; to the number of characters of the widest item in the Item array. Because
- ; Popup2 stores only one menu item list at a time in the Item array, you'll
- ; need to redimension and reassign Item and Width each time you wish to
- ; display a different menu. However, depending upon the size and number of
- ; different menus you wish to display, the resultant memory savings should
- ; more than balance the slight performance degradation.
- ;
- ; Popup2 dynamically centers the menu box title such that the entire title
- ; will always be displayed. Note, however, that for performance Popup2 does
- ; no special error handling. Thus you should ensure that the arguments you
- ; give it are indeed valid, i.e., the canvas coordinates must allow the entire
- ; menu to fit on the screen, the default item number must be within the legal
- ; range, etc.
-
- Proc Popup2(R,C,VNum,DefItem,Title,Prompt1,Prompt2)
- Private;R, ;Row position of upper-left corner of menu box
- ;C, ;Column position of upper-left corner menu box
- ;VNum, ;Number of items to be displayed in one menu image
- ;DefItem, ;Item (number) to show
- ;Title, ;Title of popup box
- ;Prompt1, ;First prompt line
- ;Prompt2, ;Second prompt line
- NItems, ;Number of items in menu list
- Char, ;Keycode of last key pressed
- MenuPos, ;Current (row image) position within menu
- CIndex, ;Current choice index into Item
- X, ;Counter variable
- PrmptColr, ;Color attribute for prompt
- BrdrColr, ;Color attribute for box border
- ListColr, ;Color attribute for menu item list
- SlctColr ;Color attribute for current menu selection
- ; Global ;Item, ;Array of items of menu
- ;Width ;Width of widest item
-
- Echo Off ;Freeze workspace image
- Cursor Off ;Hide blinking cursor
- Canvas Off ;Disable immediate printing to canvas
-
- PrmptColr = SysColor(0) ;Top two line prompt color
- BrdrColr = SysColor(9) ;Border color
- ListColr = SysColor(17) ;Menu list color
- SlctColr = SysColor(18) ;Current menu selection color
-
- Style Attribute PrmptColr
- @ 0,0 ;Display prompt information
- ?? Spaces(80)+Prompt2+Spaces(80-Len(Prompt2))
- @ 0,0
- ?? Prompt1
-
- Width = Max(Len(Title),Width) ;Expand box width if title is too wide
- NItems = ArraySize(Item) ;Set number of items in list
- If VNum > NItems
- Then VNum = NItems
- Endif
-
- Switch
- Case DefItem < VNum : ;Redraw top screen
- Redraw = 0
- MenuPos = DefItem
- Case DefItem > NItems-VNum : ;Redraw last screen
- Redraw = NItems-VNum
- MenuPos = DefItem-NItems+VNum
- Otherwise : ;Redraw intermediate screen
- Redraw = DefItem-1 ;Place item at top of menu
- MenuPos = 1
- Endswitch
-
- ;Set default menu settings:
- CIndex = DefItem ;First menu item
- LastPos = MenuPos ;Last image position is current pos.
- LastIdx = CIndex ;Last menu item index
-
- Style Attribute BrdrColr
- SetMargin C
- @ R,C ;Draw menu skeleton and initial image
- ?? "╔",Fill("═",Width+2),"╗"
- ? "║ ",Format("AC,W"+Strval(Width),Title)," ║"
- ? "╟",Fill("─",Width+2),"╢"
- For X From 1 To VNum
- ? "║",Spaces(Width+2),"║"
- Endfor
- ? "╚",Fill("═",Width+2),"╝"
-
- @ R+3,C+1
- If Redraw = 0 ;Records above?
- Then ?? " "
- Else ?? " " ; Yes- Show items are above
- Endif
- @ R+VNum+2,C+1
- If Redraw+VNum = NItems ;Records below?
- Then ?? " "
- Else ?? " " ; Yes- Show items are below
- Endif
-
- @ R+2,C+2
- SetMargin C+2
- Style Attribute ListColr
- For X From 1 To VNum
- ? Item[X+Redraw]+Spaces(Width-Len(Item[X+Redraw]))
- Endfor
- SetMargin Off
-
- Canvas On ;Reenable immediate echoing to canvas
-
- Redraw = -1 ;Disable menu image redraw
-
- While True
-
- Style Attribute SlctColr
- @ MenuPos+R+2,C+2 ;Highlight current selection
- ?? Item[CIndex]
- Style Attribute ListColr
-
- Char = getchar()
-
- Switch
- Case Char > 31: ;First character search?
- For X From CIndex+1 to NItems ;Search (down) item array
- If Upper(Substr(Item[X],1,1)) = Upper(Chr(Char))
- Then QuitLoop ;Found a match
- Endif
- Endfor
- If X = NItems+1 ;Match not found
- Then Beep
- Else If MenuPos+X-CIndex > VNum ;Is next item already visible?
- Then Switch ; No-
- Case X < VNum : ;Redraw top screen
- Redraw = 0
- MenuPos = X
- Case X > NItems-VNum : ;Redraw last screen
- Redraw = NItems-VNum
- MenuPos = X-NItems+VNum
- Otherwise : ;Redraw intermediate screen
- Redraw = X-1 ;Place item at top of menu
- MenuPos = 1
- Endswitch
- Else MenuPos = MenuPos+X-CIndex
- Redraw = -1
- Endif
- CIndex = X ;Update current item
- Endif
- Case Char = -72 : ;Up
- If CIndex = 1 ;Already at first item?
- Then Beep
- Else If MenuPos > 1 ;Can move within menu image?
- Then MenuPos = MenuPos-1 ; Yes- Move to previous item
- Else Redraw = CIndex-2 ; No- Redraw entire menu
- Endif
- CIndex = CIndex-1 ;Update current item
- Endif
- Case Char = -80 : ;Down
- If CIndex = NItems ;On last item?
- Then Beep
- Loop
- Else If MenuPos < VNum ;Can move within menu image?
- Then MenuPos = MenuPos+1 ; Yes- Move to next item
- Else Redraw = CIndex-VNum+1 ; No- Redraw entire menu
- Endif
- CIndex=CIndex+1 ;Update current item
- Endif
- Case Char = -71 : ;Home
- If MenuPos <> CIndex ;Already viewing top of menu?
- Then Redraw = 0 ; No- Redraw top of menu
- Endif
- MenuPos = 1 ;Position at first item
- CIndex = 1 ;Select first item
- Case Char = -79 : ;End
- If CIndex+VNum-MenuPos <> NItems ;Already viewing end of menu?
- Then Redraw = NItems-VNum ; No- Redraw end of menu
- Endif
- MenuPos = VNum ;Position at bottom of menu
- CIndex = NItems ;Select last item
- Case Char = -73 : ;PgUp
- If MenuPos = CIndex ;Are we within first screen?
- Then Beep ; Yes- Disallow PgUp
- Else If CIndex-MenuPos-VNum > 0
- Then CIndex = CIndex-MenuPos-VNum+1
- Else CIndex = 1
- Endif
- Redraw = CIndex-1 ; No- Redraw previous page
- MenuPos = 1 ; Position on that item
- Endif
- Case Char = -81 : ;PgDn
- If CIndex+VNum-MenuPos = NItems ;Are we within last screen?
- Then Beep ; Yes- Disallow PgDn
- Else If NItems-VNum < CIndex+VNum-MenuPos
- Then CIndex = NItems-VNum+1
- Else CIndex = CIndex+VNum-MenuPos+1
- Endif
- Redraw = CIndex-1 ; No- Redraw next page
- MenuPos = 1 ; Position on that item
- Endif
- Case Char = 13 : ;Enter
- Cursor Normal
- Style
- Return Item[CIndex] ;Return selection
- Case Char = 27 : ;Esc
- Cursor Normal
- Style
- Return "" ;Return null selection
- Otherwise: ;Illegal key
- Beep
- Endswitch
-
- If Redraw = -1 ;Need to redraw entire menu?
- Then @ LastPos+R+2,C+2
- ?? Item[LastIdx]
- Else Canvas Off ;Disable immediate canvas echo
- SetMargin C+2
- @ R+2,C+2
- For X from 1 to VNum ;Redraw entire menu box
- ? Item[Redraw+X]+Spaces(Width-Len(Item[Redraw+X]))
- Endfor
- SetMargin Off
- @ R+3,C+1
- Style Attribute BrdrColr
- If Redraw = 0 ;Records above?
- Then ?? " "
- Else ?? " " ; Yes- Show items are above
- Endif
- @ R+VNum+2,C+1
- If Redraw+VNum = NItems ;Records below?
- Then ?? " "
- Else ?? " " ; Yes- Show items are below
- Endif
- Canvas On ;Enable immediate canvas echo
- Redraw = -1
- Endif
-
- LastPos = MenuPos ;Update last row position
- LastIdx = CIndex ;Update last item index
-
- Endwhile
-
- Endproc
-
