Create Horizontal, Vertical, or Diagonal Gradient Forms

Category:

Forms and Controls

Type:

Snippets

Difficulty:

Intermediate

Author:

Vaggelis Lamprinoudis

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

Paste these functions into a modlue and you can create gradient forms with JUST one line of code !! See comments in code for syntax.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Dim Red, Green, Blue

Code:

'In Form Load
'Call Gradient(Me, "du", vbRed, vbGreen)
' or
' Call Gradient(Me, "H", &HC0C000, &HC000C0)

' Where :
' Me=Form's Name
' H orizontal, V ertical, D iagonally U p, D iagonally D own
' Start Color
' End Color

Public Function Gradient(Frm As Form, Way As String, SClr As ColorConstants, EClr As ColorConstants)

Frm.AutoRedraw = True: Frm.ScaleMode = 3 '2 is interesting,too
Analyze (SClr): SRed = Red: SGreen = Green: SBlue = Blue
Analyze (EClr): ERed = Red: EGreen = Green: EBlue = Blue
DifR = ERed - SRed: DifG = EGreen - SGreen: DifB = EBlue - SBlue
Select Case UCase(Way)
  Case Is = "H": Fora = Frm.ScaleHeight
  Case Is = "V": Fora = Frm.ScaleWidth
  Case "DU", "DD": Fora = Sqr(2) * Sqr((Frm.ScaleWidth * Frm.ScaleWidth) + (Frm.ScaleHeight * Frm.ScaleHeight))
End Select
For Yi = 0 To Fora
SRed = SRed + (DifR / Fora): If SRed < 0 Then SRed = 0
SGreen = SGreen + (DifG / Fora): If SGreen < 0 Then SGreen = 0
SBlue = SBlue + (DifB / Fora): If SBlue < 0 Then SBlue = 0
Select Case UCase(Way)
  Case Is = "H": Frm.Line (0, Yi)-(Frm.ScaleWidth, Yi), RGB(SRed, SGreen, SBlue), B
  Case Is = "V": Frm.Line (Yi, 0)-(Yi, Frm.ScaleHeight), RGB(SRed, SGreen, SBlue), B
  Case Is = "DU": Frm.Line (Yi, 0)-(0, Yi), RGB(SRed, SGreen, SBlue)
  Case Is = "DD": Frm.Line (Frm.ScaleWidth - Yi, 0)-(Frm.ScaleWidth, Yi), RGB(SRed, SGreen, SBlue)
End Select
Next
End Function

Public Function Analyze(Chroma As ColorConstants)
'********************************************************
'*   Red             Green            Blue              *
'*   Base 1          Base 256        Base 65 536        *
'*   1 = 1           1 = 256         1 = 65 536         *
'*   255 = 255       255 = 65 280    255 = 16 711 680   *
'********************************************************
Dim rr, gr, br As Long
rr = 1: gr = 256: br = 65536
Dim rest As Long

rest = Chroma \ br
Blue = rest
Chroma = Chroma Mod br

If Blue < 0 Then Blue = 0

rest = Chroma \ gr
Green = rest
Chroma = Chroma Mod gr

If Green < 0 Then Green = 0

rest = Chroma \ rr
Red = rest
Chroma = Chroma Mod rr

If Red < 0 Then Red = 0
End Function