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 TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

foxpro print

Status
Not open for further replies.

Cybermens

Programmer
Mar 25, 2025
30
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
 
Wow ! I thought I'm the only one who is still using "@ row,col say 'Hello'" for 80x25 screen and " @ prow,pcol say " for printer output.
Secondly the first part of the 'MFLD' logic is very convoluted: it seems the only time the print routine in the second part will be executed is when somehow the MFLD get manipulated to have a value of >= 4 within a Case construct where MFLD is the evaluated parameter; not the best way to handle an input read loop.
As to the print issue: you will need to make your current print section to be a subroutine to handle each print option (screen/file/printer) :

DO CASE

CASE miod = 00
rest scre from pklpscr
rele all
retu

CASE miod = 01 && Output to file && In File / Screen

do output_sub with 01 && file only
do output_sub with 02 && printer only

exit
CASE miod = 02 && Output In Printer

do output_sub with 02 && printer only

exit
CASE miod = 03 && Output to screen && In File / Screen

do output_sub with 03 && screen only

exit

ENDCASE
 
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() ----------------*
This what i do, save,print and preview...
<vfp>
Set Printer To Name Rtrim(Iif(XPilih='1',ZZ_INVOICEPRINTER,ZZ_OTHERPRINTER))
FileToPrn = Alltrim(ZZZREPDIR+'1DonnyXW.TXT')
FolderFile= FileToPrn
Set Device To File (FileToPrn) Additive
Set Margin To 0
Printjob
....bla...bla....bla...blaaaa
Endprintjob
Set Printer Off
Set Printer To
Set Device To Screen
FileToPrn = Filetostr(FileToPrn) &&&&&save to text file
???FileToPrn+Chr(13) &&& print text file
Do Form FPreview With FileToPrn,FolderFile,XPilih &&&&display text file
</vfp>
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top