Results 1 to 14 of 14

Thread: Color Gradient

  1. #1

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Question Color Gradient

    I have seen in the past in MS Access 2003 you can apply a color gradient to a form. In VB6 is it possible to apply a color gradient to the back color of a shape or a frame?

    Thanks

  2. #2
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,996

    Re: Color Gradient

    Not with buit-in features of VB6.
    But yes, look here.

  3. #3

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Color Gradient

    Eduardo, you're link shows me how to impress a gradient on a form. I want to do it on a shape (or a frame)!

  4. #4
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,996

    Re: Color Gradient

    Quote Originally Posted by AccessShell View Post
    Eduardo, you're link shows me how to impress a gradient on a form. I want to do it on a shape (or a frame)!
    In a shape you cannot.
    In a frame not impossible but it would be too difficult because it would require some advanced use of API's.

    You could do it in a PictureBox.
    (with almost the same code of the form)

  5. #5
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Color Gradient

    Check this. Object maybe a PictureBox or a Form
    f& ans t& are the two colors
    You can define two points as a frame, to place portion of gradient or fill frame with full gradient (check boolean all).


    Code:
    Function RMAX(ByVal q As Single, ByVal w As Single) As Single
    If q > w Then
    RMAX = q
    Else
    RMAX = w
    End If
    End Function
    
    Function RMIN(ByVal q As Single, ByVal w As Single) As Single
    If q < w Then
    RMIN = q
    Else
    RMIN = w
    End If
    End Function
    Sub Gradient(TheObject As Object, ByVal f&, ByVal t&, ByVal xx1&, ByVal xx2&, ByVal yy1&, ByVal yy2&, ByVal hor As Boolean, ByVal all As Boolean)
        Dim Redval&, Greenval&, Blueval&
        Dim r1&, g1&, b1&, sr&, SG&, sb&
        f& = f& Mod &H1000000
        t& = t& Mod &H1000000
        Redval& = f& And &H10000FF
        Greenval& = (f& And &H100FF00) / &H100
        Blueval& = (f& And &HFF0000) / &H10000
        r1& = t& And &H10000FF
        g1& = (t& And &H100FF00) / &H100
        b1& = (t& And &HFF0000) / &H10000
        sr& = (r1& - Redval&) * 1000 / 127
        SG& = (g1& - Greenval&) * 1000 / 127
        sb& = (b1& - Blueval&) * 1000 / 127
        Redval& = Redval& * 1000
        
        Greenval& = Greenval& * 1000
        Blueval& = Blueval& * 1000
        Dim Step&, Reps&, FillTop As Single, FillLeft As Single, FillRight As Single, FillBottom As Single
        If hor Then
        yy2& = TheObject.Height - yy2&
        If all Then
        Step = ((yy2& - yy1&) / 127)
        Else
        Step = (TheObject.Height / 127)
        End If
        If all Then
        FillTop = yy1&
        Else
        FillTop = 0
        End If
        FillLeft = xx1&
        FillRight = TheObject.width - xx2&
        FillBottom = FillTop + Step * 2
        Else ' vertical
        
            xx2& = TheObject.width - xx2&
        If all Then
        Step = ((xx2& - xx1&) / 127)
        Else
        Step = (TheObject.width / 127)
        End If
        If all Then
        FillLeft = xx1&
        Else
        FillLeft = 0
        End If
        FillTop = yy1&
        FillBottom = TheObject.Height - yy2&
        FillRight = FillLeft + Step * 2
        
        End If
        For Reps = 1 To 127
        If hor Then
            If FillTop <= yy2& And FillBottom >= yy1& Then
            TheObject.Line (FillLeft, RMAX(FillTop, yy1&))-(FillRight, RMIN(FillBottom, yy2&)), rgb(Redval& / 1000, Greenval& / 1000, Blueval& / 1000), BF
            End If
            Redval& = Redval& + sr&
            Greenval& = Greenval& + SG&
            Blueval& = Blueval& + sb&
            FillTop = FillBottom
            FillBottom = FillTop + Step
        Else
            If FillLeft <= xx2& And FillRight >= xx1& Then
            TheObject.Line (RMAX(FillLeft, xx1&), FillTop)-(RMIN(FillRight, xx2&), FillBottom), rgb(Redval& / 1000, Greenval& / 1000, Blueval& / 1000), BF
            End If
            Redval& = Redval& + sr&
            Greenval& = Greenval& + SG&
            Blueval& = Blueval& + sb&
            FillLeft = FillRight
            FillRight = FillRight + Step
        End If
        Next
        
    End Sub

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Color Gradient

    This is pretty quick:

    Code:
    Option Explicit
    
    Private Type TRIVERTEX
        PxX As Long
        PxY As Long
        RedLow As Byte
        Red As Byte
        GreenLow As Byte
        Green As Byte
        BlueLow As Byte
        Blue As Byte
        AlphaLow As Byte
        Alpha As Byte
    End Type
    
    Private Type GRADIENT_RECT
        UpperLeft As Long
        LowerRight As Long
    End Type
    
    Private Declare Function GradientFill Lib "msimg32" ( _
        ByVal hDC As Long, _
        ByRef Vertex As TRIVERTEX, _
        ByVal nVertex As Long, _
        ByRef Mesh As GRADIENT_RECT, _
        ByVal nMesh As Long, _
        ByVal Mode As Long) As Long
    
    Private Sub LetVertex( _
        ByRef TRIVERTEX As TRIVERTEX, _
        ByVal PxX As Long, _
        ByVal PxY As Long, _
        ByVal COLORREF As Long)
        With TRIVERTEX
            .PxX = PxX
            .PxY = PxY
            .Red = COLORREF And &HFF&
            .Green = (COLORREF And &HFF00&) \ &H100&
            .Blue = COLORREF \ &H10000
        End With
    End Sub
    
    Private Sub GradientFillForm(ByVal StartRGBx As Long, ByVal EndRGBx As Long)
        Const GRADIENT_FILL_RECT_H = &H0&
        Const GRADIENT_FILL_RECT_V = &H1&
        Dim TRIVERTEX(0 To 1) As TRIVERTEX
        Dim GRADIENT_RECT As GRADIENT_RECT
    
        With GRADIENT_RECT
            .UpperLeft = 0
            .LowerRight = 1
        End With
        LetVertex TRIVERTEX(0), 0, 0, StartRGBx
        LetVertex TRIVERTEX(1), _
                  ScaleX(ScaleWidth, ScaleMode, vbPixels), _
                  ScaleY(ScaleHeight, ScaleMode, vbPixels), _
                  EndRGBx
        AutoRedraw = True
        Cls
        GradientFill hDC, TRIVERTEX(0), 2, GRADIENT_RECT, 1, GRADIENT_FILL_RECT_V
        AutoRedraw = False
    End Sub
    
    Private Sub Form_Resize()
        If WindowState <> vbMinimized Then GradientFillForm &H80C0FF, &HFFFFC0
    End Sub
    Maximize, resize, etc. it keeps up as well as about anything.
    Attached Files Attached Files

  7. #7

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Color Gradient

    GeorgeKar,
    I tried your code and could only get it to work on the form - not on the picturebox. I did change the code "Me.hDC to Me.Picture1.hDc", etc for the height and width parameters.

  8. #8
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Color Gradient

    I was pretty sure I gave you what you need to crack open the good old MSDN Library docs that come with VB6 and do this yourself. But here's an example:

    Name:  sshot.png
Views: 1946
Size:  4.0 KB


    There we have a UserControl named Container with an instance Container1 on a Form. On the Form I have added some controls to Container1 much as you might a Frame, PictureBox, etc.

    If you check the "Run" CheckBox Container1 will run around the Form. If you click on Command1 a status message will be shown and the gradient colors flipped.
    Attached Files Attached Files

  9. #9
    PowerPoster ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    3,046

    Re: Color Gradient

    Quote Originally Posted by AccessShell View Post
    GeorgeKar,
    I tried your code and could only get it to work on the form - not on the picturebox. I did change the code "Me.hDC to Me.Picture1.hDc", etc for the height and width parameters.


    Hi,
    try this..
    Code:
    Option Explicit
    
    'Makes the Form (or PictureBox) gradient
    'Author: unknown, found Dec. 2001
    'Syntax: Call Gradient(Object, R1, G1, B1, R2, G2, B2, Angle)
    '
    'Object: Form or PictureBox (must support the line-method)
    'R1: Red component of the starting color
    'G1: Green component of the starting color
    'B1: Blue component of the starting color
    'R2: Red component of the ending color
    'G2: Green component of the ending color
    'B2: Blue component of the ending color
    'Angle: True or False
    '                 True: Gradient from left to right
    '                 False: Gradient from top to bottom
    '
    'Note:
    '* The Object must be in ScaleMode = 3 (Pixels) and AutoRedraw = true
    '* By setting the starting values of R, G, and B bigger than the
    '  ending values, you create a negative ColBar.
    '* The values of R, G, and B must not exceed 255.
    '* For better calculations the values Of R1...B2 are Single.
    '
    'Examples:
    '
    'Call Gradient(Form1, 0, 50, 64, 0, 64, 255, True)
    'Call Gradient(Picture1, 200, 60, 255, 184, 255, 55, False)
    
    
    
    
    
    
    Private Sub Command1_Click()
    Call Gradient(Picture1, 200, 60, 255, 184, 255, 55, False)
    End Sub
    
    Public Sub Gradient(Obj As Object, R1 As Single, G1 As Single, B1 As Single, R2 As Single, G2 As Single, B2 As Single, Angle As Boolean)
    Dim R, G, B As Single
    Dim Wi%
    Obj.AutoRedraw = True
    Obj.ScaleMode = 3
    If Angle = False Then
    R = (R2 - R1) / Obj.ScaleHeight
    G = (G2 - G1) / Obj.ScaleHeight
    B = (B2 - B1) / Obj.ScaleHeight
    For Wi = 0 To Obj.ScaleHeight - 1
    Obj.Line (0, Wi)-(Obj.ScaleWidth - 1, Wi), RGB(R1, G1, B1)
    R1 = R1 + R
    G1 = G1 + G
    B1 = B1 + B
    Next Wi
    Exit Sub
    End If
    If Angle = True Then
    R = (R2 - R1) / Obj.ScaleWidth
    G = (G2 - G1) / Obj.ScaleWidth
    B = (B2 - B1) / Obj.ScaleWidth
    For Wi = 0 To Obj.ScaleWidth - 1
    Obj.Line (Wi, 0)-(Wi, Obj.ScaleHeight - 1), RGB(R1, G1, B1)
    R1 = R1 + R
    G1 = G1 + G
    B1 = B1 + B
    Next Wi
    Exit Sub
    End If
    End Sub
    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  10. #10

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Color Gradient

    OK. So I was able to make a color gradient in a picturebox. In design time I also added 3 labels at different vertical positions in the picurebox. In design time I also filled the label boxes with captions. The program worked correctly.

    So I took it to the next step. I filled the labels boxes in run time. The labels were no longer transparent. I saw the data but the rest of the label controls were opaque. To make matters worse when I put a timer on the form to get new data, all the labels disappeared, only the gradient remained.

  11. #11
    Addicted Member beic's Avatar
    Join Date
    Jun 2012
    Posts
    150

    Re: Color Gradient

    Quote Originally Posted by dilettante View Post
    This is pretty quick:

    Code:
    Option Explicit
    
    Private Type TRIVERTEX
        PxX As Long
        PxY As Long
        RedLow As Byte
        Red As Byte
        GreenLow As Byte
        Green As Byte
        BlueLow As Byte
        Blue As Byte
        AlphaLow As Byte
        Alpha As Byte
    End Type
    
    Private Type GRADIENT_RECT
        UpperLeft As Long
        LowerRight As Long
    End Type
    
    Private Declare Function GradientFill Lib "msimg32" ( _
        ByVal hDC As Long, _
        ByRef Vertex As TRIVERTEX, _
        ByVal nVertex As Long, _
        ByRef Mesh As GRADIENT_RECT, _
        ByVal nMesh As Long, _
        ByVal Mode As Long) As Long
    
    Private Sub LetVertex( _
        ByRef TRIVERTEX As TRIVERTEX, _
        ByVal PxX As Long, _
        ByVal PxY As Long, _
        ByVal COLORREF As Long)
        With TRIVERTEX
            .PxX = PxX
            .PxY = PxY
            .Red = COLORREF And &HFF&
            .Green = (COLORREF And &HFF00&) \ &H100&
            .Blue = COLORREF \ &H10000
        End With
    End Sub
    
    Private Sub GradientFillForm(ByVal StartRGBx As Long, ByVal EndRGBx As Long)
        Const GRADIENT_FILL_RECT_H = &H0&
        Const GRADIENT_FILL_RECT_V = &H1&
        Dim TRIVERTEX(0 To 1) As TRIVERTEX
        Dim GRADIENT_RECT As GRADIENT_RECT
    
        With GRADIENT_RECT
            .UpperLeft = 0
            .LowerRight = 1
        End With
        LetVertex TRIVERTEX(0), 0, 0, StartRGBx
        LetVertex TRIVERTEX(1), _
                  ScaleX(ScaleWidth, ScaleMode, vbPixels), _
                  ScaleY(ScaleHeight, ScaleMode, vbPixels), _
                  EndRGBx
        AutoRedraw = True
        Cls
        GradientFill hDC, TRIVERTEX(0), 2, GRADIENT_RECT, 1, GRADIENT_FILL_RECT_V
        AutoRedraw = False
    End Sub
    
    Private Sub Form_Resize()
        If WindowState <> vbMinimized Then GradientFillForm &H80C0FF, &HFFFFC0
    End Sub
    Maximize, resize, etc. it keeps up as well as about anything.
    Hi there,

    So, it's a few year old post, but the code still working great, but how could it be extended to be able to set the gradient Angle too?

    I would like 90 degree for example:

    Call GradientFillForm(&H80C0FF, &HFFFFC0, 90)

    Thanks!

  12. #12
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Color Gradient

    I don't see any easy answer for that in GDI32. You might try playing with rotation transforms, but you'll need to span a larger rectangle to get full coverage.

  13. #13
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Color Gradient

    Quote Originally Posted by beic View Post
    how could it be extended to be able to set the gradient Angle too?

    I would like 90 degree for example:

    Call GradientFillForm(&H80C0FF, &HFFFFC0, 90)
    Have just uploaded an (API-free) Demo for that into the CodeBank:
    https://www.vbforums.com/showthread....s-and-PicBoxes

    HTH

    Olaf

  14. #14
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Color Gradient

    Looking at my old code, it seems that a way to do this is to just apply some trigonometry to derive the proper values for the TRIVERTEX array in GradientFillDiagonal().

    It is just drawing two filled triangles to cover the rectangle, so that shouldn't be too hard to adjust.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width