home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / clarion / toolbo01.cla < prev    next >
Encoding:
Text File  |  1993-06-01  |  46.6 KB  |  854 lines
  1.                 MEMBER('TOOLBOX')
  2. OMIT('╝')
  3. ╔════════════════════════════════════════════════════════════════════════════╗
  4. ║   TOOLBO01.CLA - Internal Source Module        !                           ║
  5. ╚════════════════════════════════════════════════════════════════════════════╝
  6.  
  7. OMIT('╝')
  8. ╔════════════════════════════════════════════════════════════════════════════╗
  9. ║ HauptMenu - Hauptmenü                          !Generated Procedure        ║
  10. ╚════════════════════════════════════════════════════════════════════════════╝
  11.  
  12. HauptMenu      PROCEDURE
  13.  
  14.  
  15. PDown    PULLDOWN,COLOR(49,7,56,49,14),HALF(120)
  16.           MENU('Stammdaten'),COLOR(112,7,120,126,14)
  17.             ITEM('Bildschirmanzeige'),USE(?ZeigTxInhalt)
  18.             ITEM('Ausdruck'),USE(?Ausdruck)
  19.             ITEM('Index neu aufbauen'),USE(?Index_neu_aufba)
  20.             ITEM('-')
  21.             ITEM('Ende'),USE(?Ende),KEY(AltX)
  22.           .
  23.         .
  24.  
  25.   CODE
  26.   OPEN(PDown)                                    !Open the pulldown menu
  27.   LOOP
  28.     DISABLE(1,FIELDS())                          !Disable any open screen
  29.     ACCEPT                                       !Enable mouse and keyboard
  30.     ENABLE(1,FIELDS())                           !Restore any open screen
  31.     CLOSE(PDown)                                 !Close the pulldown menu
  32.     CASE KEYCODE()
  33.     END
  34.     CASE FIELD()                                 !Jump to selected item
  35.     OF ?ZeigTxInhalt                             !For a Pulldown field
  36.       ZeigTxInhalt                               !  execute its procedure
  37.     OF ?Ausdruck                                 !For a Pulldown field
  38.       DruckTxInhalt                              !  execute its procedure
  39.     OF ?Index_neu_aufba                          !For a Pulldown field
  40.       BuildKeys                                  !  execute its procedure
  41.     OF ?Ende                                     !For a Pulldown field
  42.       EMBED('~~HauptMenu~2~1~3~~')
  43.       RETURN
  44.        
  45.       END                                        !  execute its procedure
  46.     END                                          !End CASE
  47.     OPEN(PDown)                                  !Reopen the pulldown menu
  48.   END                                            !End LOOP
  49. OMIT('╝')
  50. ╔════════════════════════════════════════════════════════════════════════════╗
  51. ║ BearbeiteTxInhalt - Eingabemaske für Toolbox-Inhalt !Generated Procedure        ║
  52. ╚════════════════════════════════════════════════════════════════════════════╝
  53. BearbeiteTxInhalt      PROCEDURE
  54.  
  55. LOC:Message      STRING(30)
  56. Action           BYTE
  57. NoMoreFields     BYTE(0)                         !No more fields flag
  58. SCREEN           SCREEN(18,76),PRE(SCR),CENTER,SHADOW,FALL,CUA,COLOR(112)
  59.                    !dimensions=25,80,25,80
  60.                    ROW(1,49)   PAINT(1,1),COLOR(17)
  61.                    ROW(1,1)    STRING('█{27}'),COLOR(113)
  62.                      COL(28)   STRING('Bearbeitung Datensatz'),COLOR(31)
  63.                      COL(50)   STRING('█{27}'),COLOR(113)
  64.                    ROW(18,1)   STRING('█▄{74}█'),COLOR(113)
  65.                                REPEAT(16)
  66.                    ROW(2,1)      STRING('█'),COLOR(113)
  67.                    ROW(2,76)     STRING('█'),COLOR(113)
  68.                                .
  69.                    ROW(2,24)   ENTRY(@s30),USE(LOC:Message),SKIP,COLOR(126,7,120)
  70.                    ROW(4,3)    PROMPT('Toolbox&index:'),COLOR(112,79,56,126,78)
  71.                      COL(17)   ENTRY(@s14),USE(TxI:TxIndex),OVR,COLOR(48,79,56)
  72.                    ROW(5,10)   PROMPT('Titel:'),COLOR(112,79,56,126,78)
  73.                      COL(17)   ENTRY(@s58),USE(TxI:Titel),OVR,COLOR(48,79,56)
  74.                    ROW(6,5)    PROMPT('Untertitel:'),COLOR(112,79,56,126,78)
  75.                      COL(17)   ENTRY(@s58),USE(TxI:UTitel),OVR,COLOR(48,79,56)
  76.                    ROW(7,9)    PROMPT('Rubrik:'),COLOR(112,79,56,126,78)
  77.                      COL(17)   ENTRY(@s30),USE(TxI:Rubrik),OVR,COLOR(48,79,56)
  78.                    ROW(8,8)    PROMPT('Ausgabe:'),COLOR(112,79,56,126,78)
  79.                      COL(17)   ENTRY(@s10),USE(TxI:Ausgabe),OVR,COLOR(48,79,56)
  80.                    ROW(9,10)   PROMPT('Seite:'),COLOR(112,79,56,126,78)
  81.                      COL(17)   ENTRY(@s3),USE(TxI:Seite),OVR,COLOR(48,79,56)
  82.                    ROW(10,11)  PROMPT('Name:'),COLOR(112,79,56,126,78)
  83.                      COL(17)   ENTRY(@s30),USE(TxI:Name),OVR,COLOR(48,79,56)
  84.                    ROW(11,8)   PROMPT('Vorname:'),COLOR(112,79,56,126,78)
  85.                      COL(17)   ENTRY(@s30),USE(TxI:Vorname),OVR,COLOR(48,79,56)
  86.                    ROW(12,8)   PROMPT('S&prache:'),COLOR(112,79,56,126,78)
  87.                      COL(17)   ENTRY(@s30),USE(TxI:Sprache),OVR,COLOR(48,79,56)
  88.                    ROW(13,10)  PROMPT('T&hema:'),COLOR(112,79,56,126,78)
  89.                      COL(17)   ENTRY(@s30),USE(TxI:Thema),OVR,COLOR(48,79,56)
  90.                    ROW(14,6)   PROMPT('Bemerkung:'),COLOR(112,79,56,126,78)
  91.                      COL(17)   ENTRY(@s58),USE(TxI:Bemerkung),OVR,COLOR(48,79,56)
  92.                    ROW(16,23)  BUTTON('  &Ok  |'),SHADOW,KEY(EnterKey),USE(?Ok),REQ,COLOR(23,71,24,31,79)
  93.                      COL(43)   BUTTON('  &Abbruch  '),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(23,71,24,31,79)
  94.                  .
  95.  
  96. RecordQueue   QUEUE,PRE(SAV)                     !Queue for concurrency checking
  97. SaveRecord    LIKE(TxI:Record),PRE(SAV)          !size of primary file record
  98.               .                                  !End Queue structure
  99. SavePointer   STRING(10)                         !Position of current record
  100. AutoAddPtr    STRING(10)                         !Position of autoinc record
  101. AutoIncAdd    BYTE(0)                            !On for Autoincrement add
  102. LastPosition  STRING(10)                         !Position of last ADD
  103.  
  104.   CODE
  105.  
  106.   CheckOpen(TxInhalt)                            !Ensure Primary file is OPEN
  107.   CASE KEYCODE()                                 !What Key was pressed?
  108.     OF InsKey                                    !Insert a new record
  109.  
  110.       Action = AddRecord                         !Set action code 1 (ADD)
  111.       LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message)) !Assign ADD message
  112.       CLEAR(TxI:Record)                          !CLEAR Record buffer
  113.  
  114.     OF EnterKey                                  !Process a CHANGE request
  115.     OROF MouseLeft2                              !on EnterKey or double mouse
  116.  
  117.       Action = ChangeRecord                      !Set action code 2 (CHANGE)
  118.       LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message)) !Assign CHANGE message
  119.       DO InitializeQueue                         !Save record to QUEUE
  120.       SavePointer = POSITION(TxInhalt)           !Save the record position
  121.  
  122.     OF DelKey                                    !Process a DELETE request
  123.  
  124.       Action = DeleteRecord                      !Set action code 3 (DELETE)
  125.       LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message)) !Assign DELETE message
  126.       SavePointer = POSITION(TxInhalt)           !Position in PRIMARY file
  127.  
  128.   END                                            !End CASE Keycode
  129.  
  130.   OPEN(Screen)                                   !Open the FORM screen
  131.   DISPLAY                                        !Display screen fields
  132.   IF Action = DeleteRecord                       !IF request for DELETE
  133.     DISABLE(1,FIELDS())                          !Disable all screen fields
  134.     ENABLE(?OK)                                  !Enable the OK and the
  135.     ENABLE(?Cancel)                              !Cancel buttons
  136.   END                                            !End IF request for delete
  137.  
  138.   LOOP                                           !Begin Main process loop
  139.  
  140.     CASE SELECTED()                              !Process selected Field
  141.       OF NoMoreFields                            !User pressed Enter or OK
  142.         CASE Action                              !Process requested Action
  143.           OF AddRecord                           !Action = 1 (ADD)
  144.  
  145.             ADD(TxInhalt)                        !Add Record to Primary file
  146.             LastPosition = POSITION(TxInhalt)
  147.  
  148.           OF ChangeRecord                        !Action = 2 (Change)
  149.  
  150.               DO ConcurrentWrite                 !Concurrent update ROUTINE
  151.               IF AbortWrite#                     !AbortWrite is on
  152.                 CYCLE                            !Let user choose response
  153.               END                                !End AbortWrite#
  154.               PUT(TxInhalt)                      !Write the Record
  155.  
  156.           OF DeleteRecord                        !Action = 3 (Delete)
  157.  
  158.             DO ConcurrentDelete                  !Concurrent update ROUTINE
  159.             IF AbortDelete#                      !AbortWrite is on
  160.               CYCLE                              !Restart main Loop
  161.             ELSE                                 !Its OK to Delete
  162.               DELETE(TxInhalt)                   !Delete this record
  163.             END                                  !End AbortWrite#
  164.         END                                      !End CASE Action
  165.  
  166.       IF ERRORCODE()                             !Error check on File I/O
  167.         IF ERRORCODE() = DupKeyErr               ! Duplicate key detected
  168.           IF DUPLICATE(TxI:TxIndexKey)           !check unique keys
  169.             GLO:Message3 = '[ '
  170.             GLO:Message3 = Clip(GLO:Message3) & (' TxI:TxIndex ')
  171.             GLO:Message3 = Clip(GLO:Message3)&' ]'
  172.           END
  173.           GLO:Message1 = 'This record creates a duplicate key entry'
  174.           GLO:Message2 = 'The unique key field(s) are listed below: '
  175.           ShowWarning                            !inform the user
  176.           SELECT(1)                              !select first field
  177.           DISPLAY                                !re-display the screen
  178.           CYCLE                                  !back to main loop
  179.         END                                      !End IF Duplicate errorcode
  180.         CASE Action                              !Error message based on Action
  181.           OF AddRecord
  182.             GLO:Message1 = 'Error attempting to ADD Record'
  183.           OF ChangeRecord
  184.             GLO:Message1 = 'Error attempting to CHANGE Record'
  185.           OF DeleteRecord
  186.             GLO:Message1 = 'Error attempting to DELETE Record'
  187.         END                                      !End CASE Action
  188.         GLO:Message2 = 'The file: TxInhalt could not be updated'
  189.         GLO:Message3 = 'Code:'&Errorcode()&': '&Error()
  190.         ShowWarning                              !Notify the user
  191.         RELEASE(TxInhalt)                        !Release the held record
  192.         FREE(RecordQueue)                        !FREE the memory Queue
  193.         DISABLE(1,FIELDS())                      !Disable all the fields
  194.         ENABLE(?Cancel)                          !Enable Cancel button
  195.         SELECT(?Cancel)                          !and place cursor on Cancel
  196.         DISPLAY                                  !Re-display the screen
  197.         CYCLE                                    !Re-start main LOOP
  198.       ELSE                                       !Else no errorcode()
  199.         FREE(RecordQueue)                        !Free memory from Queue
  200.         IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd)
  201.           SELECT(1)                              !Place cursor on 1st field
  202.           CYCLE                                  !Re-start main LOOP
  203.         END                                      !End IF (Action = ....)
  204.         BREAK                                    !Break from main Loop
  205.       END                                        !End IF Errorcode()
  206.  
  207.     END                                          !End CASE Selected()
  208.  
  209.     ACCEPT                                       !Enable screen entry
  210.  
  211.     CASE FIELD()                                 !Process fields
  212.       OF ?Ok                                     !On the OK button
  213.  
  214.         SELECT(1)                                !Start with the first field
  215.         SELECT                                   !and cycle non-stop
  216.         CYCLE                                    !restart main process loop
  217.  
  218.       OF ?Cancel                                 !On Cancel button
  219.  
  220.         FREE(RecordQueue)                        !Free the memory Queue
  221.         RESET(TxInhalt,LastPosition)             !Position to record we added
  222.         NEXT(TxInhalt)                           !and re-read
  223.         BREAK                                    !Break from main LOOP
  224.     END                                          !End CASE FIELD
  225.  
  226.   END                                            !END MAIN PROCESS LOOP
  227.  
  228.  
  229. ConcurrentWrite ROUTINE
  230.  AbortWrite# = 0                                 !Initialize AbortWrite#
  231.  IF ~AutoIncAdd                                  !Not an Autoincrement ADD
  232.    Sav:SaveRecord = TxI:Record                   !Save Record to the Queue
  233.    ADD(RecordQueue,2)                            !Add the changed record
  234.    GET(RecordQueue,1)                            !Get the original record
  235.    RESET(TxInhalt,SavePointer)                   !Position to record on disk
  236.    HOLD(TxInhalt,2)                              !Set HOLD retry for 2 seconds
  237.    NEXT(TxInhalt)                                !Read the record into buffer
  238.    IF ERRORCODE()                                !Was there an error?
  239.      CASE ERRORCODE()                            !Process recoverable errors
  240.        OF IsHeldErr                              !Record is already held
  241.          GLO:Message1 = 'The Record is locked by another workstation '
  242.          GLO:Message2 = 'when you return to the entry FORM choose OK '
  243.          GLO:Message3 = 'to try the update again, or CANCEL to abort '
  244.          ShowWarning                             !Show user a warning
  245.          SELECT(1)                               !Place cursor on 1st field
  246.          RELEASE(TxInhalt)                       !Release the HOLD
  247.          AbortWrite# = 1                         !Turn on AbortWrite#
  248.          EXIT                                    !Back to main Loop
  249.        ELSE                                      !On any other error
  250.          IF DiskError('File Access Error')       !Call the Diskerror function
  251.            RELEASE(TxInhalt)                     !Release the hold
  252.            FREE(RecordQueue)                     !Free the memory Queue
  253.            DISABLE(1,FIELDS())                   !Disable all screen fields
  254.            ENABLE(?Cancel)                       !Enable the Cancel button
  255.            SELECT(?Cancel)                       !Place cursor on Cancel
  256.            AbortWrite# = 1                       !Turn on AbortWrite#
  257.            EXIT                                  !and exit the routine
  258.          END                                     !End IF Diskerror
  259.      END                                         !End CASE Errorcode()
  260.    ELSIF Sav:SaveRecord <> TxI:Record            !Has the record been changed
  261.      Sav:SaveRecord = TxI:Record                 !Then update the Queue record
  262.      PUT(RecordQueue)                            !Update the memory Queue
  263.      GLO:Message1 = 'The Record was changed by another station '
  264.      GLO:Message2 = 'your screen now reflects the changed data '
  265.      GLO:Message3 = 'OK button to continue, or CANCEL to abort '
  266.      ShowWarning                                 !Notify the user of changes
  267.      SELECT(1)                                   !Place cursor on 1st field
  268.      DISPLAY                                     !Update the screen
  269.      AbortWrite# = 1                             !Turn AbortWrite# ON
  270.      EXIT                                        !Exit the Routine
  271.    ELSE                                          !Its ok to update the file
  272.      GET(RecordQueue,2)                          !Retrieve the users changes
  273.      TxI:Record = Sav:SaveRecord                 !Move changes to record buffer
  274.    END                                           !End IF Errorcode()
  275.  END                                             !End IF ~AutoIncAdd
  276.  
  277.  
  278.  
  279. ConcurrentDelete ROUTINE
  280.   AbortDelete# = 0
  281.   RESET(TxInhalt,SavePointer)                    !Set position in Primary file
  282.   HOLD(TxInhalt,2)                               !Hold the record
  283.   NEXT(TxInhalt)                                 !Read the record into buffer
  284.   IF POSITION(TxInhalt) <> SavePointer           !Is the record already deleted?
  285.     RELEASE(TxInhalt)                            !Relase record Hold
  286.     FREE(RecordQueue)                            !Free the memory Queue
  287.     RETURN                                       !Return to the calling procedure
  288.   END                                            !End IF position check
  289.   IF ERRORCODE()                                 !Check for file access error
  290.     CASE ERRORCODE()                             !Case for recoverable errors
  291.       OF IsHeldErr                               !Record is already held
  292.         GLO:Message1 = 'The Record is locked by another workstation '
  293.         GLO:Message2 = 'when you return to the entry FORM choose OK '
  294.         GLO:Message3 = 'to try the update again, or CANCEL to abort '
  295.         ShowWarning                              !Notify the user
  296.         SELECT(1)                                !Place cursor on 1st field
  297.         RELEASE(TxInhalt)                        !Release HOLD request
  298.         AbortDelete# = 1                         !Set AbortDelete# ON
  299.         EXIT                                     !Re-start main LOOP
  300.       ELSE                                       !for any other error
  301.         IF DiskError('Unable to process current Record') !Call error function
  302.           GLO:Message2 = 'Unable to continue, Press OK to exit'
  303.           ShowWarning                            !Notify the user
  304.           FREE(RecordQueue)                      !Free the memory queue
  305.           RETURN                                 !Return to calling procedure
  306.         END                                      !End IF Diskerror
  307.     END                                          !End CASE errorcode
  308.   END                                            !End IF errorcode()
  309.  
  310. InitializeQueue ROUTINE                          !save initial record values
  311.   Sav:SaveRecord = TxI:Record                    !Save the current record
  312.   ADD(RecordQueue,1)                             !add record to Queue
  313.   ADD(RecordQueue,2)                             !add record again
  314.   IF ERRORCODE()                                 !check Queue add error
  315.     CASE ERRORCODE()
  316.       OF NoMemErr                                !Is there enough memory?
  317.       GLO:Message1 = 'Not Enough Memory to proceed'
  318.       GLO:Message2 = 'with this operation . . . . '
  319.       ShowWarning                                !Notify the user
  320.       DISABLE(1,FIELDS())                        !Disable the screen fields
  321.       ENABLE(?Cancel)                            !Enable the Cancel button
  322.       SELECT(?Cancel)                            !Place cursor on Cancel
  323.       DISPLAY                                    !Update screen display
  324.     ELSE                                         !On any other error
  325.       GLO:Message1 = ERRORCODE() & ' ' & ERROR()
  326.       GLO:Message2 = 'Unable to continue . . . .'
  327.       ShowWarning                                !Show user the error
  328.       DISABLE(1,FIELDS())                        !Disable screen fields
  329.       ENABLE(?Cancel)                            !Enable Cancel button
  330.       SELECT(?Cancel)                            !Place cursor on Cancel
  331.       DISPLAY                                    !re-display the screen
  332.     END                                          !End CASE Errorcode
  333.   END                                            !End IF Errorcode
  334. OMIT('╝')
  335. ╔════════════════════════════════════════════════════════════════════════════╗
  336. ║ BuildKeys -                                    !Generated Procedure        ║
  337. ╚════════════════════════════════════════════════════════════════════════════╝
  338. BuildKeys       PROCEDURE
  339.  
  340. SCREEN           SCREEN(5,30),PRE(SCR),CUA,COLOR(112)
  341.                    !dimensions=25,80,25,80
  342.                    ROW(1,1)    STRING('█{30}'),COLOR(113)
  343.                    ROW(3,4)    STRING('Index wird neu aufgebaut')
  344.                    ROW(5,1)    STRING('█▄{28}█'),COLOR(113)
  345.                                REPEAT(3)
  346.                    ROW(2,1)      STRING('█'),COLOR(113)
  347.                    ROW(2,30)     STRING('█'),COLOR(113)
  348.                                .
  349.                  .
  350.  
  351.  
  352.   CODE
  353.   OPEN(Screen)                                   !Open the screen
  354.   EMBED('~~BuildKeys~1~Setup Screen~3~~')
  355.   BUILD(TxInhalt)
  356.   RETURN
  357.    
  358.   END
  359.  
  360.   LOOP                                           !Loop through the fields
  361.     CASE SELECTED()                              !Jump to field setup routine
  362.     END                                          !End CASE
  363.     ACCEPT                                       !Enable the mouse and keyboard
  364.     CASE FIELD()                                 !Jump to field edit routine
  365.     END                                          !End CASE
  366.   END                                            !End LOOP
  367. OMIT('╝')
  368. ╔════════════════════════════════════════════════════════════════════════════╗
  369. ║ ZeigTxInhalt - Bildschirmübersicht Berichte    !Generated Procedure        ║
  370. ╚════════════════════════════════════════════════════════════════════════════╝
  371. ZeigTxInhalt       PROCEDURE
  372.  
  373.  
  374. Queue            QUEUE
  375.                    STRING(215)
  376.                  .
  377.  
  378.  
  379. SCREEN           SCREEN(25,80),PRE(SCR),CENTER,EXPAND(10),ZOOM,CUA,COLOR(112)
  380.                    !dimensions=25,80,25,80
  381.                    ROW(1,1)    STRING('█{24}'),COLOR(113)
  382.                      COL(56)   STRING('█{25}'),COLOR(113)
  383.                    ROW(25,1)   STRING('█▄{78}█'),COLOR(113)
  384.                                REPEAT(23)
  385.                    ROW(2,1)      STRING('█'),COLOR(113)
  386.                    ROW(2,80)     STRING('█'),COLOR(113)
  387.                                .
  388.                    ROW(1,25)   PROMPT('Toolbox Inhaltsverzeichnis 1992'),COLOR(31,31,31,31,31)
  389.                    ROW(4,4)    LIST(17,74),FROM(Queue),FIX(2),HVSCROLL,USE(?List),IMM,COLOR(48,15,120)
  390.                    ROW(23,4)   BUTTON('  &Neu  |'),SHADOW,USE(?Insert),COLOR(23,71,24,31,79)
  391.                      COL(14)   BUTTON('  &Bearbeiten  |'),SHADOW,USE(?Bearbeiten),COLOR(23,71,24,31,79)
  392.                      COL(31)   BUTTON('  &Löschen  |'),SHADOW,USE(?Delete),COLOR(23,71,24,31,79)
  393.                      COL(69)   BUTTON('  &Ende  |'),SHADOW,KEY(EscKey),USE(?Ende),COLOR(23,71,24,31,79)
  394.                  .
  395.  
  396.  
  397.   CODE
  398.   CheckOpen(TxInhalt)                            !Ensure TxInhalt file is open
  399.   FREE(Queue)                                    !Make sure Queue is empty
  400.   OPEN(Screen)                                   !Open the screen
  401.   DISPLAY                                        !Display innitialized fields
  402.   Queue = 'Thema' & |
  403.           ' {26}' & 'Rubrik' & |
  404.           ' {25}' & 'Name' & |
  405.           ' {27}' & 'Ausgabe' & |
  406.           '    ' & 'Seite Sprache' & |
  407.           ' {24}' & 'Bemerkung'                  !Add fixed listbox line
  408.   ADD(Queue)                                     ! to the Queue
  409.   Queue = '─{200}'                               !Add fixed listbox line
  410.   ADD(Queue)                                     ! to the Queue
  411.   BeginBrowse(?List)                               !Begin a browse session
  412.   LOOP                                           !Process browse requests
  413.     CASE BrowseAction(TxInhalt,TxI:TxIndexKey,Queue) !Browse the file
  414.  
  415.     OF FormatQueue                               !Format a queue element
  416.       Queue = FORMAT(TxI:Thema,@s30) & |
  417.               '│' & |
  418.               FORMAT(TxI:Rubrik,@s30) & |
  419.               '│' & |
  420.               FORMAT(TxI:Name,@s30) & |
  421.               '│' & |
  422.               FORMAT(TxI:Ausgabe,@s10) & |
  423.               '│' & |
  424.               '  ' & FORMAT(TxI:Seite,@s3) & |
  425.               '│' & |
  426.               FORMAT(TxI:Sprache,@s30) & |
  427.               '│' & |
  428.               FORMAT(TxI:Bemerkung,@s74)         !Format the listbox queue
  429.  
  430.     OF ProcessField                              !Process a field
  431.  
  432.       CASE KEYCODE()
  433.       END
  434.  
  435.       CASE FIELD()                               !Jump to edit routine
  436.       OF ?Insert                                 !Process the Insert Button
  437.         GET(TxInhalt,0)                          ! Dereference current record
  438.         SETKEYCODE(InsKey)                       ! Set action to Insert
  439.         BearbeiteTxInhalt                        ! Run the update procedure
  440.         SELECT(?List)                            ! Reselect the List field
  441.       OF ?Delete                                 !Process the Delete Button
  442.         SETKEYCODE(DelKey)                       ! Set action to Delete
  443.         BearbeiteTxInhalt                        ! Run the update procedure
  444.         SELECT(?List)                            ! Reselect the List field
  445.       OF ?List                                   !Process the list field
  446.         CASE KEYCODE()                           ! Jump to keycode routine
  447.         OF InsKey                                ! For the insert key
  448.           GET(TxInhalt,0)                        !  Dereference current record
  449.           BearbeiteTxInhalt                      !  Run the update procedure
  450.         OF   DelKey                              ! For the delete key
  451.           BearbeiteTxInhalt                      !  Run the update procedure
  452.         END                                      ! End CASE
  453.       OF ?Bearbeiten                             !Edit Procedure or source
  454.         BearbeiteTxInhalt                        ! for ?Bearbeiten
  455.       OF ?Ende                                   !Edit Procedure or source
  456.         EMBED('~~ZeigTxInhalt~4~5~3~~')
  457.         RETURN
  458.          
  459.         END                                      ! for ?Ende
  460.       END
  461.  
  462.     OF NoRecords                                 !No records to browse
  463.       IF RECORDS(TxInhalt)                       !If file is not empty
  464.         IF ?List <> 1                            !  And list is not first
  465.           SELECT(1)                              !    Select the first field
  466.         ELSE                                     !  End IF
  467.           SELECT(?Insert)                        ! Select the Insert Button
  468.         END                                      ! End IF
  469.       ELSE                                       !If file is empty
  470.         GET(TxInhalt,0)                          !  Dereference current record
  471.         SETKEYCODE(InsKey)                       !  Ask for a new record
  472.         BearbeiteTxInhalt                        !  Run the update procedure
  473.         IF POSITION(TxI:TxIndexKey) = ''         !  If record not added
  474.           BREAK                                  !   Return to caller
  475.         END                                      !  End IF
  476.       END                                        !End IF
  477.  
  478.     END                                          !End CASE
  479.   END                                            !End LOOP
  480.   EndBrowse                                      !End the browse session
  481.   FREE(Queue)                                    !Free the Queue memory
  482.  
  483.  
  484. OMIT('╝')
  485. ╔════════════════════════════════════════════════════════════════════════════╗
  486. ║ DruckTxInhalt -                                !Generated Procedure        ║
  487. ╚════════════════════════════════════════════════════════════════════════════╝
  488.  
  489. DruckTxInhalt       PROCEDURE
  490.  
  491. LineCounter      BYTE
  492. PageCounter      SHORT
  493. ReportDevice     STRING('LPT1 {25}')
  494.  
  495.  
  496. SCREEN           SCREEN(6,22),PRE(SCR),CENTER,SHADOW,ZOOM,CUA,COLOR(112)
  497.                    !dimensions=25,80,25,80
  498.                    ROW(1,1)    STRING('█▀{20}█'),COLOR(113)
  499.                    ROW(2,5)    STRING('Erzeuge Report'),COLOR(113)
  500.                    ROW(6,1)    STRING('█▄{20}█'),COLOR(113)
  501.                                REPEAT(4)
  502.                    ROW(2,1)      STRING('█'),COLOR(113)
  503.                    ROW(2,22)     STRING('█'),COLOR(113)
  504.                                .
  505.                    ROW(4,5)    PROMPT('Seite:'),COLOR(113,116,120,127,127)
  506.                      COL(11)   ENTRY(@n6),USE(PageCounter),SKIP,COLOR(126,7,120)
  507.                    ROW(5,5)    PROMPT('Zeile:'),COLOR(113,116,120,127,127)
  508.                      COL(14)   ENTRY(@n3),USE(LineCounter),SKIP,COLOR(126,7,120)
  509.                  .
  510.  
  511. REPORT           REPORT        LENGTH(66),WIDTH(80),PAGE(PageCounter),LINE(LineCounter),PRINTER('GENERIC PRINTER'),PRE(RPT),DEVICE(ReportDevice)
  512. PageHead                       HEADER
  513.                    ROW(1,1)      STRING('Toolbox-Inhalt bis 5/93 {38}Seite:')
  514.                    COL(69)       STRING(@n6),USE(PageCounter)
  515.                    ROW(2,1)      STRING('─{74}')
  516.                    ROW(3,1)      STRING('Toolbox-Index  Rubrik {25}Ausgabe    Seite')
  517.                    ROW(4,1)      STRING('Thema {26}Sprache')
  518.                    ROW(5,1)      STRING('Name {27}Vorname')
  519.                    ROW(6,1)
  520.                    ROW(7,1)      STRING('Titel')
  521.                    ROW(8,1)      STRING('Untertitel')
  522.                    ROW(9,1)      STRING('Bemerkung')
  523.                    ROW(10,1)     STRING('═{74}')
  524.                                .
  525. Detail                         DETAIL
  526.                    ROW(1,1)      STRING(14),USE(TxI:TxIndex)
  527.                    COL(16)       STRING(30),USE(TxI:Rubrik)
  528.                    COL(47)       STRING(10),USE(TxI:Ausgabe)
  529.                    COL(58)       STRING(3),USE(TxI:Seite)
  530.                    ROW(2,1)      STRING(30),USE(TxI:Thema)
  531.                    COL(32)       STRING(30),USE(TxI:Sprache)
  532.                    ROW(3,1)      STRING(30),USE(TxI:Name)
  533.                    COL(32)       STRING(30),USE(TxI:Vorname)
  534.                    SUPPRESS(3)
  535.                    ROW(4,1)
  536.                    ROW(5,1)      STRING(74),USE(TxI:Titel)
  537.                    ROW(6,1)      STRING(74),USE(TxI:UTitel)
  538.                    SUPPRESS(6)
  539.                    ROW(7,1)      STRING(74),USE(TxI:Bemerkung)
  540.                    SUPPRESS(7)
  541.                    ROW(8,1)      STRING('─{74}')
  542.                  .             .
  543.  
  544.  
  545.   CODE
  546.   CheckOpen(TxInhalt)                            !Ensure TxInhalt file is open
  547.   RedirectReport                                 !Call redirection procedure
  548.   CASE GLO:FileSpec                              !Detect redirection selection
  549.   OF 'CANCEL'                                    !Cancel report requested
  550.     RETURN
  551.   OF 'SCREEN'                                    !Screen view requested
  552.     Temp" = COMMAND('CLATMP',0)                  !Get temporary file directory
  553.     IF NOT Temp"                                 !None set?
  554.       Temp" = 'TempRpt.$$$'                      !Assign temporary filename
  555.     ELSIF SUB(CLIP(Temp"),-1,1) = '\'
  556.       Temp" = CLIP(Temp") & 'TempRpt.$$$'        !Assign temporary filename
  557.     ELSE
  558.       Temp" = CLIP(Temp") & '\' & 'TempRpt.$$$'  !Assign temporary filename
  559.     END
  560.     ReportDevice = Temp"
  561.     GLO:FileSpec = Temp"
  562.   ELSE                                           !All other report devices
  563.     ReportDevice = GLO:FileSpec                  ! go to the device
  564.     Temp" = SUB(LEFT(UPPER(GLO:FileSpec)),1,3)   !Get first three characters
  565.     IF (Temp" = 'LPT' OR Temp" = 'COM') AND NUMERIC(SUB(LEFT(GLO:FileSpec),4,1))
  566.       IF Temp" = 'LPT' and NOT STATUS(GLO:FileSpec) !Check printer status
  567.         GLO:Message1 = 'The Printer is Off-Line!'
  568.         GLO:Message2 = 'Please correct this situation'
  569.         ShowWarning                              !Notify the user if off-line
  570.         RETURN
  571.       END
  572.       GLO:FileSpec = ''                          !Disable viewing
  573.     END
  574.   END
  575.   OPEN(REPORT)                                   !Prepare to print report
  576.   SET(TxI:TxIndexKey)                            !Top of file, keyed order
  577.   OPEN(Screen)
  578.   LOOP                                           !Primary file process loop
  579.     NEXT(TxInhalt)                               !Get each TxInhalt record
  580.     IF ERRORCODE() THEN ErrEndFileFlag# = 1 ELSE ErrEndFileFlag# = 0. !Flag EOF
  581.     IF ErrEndFileFlag# THEN BREAK.               !End of file? Terminate report
  582.     
  583.     PRINT(RPT:Detail)                            !Print line item detail
  584.     DISPLAY                                      !Display report progress
  585.     
  586.     LOOP WHILE KEYBOARD()                        !If any keystrokes waiting
  587.       ASK                                        ! in the buffer, get them
  588.       IF KEYCODE() = EscKey                      !Detect the ESC key
  589.         CLOSE(REPORT)                            ! close the report
  590.         RETURN                                   ! and get out
  591.       END
  592.     END                                          !End abort key loop
  593.   END                                            !End TxInhalt file loop
  594.   CLOSE(REPORT)                                  !Close report
  595.   CLOSE(Screen)                                  !Close report progress screen
  596.   ViewReport                                     !Call View Procedure
  597.  
  598. OMIT('╝')
  599. ╔════════════════════════════════════════════════════════════════════════════╗
  600. ║ RedirectReport -                               !Generated Procedure        ║
  601. ╚════════════════════════════════════════════════════════════════════════════╝
  602. RedirectReport       PROCEDURE
  603.  
  604. Destination      STRING(6)
  605. FileName         STRING(64)
  606. SCREEN           SCREEN(12,48),PRE(SCR),CENTER,SHADOW,ZOOM,CUA,COLOR(112)
  607.                    !dimensions=25,80,25,80
  608.                    ROW(1,1)    STRING('█{48}'),COLOR(113)
  609.                    ROW(2,3)    STRING('┌─')
  610.                      COL(16)   STRING('─{30}┐')
  611.                    ROW(6,3)    STRING('└─{42}┘')
  612.                    ROW(12,1)   STRING('█▄{46}█'),COLOR(113)
  613.                                REPEAT(3)
  614.                    ROW(3,3)      STRING('│')
  615.                    ROW(3,46)     STRING('│')
  616.                                .
  617.                                REPEAT(10)
  618.                    ROW(2,1)      STRING('█'),COLOR(113)
  619.                    ROW(2,48)     STRING('█'),COLOR(113)
  620.                                .
  621.                    ROW(2,5)    PROMPT('Ausgabe an:'),COLOR(113,116,120,127,127)
  622.                                OPTION,USE(Destination)
  623.                    ROW(3,6)      RADIO('LPT1'),OVR,COLOR(113,126,120,126,127)
  624.                      COL(16)     RADIO('LPT2'),OVR,COLOR(113,126,120,126,127)
  625.                      COL(26)     RADIO('LPT3'),OVR,COLOR(113,126,120,126,127)
  626.                      COL(36)     RADIO('LPT4'),OVR,COLOR(113,126,120,126,127)
  627.                    ROW(4,6)      RADIO('COM1'),OVR,COLOR(113,126,120,126,127)
  628.                      COL(16)     RADIO('COM2'),OVR,COLOR(113,126,120,126,127)
  629.                      COL(26)     RADIO('COM3'),OVR,COLOR(113,126,120,126,127)
  630.                      COL(36)     RADIO('COM4'),OVR,COLOR(113,126,120,126,127)
  631.                    ROW(5,6)      RADIO('DATEI'),OVR,COLOR(113,126,120,126,127)
  632.                      COL(16)     RADIO('BILDSCHIRM'),OVR,COLOR(113,126,120,126,127)
  633.                                .
  634.                    ROW(8,4)    PROMPT('Dateiname:'),COLOR(113,116,120,127,127)
  635.                      COL(15)   ENTRY(@s31),USE(FileName),OVR,COLOR(126,7,120)
  636.                    ROW(10,13)  BUTTON('  &Ok  |'),SHADOW,KEY(EnterKey),USE(?Ok),COLOR(23,71,24,31,79)
  637.                      COL(26)   BUTTON('  &Abbruch  |'),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(23,71,24,31,79)
  638.                  .
  639.  
  640.   CODE
  641.   OPEN(Screen)
  642.   LOOP
  643.     ACCEPT                                       !Accept input
  644.  
  645.     CASE FIELD()
  646.     OF ?Destination
  647.       EMBED('~~RedirectReport~4~3~7~~')
  648.       IF Destination = 'FILE'
  649.         ENABLE(?FileName)
  650.         SELECT(?FileName)
  651.       ELSE
  652.         DISABLE(?FileName)
  653.         GLO:FileSpec = Destination
  654.       END
  655.       
  656.       END
  657.  
  658.     OF ?FileName
  659.       EMBED('~~RedirectReport~4~4~7~~')
  660.       GLO:FileSpec = FileName
  661.       END
  662.  
  663.     OF ?Ok
  664.       EMBED('~~RedirectReport~4~5~7~~')
  665.       RETURN
  666.       END
  667.  
  668.     OF ?Cancel
  669.       EMBED('~~RedirectReport~4~6~7~~')
  670.       GLO:FileSpec = 'CANCEL'
  671.       RETURN
  672.       END
  673.  
  674.     END
  675.   END
  676. OMIT('╝')
  677. ╔════════════════════════════════════════════════════════════════════════════╗
  678. ║ ViewReport -                                   !Generated Procedure        ║
  679. ╚════════════════════════════════════════════════════════════════════════════╝
  680.  
  681. ViewReport       PROCEDURE
  682.  
  683. ListQueue        QUEUE,PRE(QUE)
  684. QueueLine          STRING(255)
  685.                  .
  686. StatusLine       STRING(80)
  687. PrintDevice      STRING(4)
  688. SaveRows         BYTE                            !Initial screen rows
  689. SaveCols         BYTE                            !Initial screen columns
  690. FirstPage        BYTE
  691. RptFile          FILE,DRIVER('ASCII'),NAME(GLO:FileSpec),PRE(Dos) ! Declare Input File
  692.                    RECORD
  693. Fline                STRING(255)
  694.                  . .
  695.  
  696. REPORT           REPORT        LENGTH(59),WIDTH(80),PRINTER('GENERIC PRINTER'),PRE(RPT),DEVICE(PrintDevice)
  697. Detail                         DETAIL
  698.                    ROW(1,1)      STRING(80),USE(QUE:QueueLine)
  699.                                .
  700. PageFoot                       FOOTER
  701.                    ROW(1,1)
  702.                    COL(1)        CONTROL('FORMFEED')
  703.                  .             .
  704. SCREEN           SCREEN(25,80),PRE(SCR),AT(1,1),EXPAND(10),CUA,COLOR(113)
  705.                    !dimensions=25,80,25,80
  706.                    ROW(1,1)    LIST(22,80),FROM(QUE:QueueLine),HVSCROLL,USE(?List),IMM,COLOR(112,113,120)
  707.                    ROW(23,7)   PROMPT('Print to:'),COLOR(113,116,119,127,127)
  708.                                OPTION,USE(PrintDevice)
  709.                      COL(17)     RADIO('LPT1'),OVR,COLOR(113,126,119,126,127)
  710.                      COL(27)     RADIO('LPT2'),OVR,COLOR(113,126,119,126,127)
  711.                      COL(37)     RADIO('LPT3'),OVR,COLOR(113,126,119,126,127)
  712.                      COL(47)     RADIO('LPT4'),OVR,COLOR(113,126,119,126,127)
  713.                      COL(57)     RADIO('COM1'),OVR,COLOR(113,126,119,126,127)
  714.                      COL(67)     RADIO('COM2'),OVR,COLOR(113,126,119,126,127)
  715.                                .
  716.                      COL(1)    ENTRY(@s80),USE(StatusLine),SKIP,COLOR(126,7,119)
  717.                    ROW(24,4)   BUTTON(' 25/50 &Modus |'),SHADOW,USE(?ChangeMode),COLOR(23,71,24,31,79)
  718.                      COL(37)   BUTTON(' &Drucken '),SHADOW,USE(?Print),COLOR(23,71,24,31,79)
  719.                      COL(70)   BUTTON(' E&nde |'),SHADOW,KEY(EscKey),USE(?Exit),COLOR(23,71,24,31,79)
  720.                  .
  721.  
  722. VEW::Length      BYTE                            ! Progress variable
  723. VEW::ProgString  STRING('{50}')                 ! Progress display variable
  724.  
  725.   CODE
  726.   IF NOT GLO:FileSpec THEN RETURN.               !If GLO:FileSpec is blank
  727.   OPEN(RptFile)                                  !Open the Dos File
  728.   IF DiskError('Cannot Locate Selected File') THEN RETURN.
  729.   IF Bytes(RptFile) > (150 * 1024)               ! If oversized file
  730.     GLO:Message1 = 'This is a large file and may take a while'
  731.     GLO:Message2 = 'to load.  You may press the Esc key'
  732.     GLO:Message3 = 'while the file is loading to exit.'
  733.     ShowWarning                                  ! Show a warning screen
  734.   END                                            !End IF
  735.   OPEN(Screen)                                   !Open the Screen
  736.   DISABLE(?PrintDevice)                          !Disable the device field
  737.   SaveRows = Rows(SCREEN)                        !Save the Screen Rows
  738.   SaveCols = Cols(SCREEN)                        !Save the Screen Columns
  739.   FirstPage = 1                                  !Set flag for Page 1
  740.   SET(RptFile)                                   !Set to the file
  741.   LOOP                                           !Loop through the dos file
  742.     NEXT(RptFile)                                ! Get the next record
  743.     IF ERRORCODE() THEN BREAK.                   !
  744.     IF Bytes(RptFile) > 150          ! Line is longer than allowed
  745.       GLO:Message1 = 'The line length is greater than 150.'
  746.       GLO:Message2 = 'The selected file is not an ASCII file.'
  747.       GLO:Message3 = 'No view on this file is available.'
  748.       ShowWarning                                ! Show an error message
  749.       FREE(ListQueue)                            ! Free memory table
  750.       CLOSE(RptFile)                             ! Close the DOS file
  751.       CLOSE(SCREEN)                              ! Close the Screen
  752.       RETURN                                     ! Return back to caller
  753.     END                                          !End IF
  754.     IF NOT (((POINTER(RptFile)+100)%100))           !Show the progess indicator
  755.       VEW::Length += 1
  756.       StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length)
  757.       IF VEW::Length = 50
  758.         VEW::Length = 1
  759.         StatusLine = ' Reading File: ' & ' {70}'
  760.       END
  761.       Display(?StatusLine)
  762.     END
  763.     Que:QueueLine = Dos:Fline                    ! Fill the queue line.
  764.     ADD(ListQueue)                               ! Add to the queue
  765.     IF ERRORCODE()                               ! If out of memory
  766.       GLO:Message1 = 'Error: ' & ERROR()         !
  767.       GLO:Message2 = 'This file is too large to be read into memory.'
  768.       GLO:Message3 = 'The entire file will not be displayed.'
  769.       ShowWarning                                !  Show an error message
  770.       BREAK                                      !  Break out of read loop
  771.     END                                          ! End IF
  772.  
  773.     IF FirstPage                                 ! If page 1
  774.       IF RECORDS(ListQueue) = ROWS(SCREEN)       !  If we have a full screen
  775.         FirstPage = 0                            !   turn off the page flag
  776.         DISPLAY                                  !   and display page 1
  777.       END                                        !  End IF
  778.     END                                          ! End IF
  779.     LOOP WHILE KEYBOARD()                        ! While Keyboard Input
  780.       SELECT(?List)                              !  Select the List box
  781.       ACCEPT                                     !  Handle internal keystrokes
  782.     END                                          ! End LOOP
  783.     IF KEYCODE() = EscKey THEN BREAK.
  784.   END                                            !End LOOP
  785.   StatusLine = 'Viewing: ' & GLO:FileSpec        ! fill the statusline
  786.   DISPLAY                                        !Display the screen
  787.   LOOP                                           !Process the screen
  788.     ACCEPT                                       !Accept input
  789.     CASE FIELD()                                 !Which field was completed
  790.     OF ?PrintDevice                              !Selected a port for printer
  791.                                                  ! Insert Edit Routine
  792.       DISABLE(?PrintDevice)                      !  Disable the PrintDevice
  793.       ENABLE(?StatusLine)                        !  Enable the StatusLine
  794.       SELECT(?Print)                             !  Select the Print button
  795.       PRESS(EnterKey)                            !  And complete it.
  796.     OF ?ChangeMode                               !Completed mode button
  797.       IF ROWS(SCREEN) = 25                       ! If in 25 line mode
  798.         CLOSE(SCREEN)                            !  Close the current screen
  799.         SETTEXT(50,80)                           !  Set to 50 line mode
  800.       ELSE                                       ! Else in 43 or 50 line mode
  801.         CLOSE(SCREEN)                            !  Close the current screen
  802.         SETTEXT(25,80)                           !  Set to 25 line mode
  803.         SETAREA(25,80)                           !  Resize the screen area
  804.         LOADSYMBOLS                              !  Reload graphic mouse
  805.       END                                        ! End IF
  806.       OPEN(SCREEN)                               !  Open screen in new mode
  807.       DISABLE(?PrintDevice)                      !  Disable the device field
  808.       DISPLAY                                    !  Display the fields
  809.                                                  ! Insert Edit Routine
  810.     OF ?Print                                    !Completed Print Button
  811.                                                  ! Insert Edit Routine
  812.       IF NOT PrintDevice                         ! If no print device selected
  813.         DISABLE(?StatusLine)                     !  Disable the StatusLine
  814.         ENABLE(?PrintDevice)                     !  Enable the PrintDevice
  815.         SELECT(?PrintDevice)                     !  Select the PrintDevice
  816.         CYCLE                                    !  Cycle to accept input
  817.       END                                        ! End IF
  818.       IF NOT STATUS(PrintDevice)                 ! Check PrintDevice status
  819.         GLO:Message1 = CLIP(PrintDevice) & ' is not ready.'
  820.         GLO:Message2 = 'Be sure the Printer is online and attached to'
  821.         GLO:Message3 = 'the specified device and try again.'
  822.         ShowWarning                              !  Show an error message
  823.         PrintDevice = ''                         !  Clear the PrintDevice
  824.         CYCLE                                    !  Cycle to accept input
  825.       END                                        ! End IF
  826.       OPEN(REPORT)                               ! Open the report to print
  827.       LOOP I# = 1 to RECORDS(ListQueue)          ! Loop while QUEUE records
  828.         GET(ListQueue,I#)                        !  Get the line
  829.         IF ERRORCODE() THEN BREAK.               !  Break if an error occurs
  830.         PRINT(RPT:Detail)                        !  Print the line
  831.         IF KEYBOARD()                            !  If keyboard input
  832.           ACCEPT                                 !   Get the keystroke
  833.           IF KEYCODE() = EscKey                  !   If the ESCAPE key
  834.             BREAK                                !    Break from printing
  835.           END                                    !   End IF
  836.         END                                      !  End IF
  837.       END                                        ! End LOOP
  838.       CLOSE(REPORT)                              ! Close the report
  839.       PrintDevice = ''                           ! Clear the printer variable
  840.     OF ?Exit                                     !Completed Exit Button
  841.                                                  ! Insert Edit Routine
  842.       BREAK                                      ! Break out of the loop
  843.     END                                          ! End CASE FIELD()
  844.   END                                            !End LOOP
  845.   FREE(ListQueue)                                !Free memory table
  846.   CLOSE(RptFile)                                 !Close the DOS file
  847.   CLOSE(SCREEN)                                  !Close the Screen
  848.   IF Rows(SCREEN) <> SaveRows |                  !If the mode is not the same
  849.       OR SaveCols <> Cols(SCREEN)                !as when we entered
  850.     SETTEXT(SaveRows,SaveCols)                   ! Reset to the entry mode
  851.     SETAREA(SaveRows,SaveCols)                   ! Resize the screen area
  852.     LOADSYMBOLS                                  ! Reload graphic mouse
  853.   END                                            !End IF
  854.