FormBlend




Option Explicit
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Sub Blend(c1 As Long, c2 As Long, c3 As Long, c4 As Long, frm As Form)
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
Const iBlockSize As Integer = 6
With frm
.ScaleMode = 3
x = .ScaleWidth - 1
Y = .ScaleHeight - 1
.AutoRedraw = True
.FillStyle = 0
.DrawStyle = 5
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 = 0 To Y Step iBlockSize
SetPixel .hdc, 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 = 0 To Y Step iBlockSize
SetPixel .hdc, x, a, RGB(Red(col(0)) + a * stepsize(1), _
Green(col(0)) + a * stepsize(2), Blue(col(0)) + a * stepsize(3))
Next
For b = 0 To Y Step iBlockSize
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 Step iBlockSize
.FillColor = RGB(Red(col(0)) + a * stepsize(1), _
Green(col(0)) + a * stepsize(2), Blue(col(0)) + a * stepsize(3))
Rectangle .hdc, a - 1, b - 1, a + iBlockSize, b + iBlockSize
Next
Next
End With
End Sub

Private Function Red(mlColor) As Integer
Red = mlColor And &HFF
End Function

Private Function Green(mlColor) As Integer
Green = (mlColor \ &H100) And &HFF
End Function

Private Function Blue(mlColor) As Integer
Blue = (mlColor \ &H10000) And &HFF
End Function

Private Sub Form_Load()
Blend vbBlue, vbRed + vbBlue, vbWhite, vbGreen, Me
End Sub











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