FinalFn




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!










( finalfn.html )- by Paolo Puglisi - Modifica del 17/12/2023