by Jonathan Liu (9 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 16th January 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
High quality gradient. All the visual basic code on the site that creates gradients didn't create a high quality one so I made one myself.
VBcoders
Private Sub Form_Paint()
'Example on how to use the sub-routine
Gradient Me, 0, 0, 0, 52, 137, 255, False, True
End Sub
Private Sub Form_Resize()
'Example on how to use the sub-routine
Gradient Me, 0, 0, 0, 52, 137, 255, False, True
End Sub
Sub Gradient(frmForm As Form, lngRStart As Long, lngGStart As Long, lngBStart As Long, _
lngREnd As Long, lngGEnd As Long, lngBEnd As Long, blnHorizontal As Boolean, _
blnReverse As Boolean)
'High quality gradient sub-routine
'By Jonathan Liu
'
'Copyright ©1999-2371 Buttress Root Software. All rights reserved.
'Resume if an error occurs
On Error Resume Next
'Declare variables
Dim dblR As Double
Dim dblG As Double
Dim dblB As Double
Dim intStep As Integer
Dim lngStart As Long
Dim lngSend As Long
'Configure form for drawing of gradient
frmForm.BackColor = 0 'Change form background color to black
frmForm.DrawMode = 13 'Change draw mode to 'Copy Pen'
frmForm.DrawStyle = 0 'Change draw style to 'Solid'
frmForm.DrawWidth = 1 'Change draw width to 1
frmForm.ScaleMode = 3 'Change scale mode to pixels
'Load initial variable values
dblR = lngREnd
dblG = lngGEnd
dblB = lngBEnd
'Modify variables to suit sub-routine parameters
If blnHorizontal = False And blnReverse = True Then
intStep = 1
lngStart = 0
lngEnd = frmForm.ScaleHeight
ElseIf blnHorizontal = False And blnReverse = False Then
intStep = -1
lngStart = frmForm.ScaleHeight
lngEnd = 0
ElseIf blnHorizontal = True And blnReverse = True Then
intStep = 1
lngStart = 0
lngEnd = frmForm.ScaleWidth
ElseIf blnHorizontal = True And blnReverse = False Then
intStep = -1
lngStart = frmForm.ScaleWidth
lngEnd = 0
End If
'Draw requested gradient
If blnHorizontal = True Then
'Draw horizontal gradient
For i = lngStart To lngEnd Step intStep
DoEvents
'Prevent run-time errors when any of the RGB values have a negative value
If dblR < 0 Then dblR = 0
If dblG < 0 Then dblG = 0
If dblB < 0 Then dblB = 0
'Draw line
frmForm.Line (i, 0)-(i, frmForm.ScaleHeight), RGB(Int(dblR), Int(dblG), Int(dblB))
'Darken colour
dblR = dblR - 255 / frmForm.ScaleWidth
dblG = dblG - 255 / frmForm.ScaleWidth
dblB = dblB - 255 / frmForm.ScaleWidth
Next i
Else
'Draw vertical gradient
For i = lngStart To lngEnd Step intStep
DoEvents
'Prevent run-time errors when any of the RGB values have a negative value
If dblR < 0 Then dblR = 0
If dblG < 0 Then dblG = 0
If dblB < 0 Then dblB = 0
'Draw line
frmForm.Line (0, i)-(frmForm.ScaleWidth, i), RGB(Int(dblR), Int(dblG), Int(dblB))
'Darken colour
dblR = dblR - 255 / frmForm.ScaleHeight
dblG = dblG - 255 / frmForm.ScaleHeight
dblB = dblB - 255 / frmForm.ScaleHeight
Next i
End If
End Sub
No comments have been posted about High quality gradient. All the visual basic code on the site that creates gradients didn't create a. Why not be the first to post a comment about High quality gradient. All the visual basic code on the site that creates gradients didn't create a.