by Jonathan Liu (9 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 7th February 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradien. Why not be the first to post a comment about Gradient Module 1.0. This module includes a sub-routine for drawing horizontal and vertical gradien.