by Sherebiah Tishbi (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 8th September 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Shade objects which have properties like line,pset. It shades in many ways as you pass the argument in function parameter
API Declarations
'Paste the code into your module or form
'Function Parameters are
'1. Object(Must)
'2. (Optional)(Default-H)Type of Shade(H-Horizontal,V-Vertical,B-Box,CC-Center circle,RTL-Rainbow Top Left, RTR-Rainbow Top Right,RBL-Rainbow Bottom Left,RBR-Rainbow Bottom right,RTC-Rainbow Top Center,RBC-Rainbow Bottom Center,RLC-Rainbow Left Center,RRC-Rainbow Right Center,T-Tinted
3.(Optional) Red Color Value
4.(Optional) Green Colour value
5.(Optional) Blue color value
'
VBcoders
Dim maxY, xRat, yRat, x, maxX
Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
Dim xbyy As Double, ybyx As Double, clrval As Double
Dim LopVal As Double
maxX = Frm.ScaleWidth
maxY = Frm.ScaleHeight
If Len(Flag) = 0 Then
Flag = "H"
End If
If rVal <= 0 Or rVal > 255 Then
rVal = 255
End If
If gVal <= 0 Or gVal > 255 Then
gVal = 255
End If
If bVal <= 0 Or bVal > 255 Then
bVal = 255
End If
Select Case Flag
Case "B"
xbyy = maxX / maxY
ybyx = maxY / maxX
x = bVal / 71
x1 = 1
x2 = maxX
y1 = 1
y2 = maxY
Frm.Line (x1, y1)-(x2, y2), RGB(rVal, gVal, bVal), B
For i = 0 To maxX / 2 Step 0.7
clrval = clrval + x
y1 = (x1 + i) * ybyx
x1 = (y1 + i) * xbyy
x2 = maxX - x1
y2 = maxY - y1
Frm.Line (x1, y1)-(x2, y2), RGB(rVal, gVal, clrval), BF
If x2 < maxX / 2 Then Exit For
Next i
Case "H"
x = bVal / maxY
For i = 0 To maxY
clrval = clrval + x
Frm.Line (0, i)-(maxX, i), RGB(rVal, gVal, clrval)
Next
Case "V"
x = bVal / maxX
For i = 0 To maxX
clrval = clrval + x
Frm.Line (i, 0)-(i, maxY), RGB(rVal, gVal, clrval)
Next
Case "RTL"
LopVal = (maxX) * (maxX)
LopVal = LopVal + ((maxY) * (maxY))
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (0, 0), i, RGB(rVal, gVal, clrval)
Next
Case "RTR"
LopVal = (maxX) * (maxX)
LopVal = LopVal + ((maxY) * (maxY))
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (maxX, 0), i, RGB(rVal, gVal, clrval)
Next
Case "RBL"
LopVal = (maxX) * (maxX)
LopVal = LopVal + ((maxY) * (maxY))
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (0, maxY), i, RGB(rVal, gVal, clrval)
Next
Case "RBR"
LopVal = (maxX) * (maxX)
LopVal = LopVal + ((maxY) * (maxY))
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To lopal
clrval = clrval + x
Frm.Circle (maxX, maxY), i, RGB(rVal, gVal, clrval)
Next
Case "CC"
LopVal = (maxX / 2) * (maxX / 2)
LopVal = LopVal + ((maxY / 2) * (maxY / 2))
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (maxX / 2, maxY / 2), i, RGB(rVal, gVal, clrval)
Next
Case "RTC"
LopVal = (maxX / 2) * (maxX / 2)
LopVal = LopVal + (maxY * maxY)
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (maxX / 2, 0), i, RGB(rVal, gVal, clrval)
Next
Case "RBC"
LopVal = (maxX / 2) * (maxX / 2)
LopVal = LopVal + (maxY * maxY)
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (maxX / 2, maxY), i, RGB(rVal, gVal, clrval)
Next
Case "RLC"
LopVal = (maxY / 2) * (maxY / 2)
LopVal = LopVal + (maxX * maxX)
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (0, maxY / 2), i, RGB(rVal, gVal, clrval)
Next
Case "RRC"
LopVal = (maxY / 2) * (maxY / 2)
LopVal = LopVal + (maxX * maxX)
LopVal = Round(Sqr(LopVal), 0)
x = bVal / LopVal
For i = 0 To LopVal
clrval = clrval + x
Frm.Circle (maxX, maxY / 2), i, RGB(rVal, gVal, clrval)
Next
Case "T"
For i = 0 To 50000
Frm.PSet (Rnd * maxX, Rnd * maxY), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
End Select
End Sub
No comments have been posted about Shade objects which have properties like line,pset. It shades in many ways as you pass the argument. Why not be the first to post a comment about Shade objects which have properties like line,pset. It shades in many ways as you pass the argument.