home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
CLIPPER
/
SCRNUZ
/
MEMPRTSC.PRG
< prev
next >
Wrap
Text File
|
1992-11-11
|
10KB
|
296 lines
*----------------------------------------------------------------------------
*
* Program Name: MEMPRTSC.PRG Copyright: EDON Corporation
* Date Created: 02/26/91 Language: Clipper S'87
* Time Created: 17:58:49 Author: Ed Phillips
* Description: Print Current Screen function for Memscrn.prg (Alt-P)
*----------------------------------------------------------------------------
PROCEDURE PrintScreen
PRIVATE dscrn, i, j,temp, poldcolor
poldcolor = Setcolor()
temp = Savescreen(1,0,24,79) && save scrn, strip attributes
output = 'QUIT'
f_name = Space(20)
lines = 58
page = 1
send_ff = .f.
Get_device()
phdr = 'Gets_hdr'
rpt_wid = 138
IF output != 'QUIT'
IF output = 'SCREEN'
Sayhelp('Extracting Screen Text ...')
ENDIF && IF output != 'SCREEN'
charcnt = 80 * 24 &&(r - l + 1) * (b - t + 1)
dscrn = ' '
j = 1
FOR i = 1 TO charcnt
dscrn = dscrn + Subs(temp,j,1)
j = j + 2
NEXT && FOR i = 1 TO charcnt
dscrn = Subs(dscrn,2)
ENDIF && IF output != 'QUIT'
prt = EOSprint()
BEGIN SEQUENCE
IF (output = 'QUIT') .OR. (output = 'FILE' .AND. Empty(f_name)) .OR. Eof()
BREAK
ELSEIF output = 'SCREEN'
prt = EOSprint()
scrn_file = MakScrnDBF(rpt_wid)
Pop_win('Creating Report...')
SET PRINTER TO (scrn_file)
SET DEVICE TO PRINT
ELSEIF output = 'PRINTER'
prt = EOSprint()
IF prt # 'Local Dot Matrix' &&Epson FX'
mem_defprt = 'HP Laser'
Ljreset()
Ljland()
rpt_wid = 80
lines = 43
SET MARGIN TO 10
ELSE && OTHERWISE...
mem_defprt = 'Epson FX'
Epson17()
rpt_wid = 130
send_ff = .t.
SET MARGIN TO 0
ENDIF
Setprc(0,0)
ENDIF && IF output = 'PRINTER'
Saycxl()
ptit = 'Screen Name: '+Trim(Scrn_name)
ptit1 = 'Coordinates: Top - '+Strzero(St,2)+', Left - '+Strzero(Sl,2)+;
', Bottom - '+Strzero(Sb,2)+', Right - '+Strzero(Sr,2)
ptit2 = 'Shadow: '+Transform(Shadow,"Y")+Space(5)+'Explode: '+Transform(Explode,"9")
@ Lc()+1,Rpt_centr(ptit,rpt_wid) SAY ptit
@ Lc()+2,Rpt_centr(ptit1,rpt_wid) SAY ptit1
@ Lc()+1,Rpt_centr(ptit2,rpt_wid) SAY ptit2
*---------------------
* Print top ruler line
*---------------------
@ Lc()+3,0 SAY ' '
x = 12
FOR i = 1 TO 7
@ Lc(),x SAY Str(i,1)+Space(9)
x = x + 10
NEXT && FOR i = 1 TO 8
@ Lc()+1,0 SAY ' '
x = 2
FOR i = 1 TO 8
@ Lc(),x SAY '0123456789'
x = x + 10
NEXT
*-----------------
* Print the screen
*-----------------
j = 1
FOR i = 1 TO 24
@ Lc()+1,0 SAY Strzero(i,2)+Subs(dscrn,j,80)
j = j + 80
NEXT && FOR i = 1 TO 24
*---------------
* Print the Gets
*---------------
IF output = 'PRINTER' .AND. prt # 'Local Dot Matrix'
Ljcondense()
rpt_wid = 138
ENDIF && IF output = 'PRINTER' .AND. prt # 'Local Dot Matrix'
SELECT ScrnGets
SEEK Scr_file->Scrn_name
IF ! Eof()
Rpt_header(1,output,Lc(),.t.)
ENDIF
DO WHILE Scrn_name = Scr_file->Scrn_name .AND. ! Eof()
*-------------
* Escape route
*-------------
cxl = Inkey()
IF cxl = esc
EXIT
ENDIF
IF ! Enuf_ln(Lc(),lines,2)
Rpt_header(1,output,1,.t.)
ENDIF
@ Lc()+1,0 SAY G_var
@ Lc(),15 SAY G_row
@ Lc(),20 SAY G_pic
@ Lc(),52 SAY G_when
@ Lc(),84 SAY Say_exp
@ Lc()+1,5 SAY Gs_flag
@ Lc(),15 SAY G_col
@ Lc(),20 SAY G_color
@ Lc(),52 SAY G_valid
@ Lc(),84 SAY Say_pict
@ Lc(),116 SAY Say_color
@ Lc()+1,0 SAY ''
SKIP
ENDDO
*---------------
* Print the Menu
*---------------
SELECT ScrnMenu
SEEK Scr_file->Scrn_name
phdr = 'Menu_hdr'
rpt_wid = 117
IF ! Eof()
Rpt_header(1,output,Lc(),.t.)
ENDIF
DO WHILE Scrn_name = Scr_file->Scrn_name .AND. ! Eof()
*-------------
* Escape route
*-------------
cxl = Inkey()
IF cxl = esc
EXIT
ENDIF
IF ! Enuf_ln(Lc(),lines,2)
Rpt_header(1,output,1,.t.)
ENDIF
@ Lc()+1,0 SAY M_func
@ Lc(),43 SAY M_row
@ Lc(),47 SAY Trim(M_prompt)
@ Lc()+1,43 SAY M_col
@ Lc(),47 SAY M_msg
@ Lc()+1,0 SAY ''
SKIP
ENDDO
*---------------
* Print the Rpt Record
*---------------
SELECT ScrnRpts
SEEK Scr_file->Scrn_name
phdr = 'Rpt_hdr'
rpt_wid = 89
SET MARGIN TO 10
IF ! Eof()
Lj10()
Rpt_header(1,output,Lc(),.t.)
@ Lc()+2,0 SAY 'Report Name: '+RptName
@ Lc()+2,0 SAY 'Page Header Proc: '+Phdr
@ Lc()+2,0 SAY 'Detail Proc: '+Detproc
@ Lc()+2,0 SAY 'Main Condition: '+Trim(MainCond)
@ Lc()+2,0 SAY 'Detail Condition: '+Trim(Detcond)
@ Lc()+2,0 SAY 'Footer Proc: '+FtrProc
@ Lc()+2,0 SAY 'Report Width: '+Ltrim(Str(Rpt_wid,3))
@ Lc()+2,0 SAY 'Left Margin: '+Ltrim(Str(Lm,2))
ENDIF
IF output = 'PRINTER'
IF prt # 'Local Dot Matrix' &&Epson FX'
mem_defprt = 'HP Laser'
Ljreset()
ELSE && OTHERWISE...
mem_defprt = 'Epson FX'
Epson10()
ENDIF
ENDIF && IF output = 'PRINTER'
SET MARGIN TO 0
Eorpt(send_ff)
IF output = 'SCREEN'
scrn_rec = RptToDBF(scrn_file)
IF scrn_rec > 0
Brpt(1,0,23,79,rpt_wid,scrn_file)
ENDIF && IF scrn_rec > 0
CleanRPT(scrn_file)
ENDIF && IF output = 'SCREEN'
END && BEGIN SEQUENCE
SELECT Scr_file
Setcolor(poldcolor)
Restscreen(1,0,24,79,temp)
RETURN
PROC Gets_hdr
PARA page, ln
PRIV tit1, tit2, tit3, var
tit1 = "Screen Manager Screen Report"
tit2 = "Screen Name: "+Trim(Scrn_name)
@ Lc()+1,0 SAY page PICT "@R Page: ###"
@ Lc(),Rpt_centr(tit1,rpt_wid) SAY tit1
@ Lc(), rpt_wid-15 SAY "As Of: "+Dtoc(Date())
@ Lc()+2,Rpt_centr(tit2,rpt_wid) SAY tit2
@ Lc()+2,0 SAY "Variable Row GET Picture PreCondition SAY Expression"
@ Lc()+1,0 SAY "GS Flag Col GET Color PostCondition SAY Picture SAY Color"
@ Lc()+1,0 SAY "───────────── ─── ────────────────────────────── ────────────────────────────── ────────────────────────────── ────────────────────"
* 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
* 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
RETURN
PROC Menu_hdr
PARA page, ln
PRIV tit1, tit2, tit3, var
tit1 = "Screen Manager Screen Report"
tit2 = "Screen Name: "+Trim(Scrn_name)
@ Lc()+1,0 SAY page PICT "@R Page: ###"
@ Lc(),Rpt_centr(tit1,rpt_wid) SAY tit1
@ Lc(), rpt_wid-15 SAY "As Of: "+Dtoc(Date())
@ Lc()+2,Rpt_centr(tit2,rpt_wid) SAY tit2
@ Lc()+2,0 SAY " Row Menu Prompt"
@ Lc()+1,0 SAY "Menu Function Col Message"
@ Lc()+1,0 SAY "──────────────────────────────────────── ─── ──────────────────────────────────────────────────────────────────────"
*cccccccccccccccccccccccccccccccccccccccc cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
* 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
* 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
RETURN
PROC Rpt_hdr
PARA page, ln
PRIV tit1, tit2, tit3, var
tit1 = "Screen Manager Screen Report"
tit2 = "Screen Name: "+Trim(Scrn_name)
@ Lc()+1,0 SAY page PICT "@R Page: ###"
@ Lc(),Rpt_centr(tit1,rpt_wid) SAY tit1
@ Lc(), rpt_wid-15 SAY "As Of: "+Dtoc(Date())
@ Lc()+2,Rpt_centr(tit2,rpt_wid) SAY tit2
*cccccccccccccccccccccccccccccccccccccccc cc cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
* 0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
* 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
RETURN
* EOF: Memprtsc.prg