LineGrad




Private Sub Form_click()
On Error Resume Next
z1 = 1 'Left side present (0-Off 1-On)
z2 = 1 'Right side present (0-Off 1-On)
r1 = 0 'Center color (R Value)
g1 = 255 'Center color (G Value)
b1 = 0 'Center color (B Value)
orr = 0 'Fade to color (R Value)
org = 0 'Fade to color (G Value)
orb = 255 'Fade to color (B Value)
Y1 = 0 'Starting position (Y Value)
Y2 = Me.Height 'Height of Pipe
X1 = 0 'Starting position (X Value)
a = 10 'Width of Pipe
r = r1 'Current R Value
g = g1 'Current G Value
B = b1 'Current B Value
'-----Left Side-----'

For x = X1 To X1 + a
r = r + (255 / (a / z1)) 'Gradient Color
g = g + (255 / (a / z1)) '" "
B = B + (255 / (a / z1)) '" "
If r = orr Or r > orr Then r = orr 'Determines if at color limit
If g = org Or g > org Then g = org '" "
If B = orb Or B > orb Then B = orb '" "
c = RGB(r, g, B) 'Make color
Line (x, Y1)-(x, Y2), c, B 'Draw part of pipe
Next

r = r1 'Reset Colors
g = g1 '" "
B = b1 '" "
X1 = x 'Reset Location
'-----Right Side-----'


For x = X1 + a To X1 Step -1
r = r + (255 / (a / z2)) 'Gradient Color
g = g + (255 / (a / z2)) '" "
B = B + (255 / (a / z2)) '" "
If r = orr Or r > orr Then r = orr 'Determines if at color limit
If g = org Or g > org Then g = org '" "
If B = orb Or B > orb Then B = orb '" "
c = RGB(r, g, B) 'Make color
Line (x, Y1)-(x, Y2), c, B 'Draw part of pipe
Next

End Sub










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