Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

foxpro print

Cybermens

Programmer
Mar 25, 2025
18
Hi,

i this program , i am printing report. Now i give the user option to either print it on screen , in a txt file or directly to the printer.

Now the user wants to print the output to a text file and directly to the printer at the same time.

I tried multiple ways but unable to do the same thing at the same time.

*---------------------------------------------------*
*---- PKLPRN.PRG ----*
*---- PACKING LIST PRINTING ----*
*---- CALLING FROM PKLE.PRG ----*
*---------------------------------------------------*
*
parameter mprn

SAVE SCREEN TO PKLPSCR


* ---------- Initialisation Section ---------------- *

*
*-------------- BOX
*
SET DEVI TO SCRE

J = 40
I = 40
MFLD = 01

DO WHILE J < 64
@ 10,I TO 16,J CLEAR
@ 10,I-1 TO 16,J
J = J + 1
I = I - 1
ENDDO
SET COLOR TO W+/N
@ 12,18 SAY 'Origine : '
@ 12,40 SAY 'Destination : '
@ 14,18 SAY 'Desp.Date : '
@ 17,52 SAY 'O/ FILE : '
*
DO WHILE .T.
DO CASE
CASE MFLD <= 00
EXIT

CASE MFLD >= 04
EXIT

CASE MFLD = 01
sele orgmst
@ 12,30 GET MORIG PICT "@!"
READ
SET COLOR TO W+/N
@ 12,30 SAY MORIG
MFLD = RKEYII()

if mfld = 02
seek morig
if !found()
do namedisp with "orgmst","code+' ³ '+city+' ³ '+di",;
morig,08,45,34,12
endif
morig = code
endif
@ 12,30 say morig pict '@!'


CASE MFLD = 02
sele orgmst
@ 12,54 GET MDESTI PICT "@!"
@ 12,59 GET MDSTSN PICT "!" valid MDSTSN $ ' 0123456789'
READ
SET COLOR TO W+/N
@ 12,54 SAY MDESTI
@ 12,59 SAY MDSTSN
MFLD = RKEYII()

if mfld = 03
seek mdesti
if !found()
do namedisp with "orgmst","code+' ³ '+city+' ³ '+di",;
mdesti,08,45,34,12
endif
mdesti = code
endif
@ 12,54 say mdesti pict '@!'


CASE MFLD = 03
@ 14,30 GET MDOCDT
READ
@ 14,30 SAY MDOCDT
MFLD = RKEYII()

ENDCASE

ENDDO
*
IF MFLD <= 00
SET COLOR TO W/N
*CLOSE PROC
*RELE ALL
RETU
ENDIF
*
*
* ---------- printer / screen / file ------------ *
*
* miod = input / output devise
set colo to /gr
@ 14,54 clea to 18,66
set colo to w
@ 13,52 clea to 16,64
@ 13,52 TO 17,64

do while .t.
@ 14,54 prom " Screen "
@ 15,54 prom " Printer "
@ 16,54 prom " File "
MENU TO miod

DO CASE

CASE miod = 00
rest scre from pklpscr
rele all
retu

CASE miod = 01 && Output In File / Screen
exit
CASE miod = 02 && Output In Printer
exit
CASE miod = 03 && Output In File / Screen
exit

ENDCASE

ENDDO (print over)


l = 06 && Line
pg = 00 && Page
m_l = 60 && maximum per page
msn = 0
*
*------- printer checking
*
if miod = 01 .or. miod = 03
mprnfile='PLST'+CUSERSN+'.PRN'
set printer to &mprnfile
@ 21,52 say 'O/File Is : '
set colo to w/n*
@ 21,64 say mprnfile
set colo to w/n
endif
*
*
do while .t.
if sys(13)="OFFLINE"
set inte off
set colo to w/n
ans =' '
@ 23,0 say " Printer Not Ready... Retry (Y/N) " get ans func "Y"
read
@ 23,00
set inte on
if ans $ "Nn"
retu
endif
loop
endif
exit
enddo
*

set devi to print

sele dogh
seek mdesti+dtoc(mdocdt,1)+mdstsn

mfltno = fltno
mawbno = awbno
mpkg = pkg
mother = other
*
mtwt = 0
i = 1
c = 0
sele dogt
seek mdesti+dtoc(mdocdt,1)+mdstsn
*
do while mdesti+dtoc(mdocdt,1)+mdstsn = desti+dtoc(docdt,1)+sn .and. !eof()
mio(i) = io
mcwbno(i) = cwbno
mcrorg(i) = orig

mctbcamt = 0

if mio(i) = 'OG'
sele cour
seek mcwbno(i)
mcrdst(i) = trim(desti)
mshprnm = trim(shname2)
if len(trim(mshprnm)) = 0
mshprnm = trim(shname1)
endif
mconsnee = trim(cname)
mwt = weight
mpcs = pktno
mctbcamt = ctbcamt
endif

if mio(i) = 'IC'
sele inco
seek mcwbno(i)
mcrdst(i) = trim(conseedes)
mshprnm = trim(coninor)
mconsnee = trim(consnee)
mwt = weight
mpcs = pktno
endif
mdox = 'DOX'
if cdoc = 'N'
mdox = 'SPS'
endif
if cdoc = 'P'
mdox = 'NP'
endif
*

sele dogh

if c = 0
@ l,008 say mfltno
@ l,018 say mdocdt
@ l,035 say morig
@ l,048 say mawbno
@ l,075 say mpkg
@ l,090 say mother
*@ l,105 say chr(14)+mdesti+' '+mdstsn
@ l,105 say chr(14)+mdesti
*@ l,107 say mdesti
l = l + 6
endif

sele dogt

msn = msn + 1

@ l,004 say msn pict '999'
@ l,009 say mcwbno(i)
@ l,022 say mwt pict '99999'
@ l,030 say mpcs pict '999'
@ l,036 say mdox
@ l,042 say chr(15)+mshprnm
@ l,083 say mconsnee
@ l,126 say mcrdst(i)
if mctbcamt > 0
@ l,145 say chr(14)+mcrorg(i)+'/ Rs.'+str(mctbcamt,8,2)+chr(18)
else
@ l,145 say chr(14)+mcrorg(i)+chr(18)
endif
*
mtwt = mtwt + mwt
l = l + 1
*@ l,005 say chr(18)
l = l + 1
*
c = c + 1
if c >= 15
c = 0
l = 6
eject

set devi to screen
DO MESG WITH " Press Any Key To Continue ","W",24
set devi to print

endif

sele dogt
skip
enddo
l = 42
@ l,007 say 'Total Weight :'
@ l,021 say mtwt pict '999999'
@ l,028 say 'Gm'
eject
set printer to
set devi to screen
if miod = 01 .or. miod = 03
!BR &MPRNFILE
endif

RESTORE SCREEN FROM PKLPSCR

RETU
*---------------- eop() ----------------*
 
You don't have to do it at the same time. Let user to print laser report and then call the program to create a text file
 

Part and Inventory Search

Sponsor

Back
Top