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 |