Media Share 9

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

/ Media Share 9 / MEDIASHARE_09.ISO / clarion / ppstpx.zip / OM8.TPX < prev next >

Wrap

Text File | 1993-06-08 | 28KB | 566 lines

#!-------------------------------------------------------------------------------#! #! OM8.TPX #! #! File Select a file from a directory listing #! Redirect Select destination for a report #! View View a selected text file in a listbox #! #!------------------------------------------------------------------------------ #! #! The File Template #! #! The File template creates a procedure to allow a user to select a file. #! The file name with its full path will be saved in the variable entered #! at the 'Filename Variable' prompt. If this field is left blank the #! default of GLO:Filespec is used. (GLO:Filespec has been entered in #! Clarion's Default Application file for your convenience. It will be #! Smart-linked out of your final .EXE if not used.) #! #! If a Next Procedure is requested (ie: a procedure created with the View #! template) it will be called just prior to returning to the calling #! procedure. #! #!------------------------------------------------------------------------------ #! #PROCEDURE(File,'Select a file from a directory listing'),SCREEN #! #!------------------------------------------------------------------------------ #PROTOTYPE('') #MAP('GETDIR.INC') #DISPLAY(' ') #PROMPT('Filename &Variable',FIELD),%SaveFilenameVar #PROMPT('Initial Directory',@S30),%StartDir #PROMPT('Beginning File Mask',@S6),%StartMask #PROMPT('Next Procedure',PROCEDURE),%NextProcedure #PROMPT('Reselect Upon Return',CHECK),%AllowReselect #PROMPT('Blank Name On Cancel',CHECK),%ClearOnCancel #INSERT(%StandardHeader) #INSERT(%SetFileSymbols) %Procedure PROCEDURE #INSERT(%LocalPPSVariables) #<! Declare Variables PPS %LocalData %ScreenStructure DirString CSTRING(64) !Used for Directory to search SaveDir LIKE(DirString) !Used to hold beginning path DirInfo GROUP !Necessary DOS file group BYTE,DIM(21) ! Used by nextdir Attrib BYTE ! Attribute in DOS format DosTime SHORT ! Time in DOS format DosDate SHORT ! Date in DOS format Filesize LONG ! Size in BYTES FileName CSTRING(13) ! File name . !End GROUP #EMBED('Data Section') CODE ProcedureName = '%Procedure' #<!Fill ProcedureName var. PPS #EMBED('Setup Procedure') #INSERT(%FileMgrStart) #<!Insert File Manager. PPS OPEN(Screen) !Open the screen #IF(%StartMask) FileMask = '%StartMask' #<!Set the begining file mask #ELSE FileMask = '*.*' !Set the begining file mask #ENDIF SaveDir = PATH() !Save the Starting Directory IF LEN(CLIP(SaveDir)) <> 3 !If we are not in the Root SaveDir = CLIP(SaveDir) & '\' ! add the trailing '\' END !End IF #IF(%StartDir) Directory = UPPER(%StartDir) #<!Change to the requested SETPATH(Directory) ! Directory Directory = PATH() ! And reread it. IF LEN(CLIP(Directory)) <> 3 !If we are not in the Root Directory = CLIP(Directory) & '\' ! add the trailing '\' END !End IF #ELSE Directory = SaveDir !Set to the Current Directory #ENDIF DO FillQueues !Fill the screen queues LOOP !Main ACCEPT loop #INSERT(%GenerateFormulas) #EMBED('Top of Accept Loop') CASE SELECTED() #<!Jump to field setup routine #INSERT(%ScreenSetupRoutines) END #<!End CASE ACCEPT !Enable the keyboard CASE KEYCODE() #FOR(%HotKey) OF %HotKey #<!User defined HotKey %HotKeyProc #<!HotKey Procedure #ENDFOR #INSERT(%FileMgrView) #!Insert File Manager View PPS END CASE FIELD() !Jump to field edit routine OF ?FileMask !FieldMask field edit #FIX(%ScreenField, '?FileMask') #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF IF REFER() !If something was touched Do FillQueues ! Fill queues with new mask SELECT(?FileList,1) ! for files, select line 1 END !End IF OF ?FileList !FileList field Edit Get(FileQueue,CHOICE()) ! Get the selected entry #FIX(%ScreenField, '?INSERT') #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF IF KEYCODE() = MouseLeft2 OR | ! On mouse double click KEYCODE() = EnterKey ! Or the Enter Key SELECT(?OK) ! Select the OK button and PRESS(EnterKey) ! press Enter to complete END ! End IF #IF(%DirQueueExists) OF ?DirList !Directory List field Edit #FIX(%ScreenField, '?DirList') #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF IF SELECTED() = ?DirList ! If selecting the same field IF KEYCODE() = MouseLeft2 OR | ! On mouse double click KEYCODE() = EnterKey ! Or the Enter Key GET(DirQueue,CHOICE()) ! Get the selected entry Directory = CLIP(Directory) & | ! and create a new directory DirLine ! with trailing \ SETPATH(Directory) ! Goto the directory IF LEN(CLIP(PATH())) <> 3 ! If we are not in the Root Directory = CLIP(PATH()) & '\' ! Reread and add trailing \ ELSE ! Else Directory = PATH() ! Reread the direcrory END ! End IF Do FillQueues ! Fill the screen queues SELECT(?FileList,1) ! Reset File Listbox pointer SELECT(?DirList,1) ! Reset Dir Listbox pointer END ! End IF END !End IF #ENDIF OF ?Ok !Ok button field Edit #FIX(%ScreenField, '?Ok') #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF IF FileLine = ' NO MATCH ' ! If no FileName selected #IF(%DirQueueExists) SELECT(?DirList) ! Select the directory List #ELSE SELECT(?Cancel) ! Select the directory List #ENDIF CYCLE ! and cycle to ACCEPT. END ! End IF %SaveFilenameVar = CLIP(Directory) & FileLine #<! Save the Filename #IF(%NextProcedure) SETPATH(SaveDir) ! Return to starting path #IF(%DirQueueExists) FREE(DirQueue) ! Free the DirQueue memory #ENDIF FREE(FileQueue) ! Free the FileQueue memory %NextProcedure #<! Call the Next procedure #IF(%AllowReselect) DO FillQueues !Fill the screen queues SELECT(?FileList) !Select the file list CYCLE !Return to Accept #ENDIF #ELSE BREAK #ENDIF OF ?Cancel !Cancel button field Edit #FIX(%ScreenField, '?Cancel') #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF SETPATH(SaveDir) ! Return to starting path #IF(%DirQueueExists) FREE(DirQueue) ! Free the DirQueue memory #ENDIF FREE(FileQueue) ! Free the FileQueue memory #IF(%ClearOnCancel) CLEAR(%SaveFilenameVar) #<! Clear the filename variable #ENDIF BREAK ! Return to Calling Procedure END ! End CASE FIELD() END !End LOOP SETPATH(SaveDir) ! Return to starting path #IF(%DirQueueExists) FREE(DirQueue) ! Free the DirQueue memory #ENDIF FREE(FileQueue) ! Free the FileQueue memory #INSERT(%FileMgrExit) #!Insert File Manager Exit PPS FillQueues ROUTINE FREE(FileQueue) !Clear the FileQueue #IF(%DirQueueExists) FREE(DirQueue) !Clear the DirQueue DirString = CLIP(Directory) & '*.*' !Set the subdirectory mask IF SETDIR(DirString,DirInfo,FA_DIREC) <> 0 !If unexpected error FREE(DirQueue) !Clear the DirQueue FREE(FileQueue) !Clear the FileQueue RETURN ! Return END !End IF LOOP !While entries found IF FileName = '.' ! If the dot entry IF NEXTDIR(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF END ! End IF IF BAND(ATTRIB,10H) ! If a subdirectory is found IF FileName = '..' ! If Previous dir entry DirLine = '..\' ! Add a backslash ELSE ! Else DirLine = FileName ! Fill the queue field END ! End IF ADD(DirQueue) ! Add to the DirQueue IF ERRORCODE() THEN BREAK. ! Break if unexpected error END ! End IF IF NEXTDIR(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF END !End LOOP SORT(DirQueue,+DirLine) !Sort the directory listing #ENDIF DirString=CLIP(Directory) & FileMask !Set the file mask IF SETDIR(DirString,DirInfo,FA_NORMAL) <> 0 !If no matching files found FileLine = ' NO MATCH ' ! Fill queue with message ADD(FileQueue) ! Add it to the FileQueue Else !else matching file found LOOP ! While entries are found IF BAND(ATTRIB,10H) = 0 ! If entry is a file FileLine = FileName ! Fill the queue field and ADD(FileQueue) ! Add to the FileQueue IF ERRORCODE() THEN BREAK. ! Break if unexpected error END ! End IF IF NEXTDIR(DirInfo) <> 0 ! Get the next entry BREAK ! Break if unexpected error END ! End IF END ! End LOOP END !End IF SORT(FileQueue,+FileLine) !Sort the file listing DISPLAY !Display the new lists #! #!*************************************************************************** #PROCEDURE(Redirect,'Select destination for a report'),SCREEN #!------------------------------------------------------------------------------ #! #! The Redirect Template #! #!------------------------------------------------------------------------------ #PROTOTYPE('') #INSERT(%StandardHeader) %Procedure PROCEDURE #INSERT(%LocalPPSVariables) #<! Declare Variables PPS %LocalData %ScreenStructure #EMBED('Data Section') CODE ProcedureName = '%Procedure' #<!Fill ProcedureName var. PPS #EMBED('Setup Procedure') #INSERT(%FileMgrStart) #<!Insert File Manager. PPS OPEN(Screen) #EMBED('Setup Screen') LOOP #INSERT(%GenerateFormulas) #EMBED('Top of Accept Loop') #FOR(%ScreenField) #IF(%ScreenFieldSetup) CASE SELECTED() #<!Jump to field setup routine #INSERT(%ScreenSetupRoutines) END #<!End CASE #ENDIF #ENDFOR ACCEPT !Accept input #FOR(%HotKey) CASE KEYCODE() #FOR(%HotKey) OF %HotKey #<!User defined HotKey %HotKeyProc #<!HotKey Procedure #ENDFOR #INSERT(%FileMgrView) #!Insert File Manager View PPS END #BREAK #ENDFOR CASE FIELD() #FOR(%ScreenField) OF %ScreenField %ScreenFieldEdit #ENDFOR END END #EMBED('End of Procedure') #INSERT(%FileMgrExit) #!Insert File Manager Exit PPS #! #! #PROCEDURE(View,'View a selected text file in a listbox'),SCREEN,REPORT,PULLDOWN #!------------------------------------------------------------------------------ #! #! The View Template #! #!------------------------------------------------------------------------------ #PROTOTYPE('') #PROJECT('%clapfx%ASCII.LIB') #INSERT(%StandardHeader) #DISPLAY(' ') #PROMPT('File to &View',@s30),%ListFile #PROMPT('Warning Size (in K)',@s6),%FileWarningSize #PROMPT('Ma&ximum Line Length',@s6),%FileLineLength #PROMPT('Progress &Indicator',CHECK), %ShowProg #PROMPT('Progress Character',@S8),%ProgChar #! #IF(%ListFile = %Null) #SET(%ListFile, 'GLO:FileSpec') #ENDIF %Procedure PROCEDURE #INSERT(%LocalPPSVariables) #<! Declare Variables PPS %LocalData SaveRows BYTE !Initial screen rows SaveCols BYTE !Initial screen columns FirstPage BYTE RptFile FILE,DRIVER('ASCII'),NAME(%ListFile),PRE(Dos) #<! Declare Input File RECORD Fline STRING(255) . . %ReportStructure %ScreenStructure %PulldownStructure #IF(%ShowProg) VEW::Length BYTE ! Progress variable VEW::ProgString STRING('{50}') ! Progress display variable #ENDIF #EMBED('Data Section') CODE ProcedureName = '%Procedure' #<!Fill ProcedureName var. PPS #EMBED('Setup Procedure') #INSERT(%FileMgrStart) #<!Insert File Manager. PPS #IF(%ProgChar) #!If showing the progress VEW::ProgString = ALL(%ProgChar) #<!Fill the progress string #ENDIF IF NOT %ListFile THEN RETURN. #<!If %ListFile is blank OPEN(RptFile) !Open the Dos File IF DiskError('Cannot Locate Selected File') THEN RETURN. #IF(%FileWarningSize) IF Bytes(RptFile) > (%FileWarningSize * 1024)#<! If oversized file GLO:Message1 = 'This is a large file and may take a while' GLO:Message2 = 'to load. You may press the Esc key' GLO:Message3 = 'while the file is loading to exit.' ShowWarning ! Show a warning screen END !End IF #ENDIF OPEN(Screen) !Open the Screen DISABLE(?PrintDevice) !Disable the device field #IF(%Pulldown) #!If a Pulldown exists OPEN(%Pulldown) #<!Open the Pulldown #ENDIF SaveRows = Rows(SCREEN) !Save the Screen Rows SaveCols = Cols(SCREEN) !Save the Screen Columns #EMBED('Setup Screen') FirstPage = 1 !Set flag for Page 1 SET(RptFile) !Set to the file LOOP !Loop through the dos file #INSERT(%GenerateFormulas) #EMBED('Top of Accept Loop') NEXT(RptFile) ! Get the next record IF ERRORCODE() THEN BREAK. ! #IF(%FileLineLength) IF Bytes(RptFile) > %FileLineLength ! Line is longer than allowed GLO:Message1 = 'The line length is greater than %FileLineLength.' #ELSE IF Bytes(RptFile) > 255 ! Line is longer than allowed GLO:Message1 = 'The line length is greater than 255.' #ENDIF GLO:Message2 = 'The selected file is not an ASCII file.' GLO:Message3 = 'No view on this file is available.' ShowWarning ! Show an error message FREE(ListQueue) ! Free memory table CLOSE(RptFile) ! Close the DOS file #IF(%Pulldown) #!If a Pulldown exists CLOSE(%Pulldown) #<!Close the Pulldown #ENDIF CLOSE(SCREEN) ! Close the Screen #EMBED('Immediately before RETURN for non-ASCII file error') RETURN ! Return back to caller END !End IF #IF(%ShowProg) #!If showing the progress #INSERT(%ShowProgress) #ENDIF #EMBED('After NEXT in RptFile LOOP') Que:QueueLine = Dos:Fline ! Fill the queue line. ADD(ListQueue) ! Add to the queue IF ERRORCODE() ! If out of memory GLO:Message1 = 'Error: ' & ERROR() ! GLO:Message2 = 'This file is too large to be read into memory.' GLO:Message3 = 'The entire file will not be displayed.' ShowWarning ! Show an error message BREAK ! Break out of read loop END ! End IF IF FirstPage ! If page 1 IF RECORDS(ListQueue) = ROWS(SCREEN) ! If we have a full screen FirstPage = 0 ! turn off the page flag DISPLAY ! and display page 1 END ! End IF END ! End IF LOOP WHILE KEYBOARD() ! While Keyboard Input SELECT(?List) ! Select the List box ACCEPT ! Handle internal keystrokes END ! End LOOP IF KEYCODE() = EscKey THEN BREAK. END !End LOOP StatusLine = 'Viewing: ' & %ListFile #<! fill the statusline DISPLAY !Display the screen LOOP !Process the screen #FOR(%ScreenField) #IF(%ScreenFieldSetup) CASE SELECTED() #<!Jump to field setup routine #INSERT(%ScreenSetupRoutines) END #<!End CASE #ENDIF #ENDFOR ACCEPT !Accept input #FOR(%HotKey) CASE KEYCODE() #FOR(%HotKey) OF %HotKey #<!User defined HotKey %HotKeyProc #<!HotKey Procedure #ENDFOR #INSERT(%FileMgrView) #!Insert File Manager View PPS END #BREAK #ENDFOR CASE FIELD() !Which field was completed #FOR(%ScreenField) #IF(%ScreenField = '?Exit') OF ?Exit !Completed Exit Button %ScreenFieldEdit #<! Insert Edit Routine BREAK ! Break out of the loop #ELSIF(%ScreenField = '?ChangeMode') OF ?ChangeMode !Completed mode button IF ROWS(SCREEN) = 25 ! If in 25 line mode CLOSE(SCREEN) ! Close the current screen SETTEXT(50,80) ! Set to 50 line mode ELSE ! Else in 43 or 50 line mode CLOSE(SCREEN) ! Close the current screen SETTEXT(25,80) ! Set to 25 line mode SETAREA(25,80) ! Resize the screen area LOADSYMBOLS ! Reload graphic mouse END ! End IF OPEN(SCREEN) ! Open screen in new mode DISABLE(?PrintDevice) ! Disable the device field DISPLAY ! Display the fields %ScreenFieldEdit #<! Insert Edit Routine #ELSIF(%ScreenField = '?Print') OF ?Print !Completed Print Button %ScreenFieldEdit #<! Insert Edit Routine IF NOT PrintDevice ! If no print device selected DISABLE(?StatusLine) ! Disable the StatusLine ENABLE(?PrintDevice) ! Enable the PrintDevice SELECT(?PrintDevice) ! Select the PrintDevice CYCLE ! Cycle to accept input END ! End IF IF NOT STATUS(PrintDevice) ! Check PrintDevice status GLO:Message1 = CLIP(PrintDevice) & ' is not ready.' GLO:Message2 = 'Be sure the Printer is online and attached to' GLO:Message3 = 'the specified device and try again.' ShowWarning ! Show an error message PrintDevice = '' ! Clear the PrintDevice CYCLE ! Cycle to accept input END ! End IF OPEN(REPORT) ! Open the report to print LOOP I# = 1 to RECORDS(ListQueue) ! Loop while QUEUE records GET(ListQueue,I#) ! Get the line IF ERRORCODE() THEN BREAK. ! Break if an error occurs PRINT(RPT:Detail) ! Print the line IF KEYBOARD() ! If keyboard input ACCEPT ! Get the keystroke IF KEYCODE() = EscKey ! If the ESCAPE key BREAK ! Break from printing END ! End IF END ! End IF END ! End LOOP CLOSE(REPORT) ! Close the report PrintDevice = '' ! Clear the printer variable #ELSIF(%ScreenField = '?PrintDevice') OF ?PrintDevice !Selected a port for printer %ScreenFieldEdit #<! Insert Edit Routine DISABLE(?PrintDevice) ! Disable the PrintDevice ENABLE(?StatusLine) ! Enable the StatusLine SELECT(?Print) ! Select the Print button PRESS(EnterKey) ! And complete it. #ELSIF(%ScreenFieldEdit) OF %ScreenField %ScreenFieldEdit #ENDIF #ENDFOR #INSERT(%PulldownEditRoutines) END ! End CASE FIELD() END !End LOOP #EMBED('Immediately after LOOP, before FREE(Queue)') FREE(ListQueue) !Free memory table CLOSE(RptFile) !Close the DOS file #IF(%Pulldown) #!If a Pulldown exists CLOSE(%Pulldown) #<!Close the Pulldown #ENDIF CLOSE(SCREEN) !Close the Screen IF Rows(SCREEN) <> SaveRows | !If the mode is not the same OR SaveCols <> Cols(SCREEN) !as when we entered SETTEXT(SaveRows,SaveCols) ! Reset to the entry mode SETAREA(SaveRows,SaveCols) ! Resize the screen area LOADSYMBOLS ! Reload graphic mouse END !End IF #EMBED('End of Procedure') #INSERT(%FileMgrExit) #!Insert File Manager Exit PPS #! #!*************************************************************************** #GROUP(%ShowProgress) IF NOT (((POINTER(RptFile)+100)%%100)) !Show the progess indicator VEW::Length += 1 StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length) IF VEW::Length = 50 VEW::Length = 1 StatusLine = ' Reading File: ' & ' {70}' END Display(?StatusLine) END #! #!*************************************************************************** #! #GROUP(%SetFileSymbols) #IF(%SaveFilenameVar = %Null) #SET(%SaveFilenameVar, 'GLO:FileSpec') #ENDIF #SET(%DirQueueExists,%Null) #SET(%FileMaskExists,%Null) #SET(%DirectoryExists,%Null) #FOR(%ScreenField) #IF(UPPER(%ScreenField) = '?DIRLIST') #SET(%DirQueueExists,'YES') #ELSIF(UPPER(%ScreenField) = '?FILEMASK') #SET(%FileMaskExists,'YES') #ELSIF(UPPER(%ScreenField) = '?DIRECTORY') #SET(%DirectoryExists,'YES') #ENDIF #ENDFOR #! #CHAIN('OM9.TPX')