Sub Blend(c1 As Long, c2 As Long, c3 As Long, c4 As Long)
Dim x As Integer, y As Integer, b As Integer Dim a As Integer, stepsize(1 To 3) As Single Dim col(1) As Long x = ScaleWidth - 1 y = ScaleHeight - 1 AutoRedraw = True ScaleMode = vbPixels 'Set the colours in each corner... PSet (0, 0), c1 PSet (x, 0), c2 PSet (0, y), c3 PSet (x, y), c4 'Then blend each side going downwards... col(0) = c1 col(1) = c3 stepsize(1) = (Red(col(1)) - Red(col(0))) / y stepsize(2) = (Green(col(1)) - Green(col(0))) / y stepsize(3) = (Blue(col(1)) - Blue(col(0))) / y For a = 1 To y - 1 PSet (0, a), RGB(Red(col(0)) + a * stepsize(1), _ Green(col(0)) + a * stepsize(2), _ Blue(col(0)) + a * stepsize(3)) Next col(0) = c2 col(1) = c4 stepsize(1) = (Red(col(1)) - Red(col(0))) / y stepsize(2) = (Green(col(1)) - Green(col(0))) / y stepsize(3) = (Blue(col(1)) - Blue(col(0))) / y For a = 1 To y - 1 PSet (x, a), RGB(Red(col(0)) + a * stepsize(1), _ Green(col(0)) + a * stepsize(2), _ Blue(col(0)) + a * stepsize(3)) Next 'Now blend horizontally! For b = 0 To y col(0) = Point(0, b) col(1) = Point(x, b) stepsize(1) = (Red(col(1)) - Red(col(0))) / x stepsize(2) = (Green(col(1)) - Green(col(0))) / x stepsize(3) = (Blue(col(1)) - Blue(col(0))) / x For a = 1 To x PSet (a, b), RGB(Red(col(0)) + a * stepsize(1), _ Green(col(0)) + a * stepsize(2), _ Blue(col(0)) + a * stepsize(3)) Next Next End Sub '~~~Red Function Red(mlColor) As Integer Red = mlColor And &HFF End Function '~~~Green Function Green(mlColor) As Integer Green = (mlColor \ &H100) And &HFF End Function '~~~Blue Function Blue(mlColor) As Integer Blue = (mlColor \ &H10000) And &HFF End Function '---====[ pAssed by vbTips32 codeBook ]====--- Assumes:Remember these few pointers... - The form must have a Scalemode of vbPixels (I hate twips!) - For safety's sake set Autoredraw to True - THIS CODE MUST BE PLACED IN THE FORM MODULE! |