A simple (API-free) solution, to render gradient background on Forms- and PictureBoxes -
in arbitrary angles between 0° and 360°.
There's an "automatic quadrant-detection" built-in (for angles > 90°) -
which makes the Start-Color (Arg-Name: Color1) "move to different edges of the Canvas".
e.g. whilst:
DrawGradientOn Me, vbGreen, vbRed, 0
...will draw a horizontal gradient (vbGreen at the left- and vbRed at the right-hand-edge)
a call like:
DrawGradientOn Me, vbGreen, vbRed, 180
...will draw the horizontal gradient as well - with vbGreen and vbRed now "swapped"
(without changing the order of the 2 color-params)
Otherwise there's not much more to comment...
HTH
Olaf
in arbitrary angles between 0° and 360°.
There's an "automatic quadrant-detection" built-in (for angles > 90°) -
which makes the Start-Color (Arg-Name: Color1) "move to different edges of the Canvas".
e.g. whilst:
DrawGradientOn Me, vbGreen, vbRed, 0
...will draw a horizontal gradient (vbGreen at the left- and vbRed at the right-hand-edge)
a call like:
DrawGradientOn Me, vbGreen, vbRed, 180
...will draw the horizontal gradient as well - with vbGreen and vbRed now "swapped"
(without changing the order of the 2 color-params)
Otherwise there's not much more to comment...
Code:
Option Explicit
Private Sub Form_Resize()
DrawGradientOn Me, vbYellow, vbRed 'last param at 0 (or left out) draws a plain, horizontal gradient
' DrawGradientOn Me, vbYellow, vbRed, 90 'a vertical gradient
' DrawGradientOn Me, vbYellow, vbRed, 180 'horizontal again, but Color1 now starts at the right-edge of the Form
' DrawGradientOn Me, vbYellow, vbRed, 270 'vertical again, but Color1 now starts at the bottom-edge
End Sub
Sub DrawGradientOn(Canvas As Object, Color1, Color2, Optional ByVal aDeg#)
Dim sm: sm = Canvas.ScaleMode
Canvas.ScaleMode = vbPixels
Canvas.AutoRedraw = True
Canvas.DrawWidth = 2
Dim a#: a = -Abs(aDeg) * Atn(1) / 45 'convert parameter aDeg into radians
Dim d#: d = Abs(Cos(a)) * Canvas.ScaleWidth + Abs(Sin(a)) * Canvas.ScaleHeight 'calc. the "walking-distance"
'calculate the RGB-Components of the Start-Color (Color1)
Dim sR#: sR = (Color1 And &HFF&)
Dim sG#: sG = (Color1 And &HFF00&) \ &H100&
Dim sB#: sB = (Color1 And &HFF0000) \ &H10000
'and now the respective RGB-fractions for one step along the walking-distance (towards Color2)
Dim dR#: dR = ((Color2 And &HFF&) - sR) / d
Dim dG#: dG = ((Color2 And &HFF00&) \ &H100& - sG) / d
Dim dB#: dB = ((Color2 And &HFF0000) \ &H10000 - sB) / d
Dim x0#, s#, x1#, y1#, x2#, y2#, gColor&
Select Case Abs(aDeg Mod 360) 'shift x0, dependent on the quadrant we are in...
Case 90 To 180: x0 = x0 + Cos(a) * Canvas.ScaleWidth
Case 180 To 270: x0 = x0 + Cos(a) * Canvas.ScaleWidth - Sin(a) * Canvas.ScaleHeight
Case 270 To 360: x0 = x0 - Sin(a) * Canvas.ScaleHeight
End Select
For s = 0 To d 'Ok, let's draw "parallel, rotated lines" in a loop over the pixel-distance d
gColor = RGB(sR + s * dR, sG + s * dG, sB + s * dB) 'calculate the current gradient-color
PointRotate a, x0 + s, 0 + 8192, x1, y1 'rotate the line-start-point (result in x1 and y1)
PointRotate a, x0 + s, 0 - 8192, x2, y2 'rotate the line-end-point (result in x2 and y2)
Canvas.Line (Int(x1), Int(y1))-(Int(x2), Int(y2)), gColor 'draw a line between our rotated points
Next
Canvas.ScaleMode = sm 'restore the prior scalemode
End Sub
'a little helper-routine, to rotate a point
Sub PointRotate(ByVal aRad#, ByVal x#, ByVal y#, xRot, yRot)
Dim sa#: sa = Sin(aRad)
Dim ca#: ca = Cos(aRad)
xRot = y * sa + x * ca 'the rotation-results are placed in the 2 last byref-params
yRot = y * ca - x * sa
End SubOlaf