• Home
 · 
• Custom Controls/Forms/Menus
 · 
• Shade objects which have properties like line,pset. It shades in many ways as you pass the argument

Shade objects which have properties like line,pset. It shades in many ways as you pass the argument

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
'





Rate Shade objects which have properties like line,pset. It shades in many ways as you pass the argument

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    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