Liren Large Software Subsidy 5/05.iso/a/a040/2.ddi/SHRWARE4.ARC/MSALABE.INC

Text File | 1988-06-03 | 5.8 KB | 278 lines

<<* MSALABE.INC *>>

<<procedure GenLabelBody>>
<<begin>>
PARAMETERS CHOICE_Y
PRIVATE filename,savrecnum,rowPROMPT
rowPROMPT = 23
savrecnum = RECNO()
* ---MAIN LOOP
DO WHILE .T.
DO CASE
CASE CHOICE_Y = 1
<<GenColor( 0,'SCREEN' )>>
* --- CREATE STATUS BOX
@ 1,49 CLEAR TO 6,75
@ 1,49 TO 6,75
@ 1,59 SAY " STATUS "
@ 2,50 SAY "       FILE:"
@ 3,50 SAY "      INDEX:"
@ 4,50 SAY "   FILTERED:"
@ 5,50 SAY "DESTINATION:"
SAVE SCREEN TO STATUSSCR
* ---Display Label forms.
@ 24,0 CLEAR
@ 24,0 SAY 'Loading directory...'
* ---MAKE DIRECTORY AND LOAD INTO MENU
* ---FIND FIRST ENTRY
STORE SYS(2000,{"}{fileprefix}_*.LBL{"}) TO MSG1
IF LEN(MSG1) <> 0
 STORE 2 TO COUNT
 STORE "MSG2" TO MSG
 DO WHILE .T.
 STORE SYS(2000,{"}{fileprefix}_*.LBL{"},1) TO &MSG
 IF LEN(&MSG) = 0
 EXIT
 ENDIF
 STORE COUNT + 1 TO COUNT
 STORE "MSG"+LTRIM(STR(COUNT)) TO MSG
 ENDDO
 * ---display
 @ 24,0 CLEAR
 @ 24,0 SAY 'Select Report File.'
 menuchoice = 0
 DO {fileprefix}_MENU WITH 4,25,COUNT-1,12
 @ 23,0 SAY "         "
 IF menuchoice = 0
 EXIT
 ELSE
 STORE "MSG"+LTRIM(STR(menuchoice)) TO MSG
 STORE &MSG TO filename
 ENDIF
ELSE
 * ---NO FILES
 @ 24,0 CLEAR
 @ 24,0 SAY 'NO LBL Files found.  Press any key to continue.'
 STORE INKEY(0) TO STOP
 EXIT
ENDIF

CASE CHOICE_Y = 2
* ---CREATE LABEL
STORE SPACE(1) TO filename

CASE CHOICE_Y = 3
* --- ADD YOUR OWN
 EXIT

CASE CHOICE_Y = 4
* --- ADD YOUR OWN
 EXIT
ENDCASE  && CHOICE_Y



* --- CHECK CONDITIONS AND RUN LABELS

IF CHOICE_Y = 1 .OR. CHOICE_Y = 2
* ---If the file does not exist, create it or exit.
@ 24,0 CLEAR
  ?? SYS(2002,1)
IF .NOT. FILE( filename )
filename = "    "
@  24, 0 SAY {"}Enter LABEL FORM filename: {fileprefix}_    .LBL{"}
@  24,32 GET filename PICTURE "@!"
READ
* ---Remove the file extension.
filename = UPPER( filename + "." )
filename = TRIM( SUBSTR( filename,1,AT(".",filename)-1 ) )
IF "" = filename
   EXIT
ENDIF
filename = {"}{fileprefix}_{"} + filename + ".LBL"
IF FILE( filename )
STORE SPACE(1) TO CHECK
@ 24,0 CLEAR
@ 24,0 SAY 'File '+filename+' exists.  Do you wish to overwrite? (Y/N)';
 GET CHECK PICT '!' VALID CHECK$'YN'
READ
IF CHECK = 'N'
EXIT
ENDIF
ENDIF
   CREATE LABEL &filename
   EXIT
ENDIF
RESTORE SCREEN FROM STATUSSCR
* --- PLACE NAME IN STATUS BOX
@ 2,63 SAY filename
SAVE SCREEN TO STATUSSCR
* --- SELECT INDEX
ndxchoice = ' '
<<select all databases>>
<<if ndxtotal = 0>>
   DO SayLine WITH rowPROMPT,"*** NO INDEX FILE IN USE"
   WAIT
<<elsif ismultindx>>
   DO {fileprefix}_NDXS WITH rowPROMPT,ndxchoice
<<endif>>
RESTORE SCREEN FROM STATUSSCR
* ---UPDATE STATUS
@ 3,63 SAY ndxchoice
SAVE SCREEN TO STATUSSCR
*
* ---Get the FOR <exp>.
expr = ""
notes = ""
choice = " "
@ 24,0 CLEAR
@ 24,0 SAY "Specify a CONDITION on the output? (y/n)" GET choice PICTURE "!"
READ
IF choice = "Y"
  <<select database 8>>  <<*Is SELECT H being used?*>>
  <<if dbfnam>>          <<*Yes, then use old <expr> system...*>>
   DO {fileprefix}_EXPR WITH expr
  <<else>>               <<*No, use new and improved...*>>
   DO {fileprefix}_COND WITH expr,notes
  <<endif>>
   IF "" <> TRIM( expr )
      * ---Check for valid LOGICAL expression.
      IF TYPE( expr ) <> "L"
         expr = ""
      ENDIF
   ENDIF
ENDIF
RESTORE SCREEN FROM STATUSSCR
* --- UP DATE STATUS
IF "" <> TRIM( expr )
 @ 4,63 SAY "Yes"
ELSE
 @ 4,63 SAY "No"
ENDIF
* ---Screen or printer selection.
menuchoice = 0
MSG1 = "Screen"
MSG2 = "Printer"
MSG3 = "Abort"
DO {fileprefix}_MENU WITH 6,35,3,8
?? CHR(7)

* ---Print the Label.
DO CASE
CASE menuchoice = 3
   EXIT
CASE menuchoice = 2
* ---UPDATE STATUS
@ 5,63 SAY "Printer"
* ---CHECK STATUS OF PRINTER
?? CHR(7)
@ 24,0 CLEAR
@ 24,0 SAY 'Please check printer and press any key to begin or '+;
'<A> to Abort.'
key = 0
DO WHILE KEY = 0 .OR. SYS(13) = 'OFFLINE'
KEY = 0
DO WHILE KEY = 0
 KEY = INKEY()
ENDDO
 IF CHR(KEY) $ "aA"
  EXIT
 ENDIF
ENDDO
IF CHR(KEY) $ "aA"
 * --- EXIT FROM MAIN LOOP
 EXIT
ENDIF
* ---printer is ready check if special fount needed
menuchoice = 0
MSG1 = "Draft"
MSG2 = "Letter Quality"
MSG3 = "Condensed"
MSG4 = "Expanded"
MSG5 = "Abort"
DO {fileprefix}_MENU WITH 7,45,5,14
?? CHR(7)
* ---Print the Label.
   @ 24,0 CLEAR
   @ 24,0 SAY "Printing Labels..."
   SET ESCAPE ON
   SET CONSOLE OFF
SET PRINT ON
DO CASE
  CASE menuchoice = 1
   IF INST_L_OFF <> SPACE(30)
   ?? &INST_L_OFF
   ENDIF
  CASE menuchoice = 2
   IF INST_L_ON <> SPACE(30)
   ?? &INST_L_ON
   ENDIF
  CASE menuchoice = 3
   IF INST_C_ON <> SPACE(30)
   ?? &INST_C_ON
   ENDIF
  CASE menuchoice = 4
   IF INST_E_ON <> SPACE(30)
   ?? &INST_E_ON
   ENDIF
  CASE menuchoice = 5
   SET PRINT OFF
   EXIT
ENDCASE
SET PRINT OFF
   IF "" <> TRIM( expr )
      LABEL FORM &filename FOR &expr TO PRINT
   ELSE
      LABEL FORM &filename  TO PRINT
   ENDIF
   EJECT
   * --- reset printer
   SET PRINT ON
   DO CASE
     CASE menuchoice = 1
      IF INST_L_OFF <> SPACE(30)
      ?? &INST_L_OFF
      ENDIF
     CASE menuchoice = 2
      IF INST_L_OFF <> SPACE(30)
      ?? &INST_L_OFF
      ENDIF
     CASE menuchoice = 3
      IF INST_C_OFF <> SPACE(30)
      ?? &INST_C_OFF
      ENDIF
     CASE menuchoice = 4
      IF INST_E_OFF <> SPACE(30)
      ?? &INST_E_OFF
      ENDIF
   ENDCASE
   SET PRINT OFF
   SET CONSOLE ON
   SET ESCAPE OFF
   EXIT
OTHERWISE
 * ---output to screen
  <<GenColor( 0,'SCREEN' )>>
   CLEAR
   SET ESCAPE ON
   IF "" <> TRIM( expr )
      LABEL FORM &filename FOR &expr
   ELSE
      LABEL FORM &filename
   ENDIF
   SET ESCAPE OFF
   WAIT
   EXIT
ENDCASE
ENDIF  &&CHOICE = 1 .OR. 2

ENDDO
IF savrecnum > 0 .AND. LASTREC <> 0
   GOTO savrecnum
ENDIF
  ?? SYS(2002)

<<end>> <<*GenLabelBody*>>

<<* EOF: MSALABE.INC *>>