• Home
 · 
• Graphics
 · 
• Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradien

Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradien

Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradients and the reverse of them. It allows

API Declarations


'by Buttress Root Software
'
'Programmed by Jonathan Liu
'Copyright ©1999-2371 Buttress Root Software. All rights reserved.

Option Explicit



Rate Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradien

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Sub DrawGradient(Object As Object, sngHeight As Single, sngWidth As Single, sngRStart As Single, _
            sngGStart As Single, sngBStart As Single, sngREnd As Single, sngGEnd As Single, _
            sngBEnd As Single, blnHorizontal As Boolean, blnReverse As Boolean)

'Resume if an error occurs
On Error GoTo ErrHandler

'Declare variables
Dim dblR As Double
Dim dblG As Double
Dim dblB As Double
Dim dblRStep As Double
Dim dblGStep As Double
Dim dblBStep As Double
Dim intStep As Integer
Dim sngStart As Single
Dim sngEnd As Single
Dim i As Single

'Configure form for drawing of gradient
Object.AutoRedraw = True    'Redraw form when necessary
Object.DrawMode = 13        'Change draw mode to 'Copy Pen'
Object.DrawStyle = 0        'Change draw style to 'Solid'
Object.DrawWidth = 1        'Change draw width to 1
Object.ScaleMode = 3        'Change scale mode to pixels

'Load initial variable values
dblR = sngREnd
dblG = sngGEnd
dblB = sngBEnd

If blnHorizontal = False Then
    dblRStep = (sngREnd - sngRStart) / sngHeight
    dblGStep = (sngGEnd - sngGStart) / sngHeight
    dblBStep = (sngBEnd - sngBStart) / sngHeight
Else
    dblRStep = (sngREnd - sngRStart) / sngWidth
    dblGStep = (sngGEnd - sngGStart) / sngWidth
    dblBStep = (sngBEnd - sngBStart) / sngWidth
End If

'Modify variables to suit sub-routine parameters
If blnHorizontal = False And blnReverse = True Then
    intStep = 1
    sngStart = -1
    sngEnd = sngHeight
ElseIf blnHorizontal = False And blnReverse = False Then
    intStep = -1
    sngStart = sngHeight
    sngEnd = -1
ElseIf blnHorizontal = True And blnReverse = True Then
    intStep = 1
    sngStart = -1
    sngEnd = sngWidth
ElseIf blnHorizontal = True And blnReverse = False Then
    intStep = -1
    sngStart = sngWidth
    sngEnd = -1
End If

'Draw requested gradient
If blnHorizontal = True Then
    'Draw horizontal gradient
    For i = sngStart To sngEnd Step intStep
        'Prevent run-time errors when any of the RGB values have a negative value
        If dblR < sngRStart Then dblR = sngRStart
        If dblG < sngGStart Then dblG = sngGStart
        If dblB < sngBStart Then dblB = sngBStart
        
        'Draw line
        Object.Line (i, 0)-(i, sngHeight), RGB(Int(dblR), Int(dblG), Int(dblB))
        Object.Line (i + 0.5, 0)-(i + 0.5, sngHeight), RGB(Int(dblR), Int(dblG), _
            Int(dblB))
        
        'Darken colour
        dblR = dblR - dblRStep
        dblG = dblG - dblGStep
        dblB = dblB - dblBStep
    Next i
Else
    'Draw vertical gradient
    For i = sngStart To sngEnd Step intStep
        'Prevent run-time errors when any of the RGB values have a negative value
        If dblR < sngRStart Then dblR = sngRStart
        If dblG < sngGStart Then dblG = sngGStart
        If dblB < sngBStart Then dblB = sngBStart
        
        'Draw line
        Object.Line (0, i)-(sngWidth, i), RGB(Int(dblR), Int(dblG), Int(dblB))
        Object.Line (0, i + 0.5)-(sngWidth, i + 0.5), RGB(Int(dblR), Int(dblG), _
            Int(dblB))
        
        'Darken colour
        dblR = dblR - dblRStep
        dblG = dblG - dblGStep
        dblB = dblB - dblBStep
    Next i
End If

ErrHandler: Exit Sub
End Sub