High Voltage Shareware

home *** CD-ROM | disk | FTP | other *** search

/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.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