home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
clarion
/
library
/
pcx3
/
paint.cla
< prev
next >
Wrap
Text File
|
1992-08-19
|
11KB
|
376 lines
! PCX LEM Demo
! don't expect much, OK?
! Select icon tool and color with mouse
! press number keys 0-9 to select a pattern
! This program uses it's own mouse cursor.
! Esc quits
! Right mouse button will start new screen
PAINT PROGRAM
INCLUDE('STD_KEYS.CLA')
INCLUDE('PCX3.CPY')
SCREEN SCREEN PRE(SCR),HUE(7,1)
ROW(1,1) PAINT(2,80),HUE(15,0)
ROW(2,67) PAINT(24,14),HUE(15,0)
ROW(24,1) PAINT(2,66),HUE(15,0)
ROW(3,1) PAINT(22,15),HUE(15,0)
ROW(3,66) PAINT(21,2),HUE(15,1)
ROW(2,16) PAINT(1,52),HUE(15,1)
COL(16) STRING('╔═{50}╗'),ENH
ROW(3,67) STRING('║'),ENH
ROW(4,66) STRING('─╢'),ENH
ROW(5,67) REPEAT(18);STRING('║'),ENH .
ROW(23,66) STRING('═╝'),ENH
ROW(3,16) STRING('║'),ENH
ROW(4,16) STRING('╟─{49}'),ENH
ROW(5,16) REPEAT(18);STRING('║'),ENH .
ROW(23,16) STRING('╚═{49}'),ENH
ROW(3,35) STRING('Select Options')
ROW(6,30) STRING('1'),ENH
COL(31) STRING('-EGA,')
COL(37) STRING('2'),ENH
COL(38) STRING('-VGA,')
COL(44) STRING('3'),ENH
COL(45) STRING('-ET3000,')
COL(54) STRING('4'),ENH
COL(55) STRING('-ET4000')
ROW(7,30) STRING('5'),ENH
COL(31) STRING('-Paradise, 6-ATI(')
COL(48) STRING('?'),ENH
COL(49) STRING('), 7-Video 7(')
COL(62) STRING('?'),ENH
COL(63) STRING(')')
ROW(9,30) STRING('1'),ENH
COL(31) STRING('-EPSON,')
COL(39) STRING('2'),ENH
COL(40) STRING('-HP LASERJET,')
COL(54) STRING('3'),ENH
COL(55) STRING('-HP Gray')
ROW(11,30) STRING('A'),ENH
COL(32) STRING('- 320x200 16 colors - EGA/VGA/SVGA')
ROW(12,30) STRING('B'),ENH
COL(32) STRING('- 640x200 16 colors - EGA/VGA/SVGA')
ROW(13,30) STRING('C'),ENH
COL(32) STRING('- 640x350 16 colors - EGA/VGA/SVGA')
ROW(14,30) STRING('D'),ENH
COL(32) STRING('- 640x480 16 colors - VGA/SVGA')
ROW(15,30) STRING('E'),ENH
COL(32) STRING('- 800x600 16 colors - SVGA')
ROW(16,30) STRING('F'),ENH
COL(32) STRING('- 320x200 256 colors - VGA/SVGA')
ROW(17,30) STRING('G'),ENH
COL(32) STRING('- 640x400 256 colors - SVGA')
ROW(18,30) STRING('H'),ENH
COL(32) STRING('- 640x480 256 colors - SVGA')
ROW(19,30) STRING('I'),ENH
COL(32) STRING('- 800x600 256 colors - SVGA')
ROW(20,30) STRING('J'),ENH
COL(32) STRING('- 1024x768 256 colors - SVGA')
ROW(10,49) ENTRY,USE(?FIRST_FIELD3)
ROW(6,19) STRING('VCARD :')
COL(27) ENTRY(@N1),USE(VCARD),ENH,SEL(0,7),OVR,REQ,NUM
ROW(9,19) STRING('PRINTER:')
COL(27) ENTRY(@N1),USE(PRINTER),ENH,SEL(0,7),OVR,REQ,NUM
ROW(11,19) STRING('VMODE :')
COL(27) ENTRY(@S1),USE(VMODE),ENH,SEL(0,7),OVR,REQ,LFT,UPR
ROW(22,31) PAUSE('Press Enter to Continue'),USE(?PAUSE_FIELD),ENH
.
VCARD BYTE !TYPE OF VIDEO CARD
PRINTER BYTE !TYPE OF PRINTER
VMODE STRING(1) !VIDEO MODE
MODES SHORT,DIM(10) !VIDEO MODE ARRAY
MOUSE STRING(50) !STRING TO HOLD MOUSE SHAPE
FILE STRING(40) !FILE TO LOAD OR SAVE
BLOBFILE STRING(40) !FILE TO LOAD OR SAVE
PAT STRING(8) !VARIABLE CREATED TO CHANGE
PATB BYTE,DIM(8),OVER(PAT) ! A DRAWING PATTERN
COLOR SHORT !DRAWING COLOR
CCOLOR SHORT !TEMP COLOR
PATTERN BYTE !DRAWING PATTERN
TOOL BYTE !DRAW TOOL
ROW SHORT !TEXT ROW
COL SHORT !TEXT COLUMN
WIDTH SHORT !SCREEN WIDTH
DEPTH SHORT !SCREEN HEIGHT
X SHORT !mouse variables...must be
Y SHORT ! declared as short
B SHORT !
OX SHORT !LAST MOUSE POSITION
OY SHORT !
OB SHORT !
XX SHORT !TEMP X
YY SHORT !TEMP Y
CODE
PATB[1] = 00000000b !change a default pattern
PATB[2] = 00111000b
PATB[3] = 01000100b
PATB[4] = 10010010b
PATB[5] = 10101010b
PATB[6] = 10010010b
PATB[7] = 01000100b
PATB[8] = 00111000b
SETPATTERN(2,PAT)
SETVMEM(2) !SVGA 512K
SETVMONITOR(3) !SVGA 800X600
DO GET_INFO !ASK FOR SCREEN SIZE, PRINTER
COLOR = 15 !COLOR = BRIGHT WHITE
PATTERN = 0 !PATTERN = 0
TOOL = 0 !TOOL = DRAW
ROW = 10 !DEFAULT TEXT ROW
COL = 30 !DEFAULT TEXT COLUMN
X = 100 !DEFAULT X
Y = 100 !DEFAULT Y
B = 0 !DEFAULT BUTTON STATUS
! MOUSE = 'R8G2F8G2H8G2U7RD5' !Standard mouse cursor
MOUSE = 'R9R9DL9L8D8D9LU9U9' !CORNER MOUSE CURSOR
MOUSEINIT !INITIALIZE MOUSE
LOOP !MAIN PROGRAM LOOP
WINDOW(0,0,WIDTH,DEPTH) !SET MOUSE AREA
OX = X !SAVE X,Y,B
OY = Y !
OB = B !
SETPOS(OX,OY) !SET GRAPHIC CURSOR
IF TOOL = 7 OR TOOL = 10 OR TOOL = 13 !IF "CUT" OR "SAVE"
DRAW(MOUSE,256+15) !DRAW MOUSE ON SCREEN
ELSE
BLOB('MOUSE.BLB',OX,OY,1)
.
LOOP UNTIL OX<>X OR OY<>Y OR OB<>B !WAIT FOR NEXT MOVEMENT
GETMPOS(X,Y,B) !READ MOUSE POSITION
IF KEYBOARD() THEN BREAK.
.
SETPOS(OX,OY)
IF TOOL = 7 OR TOOL = 10 OR TOOL = 13
DRAW(MOUSE,256+15)
ELSE
BLOB('MOUSE.BLB',OX,OY,1)
.
IF KEYBOARD()
ASK
IF TOOL = 9 !TEXT MODE
SETCURSOR(ROW,COL)
TYPE(CHR(KEYCODE()))
COL += 1
ELSIF KEYCODE() >= 48 AND KEYCODE() <= 57 !NUMBER KEYS
PATTERN = KEYCODE() - 48 !SELECT PATTERN
DO SHOW_COLORS !DRAW PALETTE
ELSIF KEYCODE() = ESC_KEY THEN BREAK. !QUIT ON Esc
.
DO SHOW_XY !PUT X,Y COORDINATES ON SCREEN
IF B = 2 THEN DO SET_SCREEN;CYCLE. !CLEAR SCREEN ON RIGHT BUTTON
IF B = 1 !LEFT BUTTON PRESSED
IF Y < 20 AND X < 320 !SELECT A COLOR
COLOR = X/20 !
DO SHOW_COLORS !
CYCLE !
ELSIF Y < 40 AND X < 320 !SELECT A TOOL
T# = X/20 !HOLD TOOL NUMBER
IF T# = 11 THEN DO LOAD_PCX;CYCLE.
IF T# = 12 THEN DO SAVE_PCX;CYCLE.
IF T# = 13 THEN DO SAVE_BLOB.
IF T# = 14 THEN DO LOAD_BLOB.
TOOL = T# !SET NEW TOOL NUMBER
DO SHOW_COLORS
CYCLE
.
IF Y > 40 THEN DO SET_TOOL. !CURSOR IN DRAWING AREA
. .
SETVMODE(3) !TEXT MODE
RETURN
SET_TOOL ROUTINE
IF TOOL = 0 THEN DRAWTO(X,Y,COLOR);EXIT.
IF TOOL = 6 THEN FILL(X,Y,COLOR);EXIT.
IF TOOL = 8 THEN SETPCX('TEMP.PCX',X,Y,WIDTH(),DEPTH());IF ERROR();BEEP.EXIT.
IF TOOL = 9 THEN DO SET_ROW_COL;EXIT.
IF TOOL = 14 THEN BLOB(BLOBFILE,X,Y,2);IF ERROR() THEN BEEP.EXIT.
WINDOW(0,41,WIDTH,DEPTH)
SETPOS(X,Y)
XX = X
YY = Y
OX = X
OY = Y
cCOLOR = COLOR;if COLOR = 0 then COLOR = 15.
COLOR += 256
DO TOOL_DRAW
LOOP
GETMPOS(X,Y,B)
IF B = 0 THEN BREAK.
IF OX = X AND OY = Y THEN CYCLE.
DO SHOW_XY
DO TOOL_DRAW
OX = X
OY = Y
DO TOOL_DRAW
.
DO TOOL_DRAW
COLOR = cCOLOR
OX = X
OY = Y
IF TOOL = 7 !CUT
SAVEPCX('TEMP.PCX',XX,YY,X,Y)
ELSIF TOOL = 13
SAVEBLOB(BLOBFILE,XX,YY,X,Y)
ELSIF TOOL = 10 !PRINT
IF PRINTER = 1 THEN EPDUMP(XX,YY,X,Y,1,0);IF ERROR() THEN STOP(ERROR())..
IF PRINTER = 2 THEN HPDUMP(XX,YY,X,Y,1,0);IF ERROR() THEN STOP(ERROR())..
IF PRINTER = 3 THEN output(chr(13));HPDUMP(XX,YY,X,Y,0,256);IF ERROR() THEN STOP(ERROR())..
ELSE !ALL OTHERS
DO TOOL_DRAW
.
WINDOW(0,0,WIDTH,DEPTH)
EXIT
TOOL_DRAW ROUTINE
EXECUTE TOOL !SELECT TOOL FUNCTION
LINE(XX,YY,OX,OY,COLOR) !LINE
FRAME(XX,YY,OX,OY,COLOR) !FRAME
BOX(XX,YY,OX,OY,COLOR) !BOX
CIRCLE(XX,YY,XX-OX,YY-OY,COLOR) !CIRCLE
DISC(XX,YY,XX-OX,YY-OY,COLOR) !DISC
FRAME(XX,YY,OX,OY,COLOR) !FILL(NOT USED HERE)
FRAME(XX,YY,OX,OY,COLOR) !CUT
FRAME(XX,YY,OX,OY,COLOR) !PASTE(NOT USED HERE)
FRAME(XX,YY,OX,OY,COLOR) !TEXT(NOT USED HERE)
FRAME(XX,YY,OX,OY,COLOR) !PRINT
FRAME(XX,YY,OX,OY,COLOR) !SAVE
FRAME(XX,YY,OX,OY,COLOR) !LOAD
FRAME(XX,YY,OX,OY,COLOR) !SAVE BLOB
FRAME(XX,YY,OX,OY,COLOR) !BLOB
.
EXIT
LOAD_PCX ROUTINE
SETCURSOR(0,0)
TYPE(ALL(' ',40))
SETCURSOR(0,0)
FILE = INPUT('FILE TO LOAD: ')
SETPCX(FILE,0,41,WIDTH,DEPTH)
IF ERROR() THEN BEEP.
DO DRAW_TOOLS
EXIT
SAVE_PCX ROUTINE
SETCURSOR(0,0)
TYPE(ALL(' ',40))
SETCURSOR(0,0)
FILE = INPUT('FILE TO SAVE: ')
SAVEPCX(FILE,0,41,WIDTH,DEPTH)
IF ERROR() THEN STOP(ERROR()).
DO DRAW_TOOLS
EXIT
LOAD_BLOB ROUTINE
SETCURSOR(0,0)
TYPE(ALL(' ',40))
SETCURSOR(0,0)
BLOBFILE = INPUT('BLOB TO LOAD: ')
DO DRAW_TOOLS
EXIT
SAVE_BLOB ROUTINE
SETCURSOR(0,0)
TYPE(ALL(' ',40))
SETCURSOR(0,0)
BLOBFILE = INPUT('BLOB TO SAVE: ')
DO DRAW_TOOLS
EXIT
GET_INFO ROUTINE
MODES[1] = 13
MODES[2] = 14
MODES[3] = 16
MODES[4] = 18
MODES[5] = 258
MODES[6] = 19
MODES[7] = 256
MODES[8] = 257
MODES[9] = 259
MODES[10] = 261
OPEN(SCREEN)
SETCURSOR
DISPLAY
LOOP
ACCEPT
CASE FIELD()
OF ?FIRST_FIELD3
IF KEYCODE() = ESC_KEY THEN RETURN.
OF ?VCARD
SETVCARD(VCARD)
IF ERROR() THEN STOP(ERROR());SELECT(?);CYCLE.
OF ?PRINTER
IF PRINTER < 1 OR PRINTER > 3 THEN BEEP;SELECT(?);CYCLE.
OF ?VMODE
CLOSE(SCREEN)
SETVMODE(MODES[VAL(VMODE)-64]) !CONVERTS LETTER TO VESA CODE
IF ERROR() THEN OPEN(SCREEN);BEEP;CYCLE.
DO SET_SCREEN
BREAK
. .
EXIT
SET_SCREEN ROUTINE
SETVMODE(MODES[VAL(VMODE)-64]) !CONVERTS LETTER TO VESA CODE
IF ERROR() THEN STOP(ERROR()).
WIDTH = WIDTH()
DEPTH = DEPTH()
DO DRAW_TOOLS
EXIT
SHOW_COLORS ROUTINE
USEPATTERN(0)
BOX(1,1,20*16,20,0)
USEPATTERN(PATTERN)
LOOP Z# = 0 TO 15
BOX(Z#*20,0,Z#*20+20,20,Z#) !DRAW COLORS
FRAME(Z#*20,0,Z#*20+20,20,7) !DRAW COLOR BORDERS
FRAME(Z#*20,20,Z#*20+20,40,7) !DRAW TOOL BORDERS
.
FRAME(COLOR*20,0,COLOR*20+20,20,15) !HIGHLIGHT COLOR
FRAME(TOOL*20,20,TOOL*20+20,40,15) !HIGHLIGHT TOOL
EXIT
SET_ROW_COL ROUTINE
ROW = Y/16
COL = X/8 + 1
EXIT
SHOW_XY ROUTINE
SETCURSOR(2,34);TYPE(format(X,@p<<#p))
SETCURSOR(2,38);TYPE(format(Y,@p<<#p))
EXIT
DRAW_TOOLS ROUTINE
BLOB('TOOLBAR.BLB',0,0,0)
if error() then stop(error()).
LINE(0,40,WIDTH-1,40,7)
DO SHOW_COLORS
EXIT