home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR4
/
P7101.ZIP
/
BROWSE.CLA
< prev
next >
Wrap
Text File
|
1994-02-02
|
42KB
|
619 lines
PROGRAM
OMIT('┘')
┌───────────────────────────────────────────────────────────┬────────────────┐
│ │Version:3007.101│
├───────────────────────────────────────────────────────────┴────────────────┤
│ BROWSE.CLA - The Browse Support Module │
│ │
│ The Browse Support Module manages the process of scrolling records │
│ through a list box. Browse support is conducted in a session that │
│ is initiated by the BeginBrowse procedure and terminated by the │
│ EndBrowse procedure. Multiple browse sessions may be conducted at │
│ the same time (e.g. a browse procedure calls a form which calls a │
│ lookup procedure). The current status of a browse session is │
│ stored in a Session queue. The browse process uses a position │
│ queue which contains a POSITION() string used to access displayed │
│ records. │
│ │
│ BeginBrowse(List,Locator,Immediate,Increment,Nomemo) │
│ │
│ Initiate a browse session and append a new element to the │
│ Session queue. Fixed (non-scrolling) queue elements should be │
│ the only elements in the list queue when a session begins. │
│ │
│ "List" is the field number of a list box that displays a queue │
│ of formatted records. │
│ │
│ "Locator" is an optional parameter that contains the field │
│ number of a locator field. Typing any displayable character │
│ activates the locator field. The USE variable of the locator │
│ field must be a key component, so completing the locator field │
│ scrolls the list box to the first matching record. │
│ │
│ "Immediate" is an optional parameter that contains a 1 if the │
│ selected record is to be accessed each time the selector bar │
│ moves over a new record. │
│ │
│ "Increment" is an optional parameter that contains a 1, 2, 3, │
│ or 4 to request an incremental locator field that automatically │
│ locates a matching record after a pause in typing. Increment │
│ values of 2, 3, and 4 request upper case, lower case, and │
│ capitalized locator fields. An increment value of 1 uses the │
│ case entered by the operator. │
│ │
│ "Nomemo" is an optional parameter that contains a 1 or 2 to │
│ disarm memo fields. A value of 1 means that memos are not │
│ displayed in the list box. A value of 2 means, in addition, │
│ that memos are not used as hot fields. Memos are always │
│ retrieved for "Process Field" actions. │
│ │
│ BrowseAction(File,Key,Queue) │
│ │
│ Manages the behavior of the list box, locator field, and hot │
│ fields. │
│ │
│ "File" is the FILE to be scrolled. │
│ │
│ "Key" is KEY to be used to access the file. │
│ │
│ "Queue" is the display queue, declared by the caller and used │
│ as the parameter of the FROM attribute of the list box. │
│ │
│ BrowseAction returns a code requesting one of the following │
│ actions: the following actions: │
│ │
│ Set the first record and set the last record of a limited │
│ range of consecutive records. │
│ │
│ Reject a record by issueing GET(File,0) to dereference the │
│ record or indicate that a record is out of range by issueing │
│ NEXT(File) or PREVIOUS(File) to move the record position. │
│ │
│ Format a display queue element for the current record. The │
│ queue element will be placed in the display queue by the │
│ browse manager. │
│ │
│ Process the record under the selector bar │
│ │
│ Process a field or key that the browse manager does not │
│ recognize. The selected record has been accessed from the │
│ file and display queue. │
│ │
│ Take action if there are no records to display. │
│ │
│ Clear the key fields subordinate to the locator field. │
│ │
│ EndBrowse │
│ │
│ Terminate the browse session. Free position elements for this │
│ session from the Position queue. Free the last element from │
│ the Session queue. │
│ │
└────────────────────────────────────────────────────────────────────────────┘
INCLUDE('KEYCODES.EQU')
MAP
BeginBrowse(SHORT,<SHORT>,<BYTE>,<BYTE>,<BYTE>)
BrowseAction(FILE,KEY,QUEUE),BYTE
EndBrowse
END
Session QUEUE !Browse session queue
Action BYTE ! Caller action
Process BYTE ! Internal process
List SHORT ! List field number
Locator SHORT ! Locator field number
Immediate BYTE ! Immediate processing flag
Increment BYTE ! Incremental locator flag
Nomemo BYTE ! No memo retrieval flag
Location STRING(40) ! Locator field contents
Length BYTE ! Locator contents length
Count BYTE ! List item count
Fixed BYTE ! Fixed list item count
Item BYTE ! Current item (1 to Count)
Choice BYTE ! Selector bar position
LastChoice BYTE ! Last Selector position
Page STRING(1) ! Current page (F,L,N,blank)
FirstPage BYTE ! First page request flag
Base SHORT ! Base for position queue
Selected STRING(256) ! Selected record position
END
Position QUEUE !Record position queue
STRING(256) ! Record Position
END
!Caller actions
NoAction EQUATE(0) ! No caller action
FormatQueue EQUATE(1) ! Format the display queue
ProcessField EQUATE(2) ! Process another field
NoRecords EQUATE(3) ! No records to display
FilterRecord EQUATE(4) ! Filter a record
ResetFirst EQUATE(5) ! Set to first of a range
ResetLast EQUATE(6) ! Set to last of a range
ProcessSelected EQUATE(7) ! Process selected record
ClearRestOfKey EQUATE(8) ! Clear low fields of key
!Internal processes
InitSession EQUATE(1) ! Initialize browse session
ProcessForward EQUATE(2) ! Process records forward
ProcessBackward EQUATE(3) ! Process records backward
ProcessSingle EQUATE(4) ! Process a single record
AcceptInput EQUATE(5) ! Accept keyboard input
LoChar EQUATE(32) !Lowest displayable char
HiChar EQUATE(127) !Highest displayable char
CODE !Dummy program
BeginBrowse PROCEDURE(InList,InLocator,InImmediate,InIncrement,InNomemo)
CODE
IF RECORDS(Session) THEN PUT(Session). !Save any current session
CLEAR(Session) !Clear the session record
Action = NoAction !Set no caller action
Process = InitSession !Initialize a browse session
List = InList !Set list field number
Locator = InLocator !Set locator field number
Immediate = InImmediate !Set immediate process flag
IF Locator THEN Increment = InIncrement. !If there is a locator field
Nomemo = InNomemo !Set no memo flag
Count = ROWS(List) !Set item count
Choice = 1 !Set top choice
LastChoice = 1 !Set top last choice
Base = RECORDS(Position) !Set base position
ADD(Session,RECORDS(Session)+1) !Add the session record
RETURN !Return to caller
BrowseAction FUNCTION(File,Key,Queue)
Delay EQUATE(50) !Time delay (1/2 second)
SpaceKey EQUATE(32) !Space bar keycode
TimeOut LONG !Deadline time (.01 seconds)
LocatorContents STRING(255) !Locator field contents
CODE
CASE Action !Process caller's action
OF FilterRecord !Caller filtered the record
CASE POSITION(Key) ! Check callers action
OF '' ! The record is rejected
IF Process = ProcessSingle ! And previously accepted
DELETE(Queue) ! Delete the queue element
GET(Position,Base+Choice-Fixed) ! Get the position element
DELETE(Position) ! And delete it
Process = ProcessForward ! Display a new last
Item = RECORDS(Queue) + 1 ! record forward
GET(Position,RECORDS(Position)) ! Get last display record
RESET(Key,Position) ! Reset to last display
NEXT(File) ! Retrieve last record
END ! End IF
OF Position ! The record is accepted
Action = FormatQueue ! Ask caller to format
RETURN(Action) ! Return to caller
ELSE ! The record is out of range
DISPLAY(List) ! Display the page
SELECT(List,Choice) ! Select the list box
Selected = '' ! Clear selected position
Process = AcceptInput ! Get keyboard input
END ! End CASE
OF FormatQueue !Caller formatted the queue
CASE Process ! Jump to current process
OF ProcessForward ! On forward processing
ADD(Queue,RECORDS(Queue)+1) ! Add new last element
ADD(Position,RECORDS(Position)+1) ! Add new last position
IF RECORDS(Queue) > Count ! If the page overflows
GET(Queue,Fixed+1) ! Get the first element
DELETE(Queue) ! And delete it
GET(Position,Base+1) ! Get the first position
DELETE(Position) ! And delete it
END ! End IF
Item += 1 ! Increment current item
OF ProcessBackward ! On backward processing
ADD(Queue,Fixed+1) ! Add new first element
ADD(Position,Base+1) ! Add new first position
IF RECORDS(Queue) > Count ! If the page overflows
GET(Queue,RECORDS(Queue)) ! Get the last element
DELETE(Queue) ! And delete it
GET(Position,RECORDS(Position)) ! GET the last position
DELETE(Position) ! And delete it
END ! End IF
Item -= 1 ! Decrement current item
OF ProcessSingle ! On a single record
PUT(Queue) ! Replace the element
DISPLAY(List) ! Display the page
SELECT(List,Choice) ! Select the list box
Process = AcceptInput ! Get keyboard input
Selected = '' ! Clear selected position
END ! End CASE
OF ProcessSelected !Caller processed a record
Selected = POSITION(Key) ! Set selected position
OF ProcessField ! Caller processed a field
IF Process = InitSession ! If we got here from Init code
Process = AcceptInput ! Skip internal field handling
Action = NoAction ! Clear ACTION
RETURN(Action) ! And go another time around
END ! END (If we got here...)
IF FIELD() <> Locator ! For non-locator field
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator
END ! End IF
IF INRANGE(FIELD(),1,List-1) ! From a prior field
FirstPage = 1 ! Request the first page
END ! End IF
END ! End IF
IF SELECTED() = List ! If list field is selected
IF FirstPage ! If first page is requested
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask caller to first
RETURN(Action) ! record in range
ELSIF FIELD() <> Locator ! From any but the locator
CASE POSITION(Key) ! Check the record
OF '' ! If record was dereferenced
DO GetChoice ! Get selected record
IF POSITION(Key) = Position ! If record is still there
Process = ProcessSingle ! Display one record
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
ELSE ! If record was deleted
DELETE(Queue) ! Delete the element
DELETE(Position) ! Delete its position
IF RECORDS(Queue) = Fixed ! If queue is now empty
DO LastPage ! Display the last page
Action = ResetLast ! Ask caller to reset to
RETURN(Action) ! last record in range
ELSE ! Otherwise
Process = ProcessForward ! Display a new
Item = RECORDS(Queue) + 1 ! last record
GET(Position,RECORDS(Position)) ! Reset to the bottom
RESET(Key,Position) ! record displayed
NEXT(File) ! Read the record
END ! End IF
END ! End IF
OF Position ! If record didn't move
GET(Queue,Choice) ! Get display element
Action = FilterRecord ! Ask caller to
Process = ProcessSingle ! filter one record
RETURN(Action) ! Return to caller
ELSE ! If record moved
DO NewPage ! Display the new page
END ! End CASE
END ! End IF
ELSE ! Else another field selected
IF FIELD() <> SELECTED() ! If selecting a new field
Process = AcceptInput ! Accept keyboard input
END ! End IF
END ! End IF
OF NoRecords !Caller added a record
IF SELECTED() = List ! And selected the list field
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask caller to reset to
RETURN(Action) ! first record in range
END ! End IF
OF ClearRestOfKey !Caller cleared subfields
SELECT(Locator) ! Select the locator field
Process = AcceptInput ! Accept keyboard input
END !End CASE
LOOP !Main processing loop
CASE Process !Jump to current process
OF InitSession !Start browse session
Fixed = RECORDS(Queue) ! Set fixed list item count
Process = AcceptInput ! Accept keyboard input
IF List <> 1 ! If the List is not first
Action = ProcessField ! Process any FIELD code
RETURN(Action) ! Do It!
END ! END (If the List...)
OF ProcessForward !Process records forward
IF Item <= Count ! If page is not full
IF Nomemo THEN NOMEMO(File). ! Disarm unneeded memos
NEXT(File) ! Read the next record
IF ~ERRORCODE() ! If a record was found
Position = POSITION(Key) ! Save its position
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
ELSE ! If no record was found
IF INSTRING(Page,'FN') ! For first or new page
Process = ProcessBackward ! Display prior records
Item = Count - Item + Fixed + 1 ! from the top record
IF RECORDS(Position) > Base ! For a partial screen
GET(Position,Base+1) ! Get top position
RESET(Key,Position) ! Reset to top record
PREVIOUS(File) ! Point to prior page
CYCLE ! Process backwards
ELSE ! For a blank screen
SET(Key) ! Set to end of file
Action = ResetLast ! Ask caller to reset
RETURN(Action) ! Return to caller
END ! End IF
END ! End IF
END ! End IF
END ! End IF
DISPLAY(List) ! Display the page
SELECT(List,Choice) ! Select the list box
Selected = '' ! Clear selected position
Process = AcceptInput ! Get keyboard input
OF ProcessBackward !Process records backward
IF Item >= Fixed + 1 ! If page is not full
IF Nomemo THEN NOMEMO(File). ! Disarm unneeded memos
PREVIOUS(File) ! Read the prior record
IF ~ERRORCODE() ! If a record was found
IF INSTRING(Page,'FN',1,1) THEN Choice += 1.! Increment selector bar
Position = POSITION(Key) ! Save its position
Action = FilterRecord ! Ask caller to filter
RETURN(Action) ! Return to caller
END ! End IF
END ! If page is full
DISPLAY(List) ! Display the page
SELECT(List,Choice) ! Select the list box
Selected = '' ! Clear selected position
Process = AcceptInput ! Get keyboard input
OF AcceptInput !Get keyboard input
IF SELECTED() = List ! If the list box is selected
IF RECORDS(Queue) = Fixed ! If there are no records
CASE Page ! Jump to current page
OF 'F' ! On the first page
GET(File,0) ! Clear the current record
Action = NoRecords ! Ask caller for records
OF 'N' ! On a new page
DO LastPage ! Display the last page
Action = ResetLast ! Ask for last record
ELSE ! On any other page
DO FirstPage ! Display the first page
Action = ResetFirst ! Ask for first record
END ! End CASE
RETURN(Action) ! Return to caller
END ! End IF
IF Immediate ! For immediate processing
GET(Position,Base+CHOICE(List)-Fixed) ! Get selected position
IF Selected <> Position ! If selector moved
GET(Position,Base+Choice-Fixed) ! Get selected position
RESET(Key,Position) ! Reset to that record
IF Nomemo = 2 THEN NOMEMO(File). ! Disarm unneeded memos
NEXT(File) ! Read the record
IF Position = POSITION(Key) ! If record is there
Action = ProcessSelected ! Ask to process record
RETURN(Action) ! Return to caller
ELSE ! Else
DO NewPage ! Rebuild the Queue
Action = ProcessField ! Ask to process record
RETURN(Action) ! Return to caller
END ! End IF
END ! End IF
END ! End IF
IF Locator ! If there is a locator field
ERASE(Locator) ! Erase locator contents
IF Increment ! For incremental locator
DO ShowLocator ! Show locator field
END ! End IF
END ! End IF
LastChoice = CHOICE(List) ! Save selector position
END !End IF
ACCEPT !Enable the keyboard
CASE FIELD() !Jump to field edit routine
OF Locator !Process the locator field
IF CONTENTS(Locator) ! If locator is requested
IF Increment ! If incremental locator
Location = CONTENTS(Locator) ! Save location
Length = LEN(CLIP(Location)) ! Save location length
END ! End IF
SELECT(List) ! Select the list box
DO NewPage ! Display a new page
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
ELSE ! ELSE (If No Locator)
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END ! End IF
OF List !Process the list field
Choice = CHOICE(List) ! Save selector bar position
IF SELECTED() <> List ! Process any new fields
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END ! END (Process...)
CASE KEYCODE() ! Jump to key edit routine
OF LoChar TO HiChar ! For any locator character
OROF BSKey OROF SpaceKey ! Or a backspace or space
IF Locator ! If there is a locator
IF Increment ! On incremental locator
DO GatherKeys ! Gather keystrokes
IF Location ! If not blank
PRESS(SUB(Location,1,Length)) ! Press the string
PRESS(DownKey) ! Complete the field
SELECT(Locator) ! Select locator
END ! End IF
ELSE ! On standard locator
PRESS(KEYCODE()) ! Press in the keycode
SELECT(Locator) ! Select locator field
END ! End IF
Action = ClearRestOfKey ! Ask caller to clear
RETURN(Action) ! subordinate fields
END ! End IF
OF CtrlPgUp ! Process the Ctrl-PgUp key
DO FirstPage ! Display the first page
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator field
END ! End IF
Action = ResetFirst ! Ask caller to reset to
RETURN(Action) ! first record in range
OF PgUpKey ! Process the PgUp key
IF LastChoice <> Fixed + 1 ! If not at the top
Choice = Fixed + 1 ! Selector bar to top
ELSE ! From the top
Page = '' ! Clear page flag
Process = ProcessBackward ! Display a new page
Item = Count ! of records backward
GET(Position,Base+1) ! Reset to the top
RESET(Key,Position) ! record displayed
PREVIOUS(File) ! Point to prior record
END ! End IF
OF UpKey ! Process the up arrow
IF LastChoice = Fixed + 1 ! From the top line
Page = '' ! Clear page flag
Process = ProcessBackward ! Display a single
Item = Fixed + 1 ! record backward
GET(Position,Base+1) ! Reset to the top
RESET(Key,Position) ! record displayed
PREVIOUS(File) ! Point to prior record
END ! End IF
OF DownKey ! Process the down arrow
IF LastChoice = Count ! From the bottom line
Page = '' ! Clear page flag
Process = ProcessForward ! Display a single
Item = Count ! record forward
GET(Position,RECORDS(Position)) ! Reset to the bottom
RESET(Key,Position) ! record displayed
NEXT(File) ! Point to the next record
END ! End IF
OF PgDnKey ! Process the PgDn key
IF LastChoice <> Count ! If not at the bottom
Choice = Count ! Selector bar to bottom
ELSE ! From the bottom
Page = '' ! Clear page flag
Process = ProcessForward ! Display a new page
Item = 1 + Fixed ! of records forwards
GET(Position,RECORDS(Position)) ! Reset to the bottom
RESET(Key,Position) ! record displayed
NEXT(File) ! Point to the next record
END ! End IF
OF CtrlPgDn ! Process the Ctrl-PgDn Key
DO LastPage ! Display the last page
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator field
END ! End IF
Action = ResetLast ! Ask caller to reset to
RETURN(Action) ! last record in range
OF LeftKey ! For left arrow key,
OROF Rightkey ! Or right arrow key,
OROF Homekey ! Or Home key,
OROF Endkey ! Or End key,
OROF MouseLeft ! Or a mouse click
! Don't do anything
ELSE ! For any other key
DO GetChoice ! Get selected record
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END ! End CASE KEYCODE()
IF Increment ! If incremental locator
DO ClearLocator ! Clear locator field
END ! End
ELSE ! Process any other field
IF FIELD() >= List OR FIELD() < 0 ! If not list or setup fld
DO GetChoice ! Get selected record
ELSIF SELECTED() = List ! Else if reprocessing List
DO GetChoice ! Get selected record
END ! End IF
Action = ProcessField ! Ask caller to process
RETURN(Action) ! Return to caller
END ! End CASE FIELD()
END !End CASE BrowseProcess
END !End LOOP
GetChoice ROUTINE !Get selected record
GET(Queue,Choice) ! Get selected element
GET(Position,Base+Choice-Fixed) ! Get selected position
RESET(Key,Position) ! Reset to that record
NEXT(File) ! Read the record
FirstPage ROUTINE !Display first page
FirstPage = 0 ! Clear first page request
Page = 'F' ! Set first page flag
DO DeletePage ! Delete the old page
Choice = Fixed + 1 ! Reset selector bar
Process = ProcessForward ! Display a new page
Item = Fixed + 1 ! of records forward
SET(Key) ! Set to the first record
LastPage ROUTINE !Display last page
Page = 'L' ! Set last page flag
DO DeletePage ! Delete the old page
Choice = Count ! Reset selector bar
Process = ProcessBackward ! Display a new page
Item = Count ! of records backward
SET(Key) ! Set to the last record
NewPage ROUTINE !Display a new page
Page = 'N' ! Set new page flag
DO DeletePage ! Delete the old page
SET(Key,Key) ! Set to the new record
Choice = Fixed + 1 ! Selector bar to top
Process = ProcessForward ! Display a new page
Item = Fixed + 1 ! of records forward
DeletePage ROUTINE !Delete the current page
LOOP WHILE RECORDS(Queue) > Fixed ! Delete all queue
GET(Queue,RECORDS(Queue)) ! elements after the
DELETE(Queue) ! fixed elements
END ! End LOOP
LOOP WHILE RECORDS(Position) > Base ! Delete all position
GET(Position,RECORDS(Position)) ! elements after the
DELETE(Position) ! base position
END ! End LOOP
GatherKeys ROUTINE !Gather locator keystrokes
DO AppendKey ! Append pending keystroke
TimeOut = CLOCK() + Delay ! Set the time delay
LOOP UNTIL CLOCK() > TimeOut ! Loop until time out
IF KEYBOARD() ! If there is a keystroke
ASK ! Read the keystroke
DO AppendKey ! Append the keystroke
DO ShowLocator ! Show the user
TimeOut = CLOCK() + Delay ! Reset the time delay
END ! End IF
END ! End LOOP
AppendKey ROUTINE !Append keystroke to locator
CASE KEYCODE() ! Process the keystroke
OF LoChar TO HiChar OROF SpaceKey ! For a character
IF Length < COLS(Locator) ! If it will fit
Location = SUB(Location,1,Length) & CHR(KEYCODE()) ! Add it on
Length += 1 ! Increment the length
END ! End IF
OF BSKey ! For a backspace
IF Length > 0 THEN Length -= 1. ! Decrement the length
Location = SUB(Location,1,Length) ! Shorten the string
EXECUTE Increment - 1 ! For locator case
Location = UPPER(Location) ! Upper case location
Location = LOWER(Location) ! Lower case location
Location = UPPER(SUB(Location,1,1)) | ! Capitalize location
& LOWER(SUB(Location,2,SIZE(Location)-1))
END ! End EXECUTE
END ! End CASE
ClearLocator ROUTINE !Clear locator field
Location = '' ! Clear field string
Length = 0 ! Zero field length
DO ShowLocator ! Show locator field
ShowLocator ROUTINE !Show locator field contents
SHOW(ROW(Locator),COL(Locator),SUB(Location,1,COLS(Locator)))
EndBrowse PROCEDURE
CODE
LOOP WHILE RECORDS(Position) > Base !Delete all position
GET(Position,RECORDS(Position)) ! elements after the
DELETE(Position) ! base position
END !End LOOP
DELETE(Session) !Delete the current session
IF RECORDS(Session) !For any prior session
GET(Session,RECORDS(Session)) ! Get the session element
END !End IF
RETURN !Return to caller