home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR2 / CLATPL.ZIP / CLARION8.TPX < prev    next >
Text File  |  1993-07-26  |  29KB  |  591 lines
  1. #!-------------------------------------------------------------------------------#!
  2. #!      CLARION8.TPX
  3. #!
  4. #!      File      Select a file from a directory listing
  5. #!      Redirect  Select destination for a report
  6. #!      View      View a selected text file in a listbox
  7. #!
  8. #!------------------------------------------------------------------------------
  9. #!
  10. #!                           The File Template
  11. #!
  12. #!  The File template creates a procedure to allow a user to select a file.
  13. #!  The file name with its full path will be saved in the variable entered
  14. #!  at the 'Filename Variable' prompt.  If this field is left blank the
  15. #!  default of GLO:Filespec is used.  (GLO:Filespec has been entered in
  16. #!  Clarion's Default Application file for your convenience.  It will be
  17. #!  Smart-linked out of your final .EXE if not used.)
  18. #!
  19. #!  If a Next Procedure is requested (ie: a procedure created with the View
  20. #!  template) it will be called just prior to returning to the calling
  21. #!  procedure.
  22. #!
  23. #!------------------------------------------------------------------------------
  24. #!
  25. #PROCEDURE(File,'Select a file from a directory listing'),SCREEN
  26. #!
  27. #!------------------------------------------------------------------------------
  28. #PROTOTYPE('')
  29. #MAP('GETDIR.INC')
  30. #DISPLAY(' ')
  31. #PROMPT('Filename &Variable',FIELD),%SaveFilenameVar
  32. #PROMPT('Initial Directory',@S30),%StartDir
  33. #PROMPT('Beginning File Mask',@S6),%StartMask
  34. #PROMPT('Next Procedure',PROCEDURE),%NextProcedure
  35. #PROMPT('Reselect Upon Return',CHECK),%AllowReselect
  36. #PROMPT('Blank Name On Cancel',CHECK),%ClearOnCancel
  37.  
  38. #INSERT(%StandardHeader)
  39. #INSERT(%SetFileSymbols)
  40. #INSERT(%SetFileErrors)
  41.  
  42. %Procedure       PROCEDURE
  43.  
  44. %LocalData
  45. %ScreenStructure
  46.  
  47. DirString   CSTRING(64)                          !Used for Directory to search
  48. SaveDir     LIKE(DirString)                      !Used to hold beginning path
  49.  
  50. DirInfo       GROUP                              !Necessary DOS file group
  51.                BYTE,DIM(21)                      ! Used by findfirst
  52. Attrib         BYTE                              ! Attribute in DOS format
  53. DosTime        SHORT                             ! Time in DOS format
  54. DosDate        SHORT                             ! Date in DOS format
  55. Filesize       LONG                              ! Size in BYTES
  56. FileName       CSTRING(13)                       ! File name
  57.              .                                   !End GROUP
  58.  
  59. #EMBED('Data Section')
  60.  
  61.   CODE
  62.   #EMBED('Setup Procedure')
  63.   OPEN(Screen)                                   !Open the screen
  64.   #EMBED('Setup Screen')
  65.   #IF(%StartMask)
  66.   FileMask = '%StartMask'                      #<!Set the begining file mask
  67.   #ELSE
  68.   FileMask = '*.*'                               !Set the begining file mask
  69.   #ENDIF
  70.   SaveDir = PATH()                               !Save the Starting Directory
  71.   IF LEN(CLIP(SaveDir)) <> 3                     !If not in the root directory
  72.     SaveDir = CLIP(SaveDir) & '\'                ! Add the trailing '\'
  73.   END                                            !End IF
  74.   #IF(%StartDir)
  75.   Directory = UPPER(%StartDir)                 #<!Change to the requested
  76.   SETPATH(Directory)                             ! Starting directory
  77.   Directory = PATH()                             ! Reread the current path
  78.   IF LEN(CLIP(Directory)) <> 3                   !If not in the root directory
  79.     Directory = CLIP(Directory) & '\'            ! Add the trailing '\'
  80.   END                                            !End IF
  81.   #ELSE
  82.   Directory = SaveDir                            !Set to the Current Directory
  83.   #ENDIF
  84.   DO FillQueues                                  !Fill the screen queues
  85.   LOOP                                           !Main ACCEPT loop
  86.     #INSERT(%GenerateFormulas)
  87.     #EMBED('Top of Accept Loop')
  88.     CASE SELECTED()                            #<! Jump to field setup routine
  89.     #INSERT(%ScreenSetupRoutines)
  90.     END                                        #<! End CASE
  91.     ACCEPT                                       ! ACCEPT keyboard input
  92.     #INSERT(%HotKeyRoutines)
  93.     CASE FIELD()                                 ! Jump to field edit routine
  94.   #FOR(%ScreenField)
  95.     #IF(%ScreenField = '?FileMask')
  96.  
  97.     OF ?FileMask                                 ! Completed file mask field
  98.     #IF(%ScreenFieldEdit)
  99.       %ScreenFieldEdit                         #<!  File mask edit routine
  100.     #ENDIF
  101.       IF REFER()                                 !  If something was entered
  102.         Do FillQueues                            !   Fill queues with new mask
  103.       END                                        !  End IF
  104.     #ELSIF(%ScreenField = '?FileList')
  105.  
  106.     OF ?FileList                                 ! FileList field edit
  107.       GET(FileQueue,CHOICE())                    !  Get selected file entry
  108.   #IF(%ScreenFieldEdit)
  109.       %ScreenFieldEdit                         #<!  File list edit routine
  110.   #ENDIF
  111.       IF KEYCODE() = MouseLeft2 OR |             !  On mouse double click
  112.          KEYCODE() = EnterKey                    !    Or the Enter Key
  113.         SELECT(?OK)                              !   Select the OK button and
  114.         PRESS(EnterKey)                          !   Press Enter to complete
  115.       END                                        !  End IF
  116.     #ELSIF(%ScreenField = '?DirList')
  117.  
  118.     OF ?DirList                                  ! Directory list field edit
  119.     #IF(%ScreenFieldEdit)
  120.       %ScreenFieldEdit                         #<!  Directory edit routine
  121.     #ENDIF
  122.       IF SELECTED() = ?DirList                   !  If staying on this field
  123.         IF KEYCODE() = MouseLeft2 OR |           !   On mouse double click
  124.            KEYCODE() = EnterKey                  !     or the Enter Key
  125.           GET(DirQueue,CHOICE())                 !    Get the selected entry
  126.           Directory = CLIP(Directory) & DirLine  !    Create a new directory
  127.           SETPATH(Directory)                     !    Set to the directory
  128.           Directory = PATH()                     !     Reread the directory
  129.           IF LEN(CLIP(Directory)) <> 3           !    If not in the Root
  130.             Directory = CLIP(Directory) & '\'    !     add the trailing \
  131.           END                                    !    End IF
  132.           Do FillQueues                          !    Fill the screen queues
  133.           SELECT(?FileList,1)                    !    Reset file list box
  134.           SELECT(?DirList,1)                     !    Reset Dir List box
  135.         END                                      !   End IF
  136.       END                                        !  End IF
  137.     #ELSIF(UPPER(%ScreenField) = '?OK')
  138.  
  139.     OF ?Ok                                       ! Ok button field Edit
  140.   #IF(%ScreenFieldEdit)
  141.       %ScreenFieldEdit                         #<!  OK button edit routine
  142.   #ENDIF
  143.       IF FileLine = '  NO MATCH     '            !  If no FileName selected
  144.   #IF(%DirQueueExists)
  145.         SELECT(?DirList)                         !   Select directory list
  146.   #ELSE
  147.         SELECT(?Cancel)                          !   Select cancel button
  148.   #ENDIF
  149.         CYCLE                                    !   Cycle to ACCEPT.
  150.       END                                        !  End IF
  151.       %SaveFilenameVar = CLIP(Directory) & FileLine #<! Save the Filename
  152.   #IF(%NextProcedure)
  153.       SETPATH(SaveDir)                           !  Return to starting path
  154.     #IF(%DirQueueExists)
  155.       FREE(DirQueue)                             !  Free the DirQueue memory
  156.     #ENDIF
  157.       FREE(FileQueue)                            !  Free the FileQueue memory
  158.       %NextProcedure                           #<!  Call the Next procedure
  159.     #IF(%AllowReselect)
  160.       DO FillQueues                              !  Fill the screen queues
  161.       SELECT(?FileList)                          !  Select the file list
  162.       CYCLE                                      !  Return to ACCEPT input
  163.     #ENDIF
  164.   #ELSE
  165.       BREAK                                      !  Break out of screen LOOP
  166.   #ENDIF
  167.     #ELSIF(%ScreenField = '?Cancel')
  168.  
  169.     OF ?Cancel                                   ! Cancel button field Edit
  170.   #IF(%ScreenFieldEdit)
  171.       %ScreenFieldEdit                         #<!  Cancel button edit routine
  172.   #ENDIF
  173.       SETPATH(SaveDir)                           !  Return to starting path
  174.   #IF(%DirQueueExists)
  175.       FREE(DirQueue)                             !  Free the DirQueue memory
  176.   #ENDIF
  177.       FREE(FileQueue)                            !  Free the FileQueue memory
  178.   #IF(%ClearOnCancel)
  179.       CLEAR(%SaveFilenameVar)                  #<!  Clear the filename variable
  180.   #ENDIF
  181.       BREAK                                      !  Return to calling procedure
  182.     #ELSIF(%ScreenFieldEdit)
  183.  
  184.     OF %ScreenField                            #<! Completed %ScreenField
  185.       %ScreenFieldEdit                         #<!  %ScreenField edit routine
  186.     #ENDIF
  187.   #ENDFOR
  188.     #INSERT(%PulldownEditRoutines)
  189.     END                                          ! End CASE FIELD()
  190.   END                                            !End LOOP
  191.   SETPATH(SaveDir)                               !Return to starting path
  192.   #IF(%DirQueueExists)
  193.   FREE(DirQueue)                                 !Free the DirQueue memory
  194.   #ENDIF
  195.   FREE(FileQueue)                                !Free the FileQueue memory
  196. #EMBED('End of Procedure')
  197.  
  198.  
  199. FillQueues  ROUTINE
  200.  
  201.   FREE(FileQueue)                                !Free the FileQueue
  202. #IF(%DirQueueExists)
  203.   FREE(DirQueue)                                 !Free the DirQueue
  204.   DirString = CLIP(Directory) & '*.*'            !Set the subdirectory mask
  205.   IF NOT LEN(CLIP(DirString)) = 6                !If not in the root directory
  206.     DirLine = '..\'                              ! Make prior directory entry
  207.     ADD(DirQueue)                                ! Add to the DirQueue
  208.   END                                            !End IF
  209.   IF FindFirst(DirString,DirInfo,FA_DIREC) <> 0     !If unexpected error
  210.     FREE(DirQueue)                               ! Clear the DirQueue
  211.     FREE(FileQueue)                              ! Clear the FileQueue
  212.     RETURN                                       ! Return
  213.   END                                            !End IF
  214.   LOOP                                           !While entries found
  215.     IF FileName = '.' OR FileName = '..'         ! If the dot entries
  216.       IF FindNext(DirInfo) <> 0                   !  Get the next entry
  217.         BREAK                                    !   Break if unexpected error
  218.       END                                        !  End IF
  219.       CYCLE                                      !  Return to dot entry check
  220.     END                                          ! End IF
  221.     IF BAND(ATTRIB,10H)                          ! If a subdirectory is found
  222.       DirLine = FileName                         !  Fill the queue field
  223.       ADD(DirQueue)                              !  Add to the DirQueue
  224.       IF ERRORCODE() THEN BREAK.                 !  Break if unexpected error
  225.     END                                          ! End IF
  226.     IF FindNext(DirInfo) <> 0                     ! Get the next entry
  227.       BREAK                                      !  Break if unexpected error
  228.     END                                          ! End IF
  229.   END                                            !End LOOP
  230.   SORT(DirQueue,+DirLine)                        !Sort the directory listing
  231. #ENDIF
  232.   DirString=CLIP(Directory) & FileMask           !Set the file mask
  233.   IF FindFirst(DirString,DirInfo,FA_NORMAL) <> 0    !If no matching files found
  234.     FileLine = '  NO MATCH  '                    ! Fill queue with message
  235.     ADD(FileQueue)                               ! Add to the FileQueue
  236.   Else                                           !Else matching file found
  237.     LOOP                                         ! While entries are found
  238.       IF BAND(ATTRIB,10H) = 0                    !  If entry is a file
  239.         FileLine = FileName                      !   Fill the queue field and
  240.         ADD(FileQueue)                           !   Add to the FileQueue
  241.         IF ERRORCODE() THEN BREAK.               !   Break if unexpected error
  242.       END                                        !  End IF
  243.       IF FindNext(DirInfo) <> 0                   !  Get the next entry
  244.         BREAK                                    !   Break if unexpected error
  245.       END                                        !  End IF
  246.     END                                          ! End LOOP
  247.   END                                            !End IF
  248.   SORT(FileQueue,+FileLine)                      !Sort the file listing
  249.   DISPLAY                                        !Display the new lists
  250.  
  251. #!
  252. #!***************************************************************************
  253. #PROCEDURE(Redirect,'Select destination for a report'),SCREEN
  254. #!------------------------------------------------------------------------------
  255. #!
  256. #!                           The Redirect Template
  257. #!
  258. #!------------------------------------------------------------------------------
  259. #PROTOTYPE('')
  260. #INSERT(%StandardHeader)
  261. %Procedure       PROCEDURE
  262.  
  263. %LocalData
  264. %ScreenStructure
  265. #EMBED('Data Section')
  266.  
  267.   CODE
  268.   #EMBED('Setup Procedure')
  269.   OPEN(Screen)
  270.   #EMBED('Setup Screen')
  271.   LOOP
  272.     #INSERT(%GenerateFormulas)
  273.     #EMBED('Top of Accept Loop')
  274.   #FOR(%ScreenField)
  275.     #IF(%ScreenFieldSetup)
  276.     CASE SELECTED()                            #<!Jump to field setup routine
  277.     #INSERT(%ScreenSetupRoutines)
  278.     END                                        #<!End CASE
  279.     #ENDIF
  280.   #ENDFOR
  281.     ACCEPT                                       !Accept input
  282.     #INSERT(%HotKeyRoutines)
  283.     CASE FIELD()
  284.     #FOR(%ScreenField)
  285.     OF %ScreenField
  286.       %ScreenFieldEdit
  287.     #ENDFOR
  288.     END
  289.   END
  290. #EMBED('End of Procedure')
  291. #!
  292. #!
  293. #PROCEDURE(View,'View a selected text file in a listbox'),SCREEN,REPORT,PULLDOWN
  294. #!------------------------------------------------------------------------------
  295. #!
  296. #!                           The View Template
  297. #!
  298. #!------------------------------------------------------------------------------
  299. #PROTOTYPE('')
  300. #PROJECT('%clapfx%ASCII.LIB')
  301. #INSERT(%StandardHeader)
  302. #DISPLAY(' ')
  303. #PROMPT('File to &View',@s30),%ListFile
  304. #PROMPT('Warning Size (in K)',@s6),%FileWarningSize
  305. #PROMPT('Ma&ximum Line Length',@s6),%FileLineLength
  306. #PROMPT('Progress &Indicator',CHECK), %ShowProg
  307. #PROMPT('Progress Character',@S8),%ProgChar
  308. #!
  309. #IF(%ListFile = %Null)
  310.   #SET(%ListFile, 'GLO:FileSpec')
  311. #ENDIF
  312.  
  313. %Procedure       PROCEDURE
  314.  
  315. %LocalData
  316. SaveRows         BYTE                            !Initial screen rows
  317. SaveCols         BYTE                            !Initial screen columns
  318. FirstPage        BYTE                            !First page display flag
  319.  
  320. RptFile          FILE,DRIVER('ASCII'),NAME(%ListFile),PRE(Dos) #<! Declare Input File
  321.                    RECORD
  322. Fline                STRING(255)
  323.                  . .
  324.  
  325. SaveScreen       SCREEN(25,80).
  326. %ReportStructure
  327. %ScreenStructure
  328. %PulldownStructure
  329. #IF(%ShowProg)
  330. VEW::Length      BYTE                            !Progress variable
  331. VEW::ProgString  STRING('{50}')                 !Progress display variable
  332. #ENDIF
  333. #EMBED('Data Section')
  334.  
  335.   CODE
  336.   #EMBED('Setup Procedure')
  337.   #IF(%ProgChar)                                #!If showing the progress
  338.   VEW::ProgString = ALL(%ProgChar)             #<!Fill the progress string
  339.   #ENDIF
  340.   IF NOT %ListFile THEN RETURN.                #<!If %ListFile is blank
  341.   OPEN(RptFile)                                  !Open the Dos File
  342.   IF DiskError('Cannot Locate Selected File') THEN RETURN.
  343.   #IF(%FileWarningSize)
  344.   IF Bytes(RptFile) > (%FileWarningSize * 1024)#<!If oversized file
  345.     GLO:Message1 = 'This is a large file and may take a while'
  346.     GLO:Message2 = 'to load.  You may press the Esc key'
  347.     GLO:Message3 = 'while the file is loading to exit.'
  348.     ShowWarning                                  ! Show a warning screen
  349.   END                                            !End IF
  350.   #ENDIF
  351.   IF GRAPHIC(1) = 5Ah                            !If in text mode
  352.     OPEN(SaveScreen)                             ! Open a save screen
  353.   END                                            !End IF
  354.   OPEN(Screen)                                   !Open the Screen
  355.   IF GRAPHIC(1) <> 5Ah                           !If not in text mode
  356.     DISABLE(?ChangeMode)                         ! Disable changemode button
  357.   END                                            !End IF
  358.   DISABLE(?PrintDevice)                          !Disable the device field
  359.   #IF(%Pulldown)                                #!If a Pulldown exists
  360.   OPEN(%Pulldown)                              #<!Open the Pulldown
  361.   #ENDIF
  362.   SaveRows = Rows(SCREEN)                        !Save the Screen Rows
  363.   SaveCols = Cols(SCREEN)                        !Save the Screen Columns
  364.   #EMBED('Setup Screen')
  365.   FirstPage = 1                                  !Set flag for Page 1
  366.   SET(RptFile)                                   !Set to the file
  367.   LOOP                                           !Loop through the dos file
  368.     #INSERT(%GenerateFormulas)
  369.     #EMBED('Top of Accept Loop')
  370.     NEXT(RptFile)                                ! Get the next record
  371.     IF ERRORCODE() THEN BREAK.                   ! Break if error occurs
  372.   #IF(%FileLineLength)
  373.     IF Bytes(RptFile) > %FileLineLength          ! Line is longer than allowed
  374.       GLO:Message1 = 'The line length is greater than %FileLineLength.'
  375.   #ELSE
  376.     IF Bytes(RptFile) > 255                      ! Line is longer than allowed
  377.       GLO:Message1 = 'The line length is greater than 255.'
  378.   #ENDIF
  379.       GLO:Message2 = 'The selected file is not an ASCII file.'
  380.       GLO:Message3 = 'No view on this file is available.'
  381.       ShowWarning                                ! Show an error message
  382.       FREE(ListQueue)                            ! Free memory table
  383.       CLOSE(RptFile)                             ! Close the DOS file
  384.   #IF(%Pulldown)                                #!If a Pulldown exists
  385.       CLOSE(%Pulldown)                         #<! Close the Pulldown
  386.   #ENDIF
  387.       CLOSE(SCREEN)                              ! Close the Screen
  388.       #EMBED('Immediately before RETURN for non-ASCII file error')
  389.       RETURN                                     ! Return back to caller
  390.     END                                          !End IF
  391.   #IF(%ShowProg)                                #!If showing the progress
  392.     #INSERT(%ShowProgress)
  393.   #ENDIF
  394.     #EMBED('After NEXT in RptFile LOOP')
  395.     Que:QueueLine = Dos:Fline                    ! Fill the queue line.
  396.     ADD(ListQueue)                               ! Add to the queue
  397.     IF ERRORCODE()                               ! If out of memory
  398.       GLO:Message1 = 'Error: ' & ERROR()         ! Create the error message
  399.       GLO:Message2 = 'This file is too large to be read into memory.'
  400.       GLO:Message3 = 'The entire file will not be displayed.'
  401.       ShowWarning                                !  Show the error message
  402.       BREAK                                      !  Break out of read loop
  403.     END                                          ! End IF
  404.  
  405.     IF FirstPage                                 ! If page 1
  406.       IF RECORDS(ListQueue) = ROWS(SCREEN)       !  If we have a full screen
  407.         FirstPage = 0                            !   Turn off the page flag
  408.         DISPLAY(?List)                           !   Display page 1
  409.       END                                        !  End IF
  410.     END                                          ! End IF
  411.     LOOP WHILE KEYBOARD()                        ! While Keyboard Input
  412.       SELECT(?List)                              !  Select the List box
  413.       ACCEPT                                     !  Handle internal keystrokes
  414.     END                                          ! End LOOP
  415.     IF KEYCODE() = EscKey THEN BREAK.
  416.   END                                            !End LOOP
  417.   StatusLine = 'Viewing: ' & %ListFile         #<!Fill the status line
  418.   DISPLAY                                        !Redisplay the screen
  419.   PrintDevice = ''                               !Blank the PrintDevice field
  420.   LOOP                                           !Process the screen
  421.   #FOR(%ScreenField)
  422.     #IF(%ScreenFieldSetup)
  423.     CASE SELECTED()                            #<! Jump to field setup routine
  424.     #INSERT(%ScreenSetupRoutines)
  425.     END                                        #<! End CASE
  426.     #ENDIF
  427.   #ENDFOR
  428.     ACCEPT                                       ! Accept keyboard input
  429.     #INSERT(%HotKeyRoutines)
  430.     CASE FIELD()                                 ! Which field was completed
  431.   #FOR(%ScreenField)
  432.     #IF(%ScreenField = '?Exit')
  433.     OF ?Exit                                     ! Completed Exit Button
  434.       #IF(%ScreenFieldEdit)
  435.       %ScreenFieldEdit                         #<!  Exit edit routine
  436.       #ENDIF
  437.       BREAK                                      !  Break out of the loop
  438.     #ELSIF(%ScreenField = '?ChangeMode')
  439.     OF ?ChangeMode                               ! Completed mode button
  440.       IF ROWS(SCREEN) = 25                       !  If in 25 line mode
  441.         CLOSE(SCREEN)                            !   Close the current screen
  442.         SETTEXT(50,80)                           !   Set to 50 line mode
  443.       ELSE                                       !  Else in 43 or 50 line mode
  444.         CLOSE(SCREEN)                            !   Close the current screen
  445.         SETTEXT(25,80)                           !   Set to 25 line mode
  446.         SETAREA(25,80)                           !   Resize the screen area
  447.         LOADSYMBOLS                              !   Reload graphic mouse
  448.       END                                        !  End IF
  449.       OPEN(SCREEN)                               !  Open screen in new mode
  450.       DISABLE(?PrintDevice)                      !  Disable the device field
  451.       IF GRAPHIC(1) <> 5Ah                       !  If not in text mode
  452.         DISABLE(?ChangeMode)                     !   Disable ChangeMode button
  453.       END                                        !  End IF
  454.       #IF(%MouseSupport)
  455.       SETMOUSE(ROW(?ChangeMode),COL(?ChangeMode))!  Reset the mouse position
  456.       #ENDIF
  457.       #IF(%ScreenFieldEdit)
  458.       %ScreenFieldEdit                         #<!  ChangeMode edit routine
  459.       #ENDIF
  460.       DISPLAY                                    !  Display the fields
  461.       PrintDevice = ''                           !  Blank PrintDevice field
  462.     #ELSIF(%ScreenField = '?Print')
  463.     OF ?Print                                    ! Completed Print Button
  464.       #IF(%ScreenFieldEdit)
  465.       %ScreenFieldEdit                         #<!  Print button edit routine
  466.       #ENDIF
  467.       IF NOT PrintDevice                         !  If no print device
  468.         DISABLE(?StatusLine)                     !   Disable the StatusLine
  469.         ENABLE(?PrintDevice)                     !   Enable the PrintDevice
  470.         SELECT(?PrintDevice)                     !   Select the PrintDevice
  471.         CYCLE                                    !   Cycle to ACCEPT input
  472.       END                                        !  End IF
  473.       IF NOT STATUS(PrintDevice)                 !  If PrintDevice not ready
  474.         GLO:Message1 = CLIP(PrintDevice) & ' is not ready.'
  475.         GLO:Message2 = 'Be sure the Printer is online and attached to'
  476.         GLO:Message3 = 'the specified device and try again.'
  477.         ShowWarning                              !   Show an error message
  478.         PrintDevice = ''                         !   Blank PrintDevice field
  479.         CYCLE                                    !   Cycle to ACCEPT input
  480.       END                                        !  End IF
  481.       StatusLine = 'Printing: ' & %ListFile    #<!  Fill the status line
  482.       DISPLAY(?StatusLine)                       !  Display the status line
  483.       OPEN(REPORT)                               !  Open the report to print
  484.       LOOP I# = 1 to RECORDS(ListQueue)          !  Loop while QUEUE records
  485.         GET(ListQueue,I#)                        !   Get the QUEUE entry
  486.         IF ERRORCODE() THEN BREAK.               !   Break if an error occurs
  487.         PRINT(RPT:Detail)                        !   Print the line
  488.         IF KEYBOARD()                            !   If keyboard input
  489.           ACCEPT                                 !    Get the keystroke
  490.           IF KEYCODE() = EscKey                  !    If the ESCAPE key
  491.             PrintDevice = ''                     !     Blank PrintDevice field
  492.             BREAK                                !     Break from printing
  493.           END                                    !    End IF
  494.         END                                      !   End IF
  495.       END                                        !  End LOOP
  496.       CLOSE(REPORT)                              !  Close the report
  497.       StatusLine = 'Viewing: ' & %ListFile     #<!  Fill the status line
  498.       DISPLAY(?StatusLine)                       !  Display the status line
  499.       PrintDevice = ''                           !  Blank PrintDevice field
  500.     #ELSIF(%ScreenField = '?PrintDevice')
  501.     OF ?PrintDevice                              ! Selected a port for printer
  502.       #IF(%ScreenFieldEdit)
  503.       %ScreenFieldEdit                         #<!  PrintDevice edit routine
  504.       #ENDIF
  505.       DISABLE(?PrintDevice)                      !  Disable the PrintDevice
  506.       ENABLE(?StatusLine)                        !  Enable the StatusLine
  507.       IF KEYCODE() = EscKey                      !  If escape key pressed
  508.         SELECT(?Exit)                            !   Select the exit button
  509.         PrintDevice = ''                         !   Blank PrintDevice field
  510.         CYCLE                                    !   Cycle to ACCEPT input
  511.       END                                        !  End IF
  512.       SELECT(?Print)                             !  Select the Print button
  513.       PRESS(EnterKey)                            !  And complete it.
  514.     #ELSIF(%ScreenFieldEdit)
  515.     OF %ScreenField                              ! Completed %ScreenField
  516.       %ScreenFieldEdit                           !  %ScreenField edit routine
  517.     #ENDIF
  518.   #ENDFOR
  519.     #INSERT(%PulldownEditRoutines)
  520.     END                                          ! End CASE FIELD()
  521.   END                                            !End LOOP
  522.   #EMBED('Immediately after LOOP, before FREE(Queue)')
  523.   FREE(ListQueue)                                !Free memory table
  524.   CLOSE(RptFile)                                 !Close the DOS file
  525.   #IF(%Pulldown)                                #!If a Pulldown exists
  526.   CLOSE(%Pulldown)                             #<!Close the Pulldown
  527.   #ENDIF
  528.   IF Rows(SCREEN) <> SaveRows |                  !If the mode is not the same
  529.       OR SaveCols <> Cols(SCREEN)                !   as when procedure started
  530.     CLOSE(SCREEN)                                !Close the Screen
  531.     SETTEXT(SaveRows,SaveCols)                   ! Reset to the entry mode
  532.     SETAREA(SaveRows,SaveCols)                   ! Resize the screen area
  533.     LOADSYMBOLS                                  ! Reload graphic mouse
  534.   END                                            !End IF
  535. #EMBED('End of Procedure')
  536. #!
  537. #!***************************************************************************
  538. #GROUP(%ShowProgress)
  539. IF NOT (((POINTER(RptFile)+100)%%100))           !Show the progess indicator
  540.   VEW::Length += 1
  541.   StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length)
  542.   IF VEW::Length = 50
  543.     VEW::Length = 1
  544.     StatusLine = ' Reading File: ' & ' {70}'
  545.   END
  546.   Display(?StatusLine)
  547. END
  548. #!
  549. #!***************************************************************************
  550. #!
  551. #GROUP(%SetFileSymbols)
  552. #IF(%SaveFilenameVar = %Null)
  553.   #SET(%SaveFilenameVar, 'GLO:FileSpec')
  554. #ENDIF
  555.   #SET(%DirQueueExists,%Null)
  556.   #SET(%FileMaskExists,%Null)
  557.   #SET(%FileListExists,%Null)
  558.   #SET(%DirectoryExists,%Null)
  559.   #SET(%FileOkExists,%Null)
  560.   #SET(%FileCancelExists,%Null)
  561.   #FOR(%ScreenField)
  562.     #IF(UPPER(%ScreenField) = '?DIRLIST')
  563.       #SET(%DirQueueExists,'YES')
  564.     #ELSIF(UPPER(%ScreenField) = '?FILEMASK')
  565.       #SET(%FileMaskExists,'YES')
  566.     #ELSIF(UPPER(%ScreenField) = '?FILELIST')
  567.       #SET(%FileListExists,'YES')
  568.     #ELSIF(UPPER(%ScreenField) = '?DIRECTORY')
  569.       #SET(%DirectoryExists,'YES')
  570.     #ELSIF(UPPER(%ScreenField) = '?OK')
  571.       #SET(%FileOkExists,'YES')
  572.     #ELSIF(UPPER(%ScreenField) = '?CANCEL')
  573.       #SET(%FileCancelExists,'YES')
  574.     #ENDIF
  575.   #ENDFOR
  576. #!***************************************************************************
  577. #!
  578. #GROUP(%SetFileErrors)
  579. #IF(%FileCancelExists <> 'YES')
  580.   #SET(%ErrorMessage,(%Procedure & ' WARNING:'))
  581.   #ERROR(%ErrorMessage)
  582.   #SET(%ErrorMessage,'   ?Cancel button is not found in the screen structure,')
  583.   #ERROR(%ErrorMessage)
  584.   #SET(%ErrorMessage,'   Exit code may not have been generated.')
  585.   #ERROR(%ErrorMessage)
  586.   #SET(%ErrorMessage,%Null)
  587.   #ERROR(%ErrorMessage)
  588. #ENDIF
  589. #!
  590. #CHAIN('CLARION9.TPX')
  591.