'===========================================================================
' Subject: DIRECTQB SMOOTH ROUTINE           Date: 04-23-99 (12:17)       
' Author:  Matthias-Emanuel Thoemmes         Code: QB, PDS                
' Origin:  mail@actlab.de                  Packet: DIRECTQB.ABC
'===========================================================================
'DirectQB 1-5 Smoothing using RGB Values
'
'by actlab - The official german QuickBasic Website 1999
'http://www.actlab.de and http://www.qbasic.de
'
'This Routine smooths any Image of any Size with any Palette.
'Today, the Routine is faster than the first one. Thanks to Angelo
'for the DQBfindPalCol routine !
'Hopefully you can use this Routine in your Games/Programms.
'
'Matthias-Emanuel Thoemmes

'$INCLUDE: 'DIRECTQB.BI'
DECLARE SUB DQBsmooth (x1%, y1%, x2%, y2%)
DIM SHARED Pal AS STRING * 768
IF DQBinit(1, 0) <> 0 THEN SYSTEM
SCREEN 13
'Make a simple Image with the standard Palette
A = DQBloadLayer(VIDEO, "C:\ADV\ENGINE\TITLE.PCX", Pal)
DQBsetPal Pal
DQBsmooth 0, 0, 320, 200

REM $DYNAMIC
SUB DQBsmooth (x1, y1, x2, y2)
'Get the Palette
A$ = STRING$(768, 0)
DQBgetPal A$
FOR x = x1 TO x2
FOR y = y1 TO y2
'Get the RGB Values of the Pixel and the Pixels around.
C0 = DQBpoint(VIDEO, x, y)
DQBgetCol C0, SR0, SG0, SB0
c1 = DQBpoint(VIDEO, x + 1, y)
DQBgetCol c1, SR1, SG1, SB1
c2 = DQBpoint(VIDEO, x, y + 1)
DQBgetCol c2, SR2, SG2, SB2
c3 = DQBpoint(VIDEO, x - 1, y)
DQBgetCol c1, SR3, SG3, SB3
C4 = DQBpoint(VIDEO, x, y - 1)
DQBgetCol C4, SR4, SG4, SB4
'Smooth with RGB.
SR = (SR1 + SR2 + SR3 + SR4) / 4
SG = (SG1 + SG2 + SG3 + SG4) / 4
SB = (SB1 + SB2 + SB3 + SB4) / 4
'Find the closest RGB Value in the Palette.
C = DQBfindPalCol(A$, SR, SG, SB)
DQBpset VIDEO, x, y, C
NEXT y
NEXT x
END SUB