'===========================================================================
' Subject: BOX ZOOM                          Date: 05-20-97 (15:00)       
' Author:  Nick Kochakian                    Code: QB, QBasic, PDS        
' Origin:  NickK@worldnet.att.net          Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB cleargfx (x!, y!, size!)
DECLARE SUB zoomgfx (x!, y!, size!)
DECLARE SUB getgfx (x!, y!, x2!, y2!)
'Box zoom
'
'5/20/97 By: - Nick Kochakian -
'
'This isn't the fasest zoomer out there, but it could be used for an advanced
'sprite (get) and zoom put!
'
'If you have any comments or questions e-mail me at: nickk@worldnet.att.net
'
'Recommended for use only in QuickBasic... It's too slow in QBasic...

DIM SHARED bx
DIM SHARED by
DIM SHARED bc
bx = 200
by = 320
bc = bx + by

DIM SHARED boxx(bx) 'Box X
DIM SHARED boxy(by) 'Box Y
DIM SHARED boxc(bc) 'Box Color

SCREEN 13
LINE (0 + 5, 1 + 5)-(1 + 5, 0 + 5), 20, BF 'This is my example graphic
LINE (0 + 3, 1 + 5)-(1 + 3, 0 + 5), 25, BF 'This is my example graphic
LINE (0 + 3, 1 + 2)-(1 + 3, 0 + 2), 25, BF 'This is my example graphic
LINE (0 + 7, 1 + 2)-(1 + 7, 0 + 2), 30, BF 'This is my example graphic
LINE (0 + 1, 1 + 7)-(1 + 1, 0 + 7), 30, BF 'This is my example graphic

'x,y = Starting points (Probally should be top left corner of your box)
'x2,y2 = Ending points (Probally should be bottom right corner of your box)

CALL getgfx(1, 1, 10, 10) 'Get the pixels

x = 10
y = 10

FOR siz = 1 TO 10
CALL cleargfx(x, y, siz - 1) 'This will clear the old zoomed image
'PAINT (1, 1), 1 'Comment the cleargfx call and uncomment this paint command
                 '... If you had a fast background put (like the BLAST put)
                 'you could zoom these images fine without destroying the
                 'background!
CALL zoomgfx(x, y, siz) 'Zoom the image
NEXT siz

SUB cleargfx (x, y, size)
bx = 1
by = 1
bc = 1

x1 = 0
y1 = .1
x2 = .1
y2 = 0

times = -1

px = x
py = y
'size = 1

zoom = size

FOR i = 1 TO zoom

px = x
py = y

DO
LINE (cx - x1 + px * size, cy - y1 + py * size)-(cx - x2 + px * size, cy - y2 + py * size), 0, BF
'IF boxc(bc) = 0 THEN LINE (x1 + px, y1 + py)-(x2 + px, y2 + py), 0, B
'LINE (x1 + px, y1 + py)-(x2 + px, y2 + py), boxc(bc), BF
px = px + 1
bc = bc + 1
bx = bx + 1
by = by + 1
'FOR a = 1 TO 999
'NEXT a
IF boxx(bx) = -2 THEN px = x: py = py + 1: bx = bx + 1: by = by + 1: bc = bc + 1
LOOP UNTIL boxc(bc) = -2
times = times + 1
IF times = 0 THEN y1 = 0: x2 = 0: y1 = y1 + .5: x2 = x2 - .5: x1 = x1 + .5: y2 = y2 - .5


y1 = y1 + .5
x2 = x2 - .5
x1 = x1 + .5
y2 = y2 - .5

'size = size + 1

bx = 1
by = 1
bc = 1
NEXT i

END SUB

SUB getgfx (x, y, x2, y2)

bx = 1
by = 1
bc = 1

px = x
py = y

DO
col = POINT(px, py)
boxc(bc) = col
boxx(bx) = px
boxy(by) = py
bx = bx + 1
by = by + 1
bc = bc + 1
px = px + 1
IF px > x2 THEN px = x: py = py + 1: boxx(bx) = -2: bx = bx + 1: by = by + 1: bc = bc + 1
LOOP UNTIL py >= y2
boxc(bc) = -2

bx = 1
by = 1
bc = 1
END SUB

SUB zoomgfx (x, y, size)
bx = 1
by = 1
bc = 1

x1 = 0
y1 = .1
x2 = .1
y2 = 0

times = -1

px = x
py = y
'size = 1

zoom = size

FOR i = 1 TO zoom

px = x
py = y

DO
IF boxc(bc) > 0 THEN LINE (cx - x1 + px * size, cy - y1 + py * size)-(cx - x2 + px * size, cy - y2 + py * size), boxc(bc), BF
'IF boxc(bc) = 0 THEN LINE (x1 + px, y1 + py)-(x2 + px, y2 + py), 0, B
'LINE (x1 + px, y1 + py)-(x2 + px, y2 + py), boxc(bc), BF
px = px + 1
bc = bc + 1
bx = bx + 1
by = by + 1
'FOR a = 1 TO 999
'NEXT a
IF boxx(bx) = -2 THEN px = x: py = py + 1: bx = bx + 1: by = by + 1: bc = bc + 1
LOOP UNTIL boxc(bc) = -2
times = times + 1
IF times = 0 THEN y1 = 0: x2 = 0: y1 = y1 + .5: x2 = x2 - .5: x1 = x1 + .5: y2 = y2 - .5


y1 = y1 + .5
x2 = x2 - .5
x1 = x1 + .5
y2 = y2 - .5

'size = size + 1

bx = 1
by = 1
bc = 1
NEXT i

END SUB