Attribute VB_Name = "modGradObj"
Option Explicit


'=============================================================================================================
'
' modGradObj Module
' -----------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : April 01, 2000
'
' VB Versions : 5.0 / 6.0
'
' Requires    : NOTHING
'
' Applies To  : (Any object that supports the AutoRedraw property & Line method)
'               Form
'               PictureBox
'               Printer
'               PropertyPage
'               UserControl
'               UserDocument
'
' Description : This module was created to easily gradiate ANY object that supports the LINE function, and
'               the AutoRedraw property.
'
' Example Use :
'
'   GradiateObject Me, &HFFFFFF, &HFF&, GD_TopBottom, GQ_1_Highest
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


' Gradient Direction
Public Enum GradDirections
  GD_TopBottom = 0
  GD_BottomTop = 1
  GD_LeftRight = 2
  GD_RightLeft = 3
End Enum

Public Enum GradQualitys
  GQ_1_Highest = 1
  GQ_2_VeryHigh = 3
  GQ_3_High = 5
  GQ_4_Medium = 7
  GQ_5_Low = 10
End Enum

' Gradient Variables
Private R1 As Integer
Private R2 As Integer
Private G1 As Integer
Private G2 As Integer
Private B1 As Integer
Private B2 As Integer
Private ColorR As Single
Private ColorG As Single
Private ColorB As Single
Private difR As Integer
Private difG As Integer
Private difB As Integer

' Function that takes a valid object and draws lines on it to make it look gradient
Public Function GradiateObject(TheObject As Object, Optional GradColor1 As Long = 16711680, Optional GradColor2 As Long = 0, Optional GradDirection As GradDirections, Optional GradientQuality As GradQualitys = GQ_2_VeryHigh)
On Error Resume Next
  
  Dim MyCounter As Integer
  Dim CounterMax As Integer
  Dim QualityValue As Single
  
  ' Set the AutoRedraw property of the object to True to keep the gradiation
  TheObject.AutoRedraw = True
  
  ' Setup the RGB values for the first color
  R1 = Val("&H" & (Right(Hex(GradColor1), 2)))
  If Len(Hex(GradColor1)) >= 4 Then
    G1 = Val("&H" & (Mid(Hex(GradColor1), (Len(Hex(GradColor1))) - 3, 2)))
  End If
  If Len(Hex(GradColor1)) = 6 Then
    B1 = Val("&H" & Left(Hex(GradColor1), 2))
  End If
  
  ' Setup the RGB values for the second color
  R2 = Val("&H" & (Right(Hex(GradColor2), 2)))
  If Len(Hex(GradColor2)) >= 4 Then
    G2 = Val("&H" & (Mid(Hex(GradColor2), (Len(Hex(GradColor2))) - 3, 2)))
  End If
  If Len(Hex(GradColor2)) = 6 Then
    B2 = Val("&H" & Left(Hex(GradColor2), 2))
  End If
  
  ' Gradiate the form
  difR = R2 - R1
  difG = G2 - G1
  difB = B2 - B1
  ColorR = R1
  ColorG = G1
  ColorB = B1
  
  Select Case GradDirection
    Case GD_TopBottom
      QualityValue = CInt(GradientQuality) * Screen.TwipsPerPixelY
      CounterMax = TheObject.Height
      For MyCounter = 1 To CounterMax Step QualityValue
        ColorR = ColorR + (difR / (CounterMax / QualityValue))
        ColorG = ColorG + (difG / (CounterMax / QualityValue))
        ColorB = ColorB + (difB / (CounterMax / QualityValue))
        TheObject.Line (0, MyCounter)-(TheObject.Width, MyCounter + QualityValue), RGB(ColorR, ColorG, ColorB), BF
      Next
    Case GD_BottomTop
      QualityValue = CInt(GradientQuality) * Screen.TwipsPerPixelY
      CounterMax = TheObject.Height
      TheObject.Line (0, 0)-(TheObject.Width, QualityValue), GradColor2, BF
      For MyCounter = CounterMax To 1 Step QualityValue * -1
        ColorR = ColorR + (difR / (CounterMax / QualityValue))
        ColorG = ColorG + (difG / (CounterMax / QualityValue))
        ColorB = ColorB + (difB / (CounterMax / QualityValue))
        TheObject.Line (0, MyCounter)-(TheObject.Width, MyCounter + QualityValue), RGB(ColorR, ColorG, ColorB), BF
      Next
    Case GD_LeftRight
      QualityValue = CInt(GradientQuality) * Screen.TwipsPerPixelX
      CounterMax = TheObject.Width
      For MyCounter = 1 To CounterMax Step QualityValue
        ColorR = ColorR + (difR / (CounterMax / QualityValue))
        ColorG = ColorG + (difG / (CounterMax / QualityValue))
        ColorB = ColorB + (difB / (CounterMax / QualityValue))
        TheObject.Line (MyCounter, 0)-(MyCounter + QualityValue, TheObject.Height), RGB(ColorR, ColorG, ColorB), BF
      Next
    Case GD_RightLeft
      QualityValue = CInt(GradientQuality) * Screen.TwipsPerPixelX
      CounterMax = TheObject.Width
      TheObject.Line (0, 0)-(QualityValue, TheObject.Height), GradColor2, BF
      For MyCounter = CounterMax To 1 Step QualityValue * -1
        ColorR = ColorR + (difR / (CounterMax / QualityValue))
        ColorG = ColorG + (difG / (CounterMax / QualityValue))
        ColorB = ColorB + (difB / (CounterMax / QualityValue))
        TheObject.Line (MyCounter, 0)-(MyCounter + QualityValue, TheObject.Height), RGB(ColorR, ColorG, ColorB), BF
      Next
    Case Else
      QualityValue = CInt(GradientQuality) * Screen.TwipsPerPixelY
      CounterMax = TheObject.Height
      For MyCounter = 1 To CounterMax Step QualityValue
        ColorR = ColorR + (difR / CounterMax)
        ColorG = ColorG + (difG / CounterMax)
        ColorB = ColorB + (difB / CounterMax)
        TheObject.Line (0, MyCounter)-(TheObject.Width, MyCounter), RGB(ColorR, ColorG, ColorB), BF
      Next
  End Select
  DoEvents
  
End Function