Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : LASER.ZIP
Filename : DEMO.PRG

**************************************
* demo.prg (Clipper specific)
*
* Demo of HP LaserJet Routines to draw lines and boxes.
*
* Written 12/89 by
* Kevin Talbot
* KJT enterprises
* 7632 SE 37th Place
* Mercer Island, WA 98040
* (206) 236-1060
* Compuserve ID: 75706,316
*
* This program is "public domain" and is free for anyone to use or modify.
* Acknowledgement of the author would be appreciated.


* Notes: Requires to module LASER.PRG for proper functioning.
* Assumes 'set print on' will connect with your LaserJet.

save screen to foo
clear
store 0.0 to r,c,x,y,l,h,w,t,func
store " " to f
store " " to o
set confirm on
set print on
set device to screen
set console off
set wrap on
msg = 17
status = 23

do laser && drag in the functions automatically during compile


do while func != 7

set device to screen
clear
func = 1
set message to msg center
@ 3,27 say "LaserJet Function Demonstration"
@ 2,10 to 15,69 double
@ 4,11 to 4,68
@ 6,27 prompt " Lines " ;
message "Draws horizontal and vertical lines"

@ 7,27 prompt " Filled rectangles " ;
message "Draws pattern-filled rectangles"

@ 8,27 prompt " Text Position (@ r,c) " ;
message "For correlating text via 'lj_say() and graphics 'x,y' positions"

@ 9,27 prompt " Boxes " ;
message "Draws ruled boxes (not filled in, just the borders)"

@ 10,27 prompt ' Add .25" Grid & Print ' ;
message 'Adds a 1/4" grid for reference and then prints the page'

@ 11,27 prompt ' Add .10" Grid & Print ' ;
message 'Adds a 1/10" grid for reference and then prints the page'

@ 12,27 prompt " Print Page w/o Grid " ;
message "Prints the page as is w/o reference grid"

@ 13,27 prompt " Quit WITHOUT Printing " ;
message "Return to DOS WITHOUT printing the page"

menu to func

do case

case func = 1 && draw lines
do while lastkey() <> 27
clear
@ 2,10 say " Draw Line in INCHES ([Esc] to Quit)"
@ 4,10 say " Start at x:" get x picture "9999.999"
@ 6,10 say " y:" get y picture "9999.999"
@ 8,10 say " Length:" get l picture "9999.999"
@ 10,10 say " Thickness:" get t picture "9999.999"
@ 12,10 say " Orientation (H/V):" get o picture "!"
@ 14,10 say " % Gray or Pattern #:" get f
read
if lastkey() != 27
@ status,26 say "Sending Data To Printer..."
lj_gotoxy(x,y)
lj_line(l,t,o,f)
@ status,0
endif
enddo

case func = 2 && filled rectangles
do while lastkey() <> 27
clear
@ 2,10 say " Filled Rectangles in INCHES ([Esc] to Quit)"
@ 4,10 say " Upper left at x:" get x picture "9999.999"
@ 6,10 say " y:" get y picture "9999.999"
@ 8,10 say " Width:" get w picture "9999.999"
@ 10,10 say " Height:" get h picture "9999.999"
@ 12,10 say "% Gray or Pattern #:" get f
read
if lastkey() != 27
@ status,26 say "Sending Data To Printer..."
lj_gotoxy(x,y)
lj_fill(w,h,f)
@ status,0
endif
enddo

case func = 3 && position text and print grid
setprc(0,0)
do while lastkey() <> 27
set device to screen
clear
@ 2,10 say " Text Position via 'lj_say()' ([Esc] to Quit)"
@ 4,10 say " Row:" get r picture "99" range 0,59
@ 6,10 say " Col:" get c picture "99" range 0,80
@ 10,10 say "(The character 'Û' will be printed at r,c)"
read
if lastkey() != 27
@ status,26 say "Sending Data To Printer..."
set device to print
string = alltrim(str(r,2)) + "," + alltrim(str(c,2))
if (c + len(string) +1) > 78
lj_say(r,c-len(string), string + 'Û')
else
lj_say(r,c,"Û" + string)
endif
@ status,0
endif
enddo


case func = 4 && draw boxes
do while lastkey() <> 27
clear
@ 2,10 say " Draw a box in INCHES ([Esc] to Quit)"
@ 4,10 say " Upper left at x:" get x picture "9999.999"
@ 6,10 say " y:" get y picture "9999.999"
@ 8,10 say " Width:" get w picture "9999.999"
@ 10,10 say " Height:" get h picture "9999.999"
@ 12,10 say " Thickness:" get t picture "9999.999"
@ 14,10 say "% Gray or Pattern #:" get f
read
if lastkey() != 27
@ status,26 say "Sending Data To Printer..."
lj_gotoxy(x,y)
lj_box(w,h,t,f)
@ status,0
endif
enddo


case func = 5 && print page w/ 1/4" grid
@ status,26 say "Sending Data To Printer..."
do grid4
@ status,0
eject


case func = 6 && print page w/ 1/10" grid
@ status,26 say "Sending Data To Printer..."
do grid10
@ status,0
eject


case func = 7 && print page w/o grid
eject


case func = 8 && quit
restore screen from foo
quit

endcase

enddo

restore screen from foo

return



procedure grid4

private i, wide, nar, one_dot
one_dot = 0.0033333333
wide= 5 * one_dot
med = 3 * one_dot
nar = 1 * one_dot

* draw horizontal 1" lines
for i = 0.0 to 10.0
lj_gotoxy(0.0,i)
lj_line(9.0,wide,"H","100")
next

* draw vertical 1" lines
for i = 0.0 to 8.0
lj_gotoxy(i,0.0)
lj_line(11.0,wide,"V","100")
next
* fake in the line @ 8"
lj_gotoxy(7.987,0.0)
lj_line(11.0,wide,"V","100")

* draw horizontal 1/2" lines
for i = 0.5 to 10.0
lj_gotoxy(0.0,i)
lj_line(9.0,med,"H","100")
next

* draw vertical 1/2" lines
for i = 0.5 to 8.0
lj_gotoxy(i,0.0)
lj_line(11.0,med,"V","100")
next

* draw horizontal 1/4" lines
for i = 0.25 to 10.25 step 0.5
lj_gotoxy(0.0,i)
lj_line(9.0,nar,"H","100")
next

* draw vertical 1/4" lines
for i = 0.25 to 8.0 step 0.5
lj_gotoxy(i,0.0)
lj_line(11.0,nar,"V","100")
next


return



procedure grid10

* draws a 1/10" grid on the page

private i, wide, nar, one_dot
one_dot = 0.0033333333
wide= 5 * one_dot
med = 3 * one_dot
nar = 1 * one_dot

* draw horizontal 1" lines
for i = 0.0 to 10.0
lj_gotoxy(0.0,i)
?? ltrim(str(i,4))
lj_gotoxy(0.0,i)
lj_line(9.0,wide,"H","100")
next

* draw vertical 1" lines
for i = 0.0 to 8.0
lj_gotoxy(i,0.0)
?? ltrim(str(i,4))
lj_gotoxy(i,0.0)
lj_line(11.0,wide,"V","100")
next
* fake in the line @ 8"
lj_gotoxy(7.987,0.0)
lj_line(11.0,wide,"V","100")

* draw horizontal 1/2" lines
for i = 0.5 to 10.0
lj_gotoxy(0.0,i)
lj_line(9.0,med,"H","100")
next

* draw vertical 1/2" lines
for i = 0.5 to 8.0
lj_gotoxy(i,0.0)
lj_line(11.0,med,"V","100")
next

* draw horizontal 1/10" lines
for i = 0.1 to 10.3 step 0.1
lj_gotoxy(0.0,i)
lj_line(9.0,nar,"H","100")
next

* draw vertical 1/10" lines
for i = 0.1 to 8.0 step 0.1
lj_gotoxy(i,0.0)
lj_line(11.0,nar,"V","100")
next


return