PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
VB - Gradient Circle-VBForums
Results 1 to 10 of 10

Thread: VB - Gradient Circle

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2002
    Location
    Someplace 'ore the rainbow
    Posts
    392

    VB - Gradient Circle

    This code will create a gradient circle using the color, position, and radius that you want. (Currently only works on a VB form!!)

    Code:
    VB Code:
    1. Public Function gradCircle(x, Y, circleRadius, colorRed, colorGreen, colorBlue, deForm As Form)
    2.  
    3. 'Define some variables
    4. Dim cirStop As Integer
    5. cirStop = 50
    6.  
    7. 'If function works fine, result is 0
    8. gradCircle = 0
    9.  
    10. 'Get color numbers (0-255)
    11. redColor = colorRed
    12. blueColor = colorBlue
    13. greenColor = colorGreen
    14.  
    15.  
    16. 'Get current AutoRedraw property
    17. defaultAutoRedraw = deForm.AutoRedraw
    18. 'Set AuroRedraw so circle can be created
    19. deForm.AutoRedraw = True
    20.  
    21.  
    22. 'Check for illegal numbers
    23. If redColor > 255 Or redColor < 0 Or blueColor > 255 Or blueColor < 0 Or greenColor > 256 Or greenColor < 0 Then
    24.  gradCircle = 1
    25.  Exit Function
    26. End If
    27.  
    28. If redColor >= blueColor And redColor >= greenColor Then topCol = redCol
    29. If blueColor >= redColor And blueColor >= greenColor Then topCol = blueCol
    30. If greenColor >= redColor And greenColor >= blueColor Then topCol = greenCol
    31. If topCol = 0 Then topCol = 255
    32.  
    33. 'Obtain proper subtraction number for gradient
    34. If cirStop = 0 Then
    35.  subBy = topCol / circleRadius
    36.  Else
    37.   subBy = cirStop / circleRadius
    38. End If
    39.  
    40.  
    41.  'Draw circle
    42.  
    43.  For i = 1 To circleRadius
    44.  deForm.Circle (x, Y), i, RGB(redColor, greenColor, blueColor)
    45.  
    46.  'Check if red has reached the stop number
    47.  If redColor > cirStop Then
    48.   redColor = redColor - subBy
    49.   Else
    50.    redDone = "yes"
    51.  End If
    52.  
    53.   'Check if blue has reached the stop number
    54.  If blueColor > cirStop Then
    55.   blueColor = blueColor - subBy
    56.   Else
    57.    blueDone = "yes"
    58.  End If
    59.  
    60.   'Check if green has reached the stop number
    61.  If greenColor > cirStop Then
    62.   greenColor = greenColor - subBy
    63.   Else
    64.    greenDone = "yes"
    65.  End If
    66.  
    67.   'If all colors have reached the stop number, exit loop
    68.  If redDone = "yes" And blueDone = "yes" And greenDone = "yes" Then Exit For
    69. Next i
    70.  
    71.  
    72. 'Reset the AutoRedraw property to normal
    73. deForm.AutoRedraw = defaultAutoRedraw
    74. End Function

    Usage:
    VB Code:
    1. Call gradCircle(xPosition, yPosition, Radius, RedRGB, GreenRGB, BlueRGB, theVBFormName)

    This function will return '0' for a succesfull drawing and a '1' for a non-succesfull one.

    If you modify this code please email me the new code at cjqp777@hotmail.com

    Cjqp
    Last edited by cjqp; Jun 24th, 2003 at 06:50 PM.

  2. #2
    Hyperactive Member rjbudz's Avatar
    Join Date
    Jul 2005
    Location
    San Diego
    Posts
    262

    Re: VB - Gradient Circle

    Very interesting. It needs work regarding defining variables (Option Explicit breaks it right off), and the function call requires the actual form as the last arg, not the form name.

    But I like it!

    There is a pattern of pixels that are not drawn at about 315 and 135 degrees, radiating from the center. Any ideas why that is?

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Nov 2002
    Location
    Someplace 'ore the rainbow
    Posts
    392

    Re: VB - Gradient Circle

    I now realize some of the coding mistakes I made in this piece, I was relatively new to VB when I wrote it.

    The best reasoning I have for the undrawn pixels lies with VB's Circle algorithem. I found that to fill these in, you can draw four gradient circles with 1px offset:
    Code:
    Call gradCircle(xPosition, yPosition, Radius, RedRGB, GreenRGB, BlueRGB, theVBFormName)
    Call gradCircle(xPosition-1, yPosition, Radius, RedRGB, GreenRGB, BlueRGB, theVBFormName)
    Call gradCircle(xPosition, yPosition-1, Radius, RedRGB, GreenRGB, BlueRGB, theVBFormName)
    Call gradCircle(xPosition-1, yPosition-1, Radius, RedRGB, GreenRGB, BlueRGB, theVBFormName)
    When your answer is the Arc Sin of 1.015, you should check your Pythagorean triple.

  4. #4
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,794

    Re: VB - Gradient Circle

    Here's your code fixed:
    VB Code:
    1. Option Explicit
    2.  
    3. Private Sub Form_Load()
    4.     gradCircle 4000, 4000, 1000, 0, 250, 0, Me
    5. End Sub
    6.  
    7. Public Function gradCircle(ByVal X As Single, ByVal Y As Single, ByVal circleRadius As Single, _
    8.           ByVal colorRed As Byte, ByVal colorGreen As Byte, ByVal colorBlue As Byte, deForm As Form)
    9.     Dim redColor As Single
    10.     Dim blueColor As Single
    11.     Dim greenColor As Single
    12.     Dim defaultAutoRedraw As Boolean
    13.     Dim topCol As Long, subBy As Single
    14.     Dim I As Long
    15.     Dim redDone As String, blueDone As String, greenDone As String
    16.    
    17.     'Define some variables
    18.     Dim cirStop As Integer
    19.     cirStop = 50
    20.    
    21.     'If function works fine, result is 0
    22.     gradCircle = 0
    23.    
    24.     'Get color numbers (0-255)
    25.     redColor = colorRed
    26.     blueColor = colorBlue
    27.     greenColor = colorGreen
    28.    
    29.     'Get current AutoRedraw property
    30.     defaultAutoRedraw = deForm.AutoRedraw
    31.     'Set AuroRedraw so circle can be created
    32.     deForm.AutoRedraw = True
    33.     deForm.DrawWidth = 2
    34.    
    35.     'Check for illegal numbers
    36.     If redColor > 255 Or redColor < 0 Or blueColor > 255 Or blueColor < 0 Or greenColor > 256 Or greenColor < 0 Then
    37.         gradCircle = 1
    38.         Exit Function
    39.     End If
    40.    
    41.     If redColor >= blueColor And redColor >= greenColor Then topCol = redColor
    42.     If blueColor >= redColor And blueColor >= greenColor Then topCol = blueColor
    43.     If greenColor >= redColor And greenColor >= blueColor Then topCol = greenColor
    44.    
    45.     If topCol = 0 Then topCol = 255
    46.    
    47.     'Obtain proper subtraction number for gradient
    48.     If cirStop = 0 Then
    49.         subBy = topCol / circleRadius
    50.     Else
    51.         subBy = cirStop / circleRadius
    52.     End If
    53.    
    54.     'Draw circle
    55.     For I = 1 To circleRadius
    56.         deForm.Circle (X, Y), I, RGB(redColor, greenColor, blueColor)
    57.        
    58.         'Check if red has reached the stop number
    59.         If redColor > cirStop Then
    60.             redColor = redColor - subBy
    61.         Else
    62.             redDone = "yes"
    63.         End If
    64.        
    65.         'Check if blue has reached the stop number
    66.         If blueColor > cirStop Then
    67.             blueColor = blueColor - subBy
    68.         Else
    69.             blueDone = "yes"
    70.         End If
    71.        
    72.         'Check if green has reached the stop number
    73.         If greenColor > cirStop Then
    74.             greenColor = greenColor - subBy
    75.         Else
    76.             greenDone = "yes"
    77.         End If
    78.        
    79.         'If all colors have reached the stop number, exit loop
    80.         If redDone = "yes" And blueDone = "yes" And greenDone = "yes" Then Exit For
    81.     Next I
    82.    
    83.     'Reset the AutoRedraw property to normal
    84.     deForm.AutoRedraw = defaultAutoRedraw
    85. End Function
    And since you inspired me, here's mine:
    VB Code:
    1. Option Explicit
    2.  
    3. Private Type tCol_32_8
    4.     R As Byte
    5.     G As Byte
    6.     B As Byte
    7.     NotUsed As Byte
    8. End Type
    9.  
    10. Private Type tCol_32
    11.     Lng As Long
    12. End Type
    13.  
    14. Public Sub DrawGradient(ByVal X As Single, ByVal Y As Single, ByVal Radius As Single, _
    15.         ByVal FromCol As Long, ByVal ToCol As Long, Obj As Object)
    16.     Dim FromRGB As tCol_32_8, ToRGB As tCol_32_8, ConvRGB As tCol_32
    17.     Dim RS As Single, GS As Single, BS As Single
    18.     Dim CurrColR As Single, CurrColG As Single, CurrColB As Single
    19.     Dim I As Single, ObjPrevDrawWidth As Integer
    20.    
    21.     ObjPrevDrawWidth = Obj.DrawWidth
    22.     Obj.DrawWidth = 2
    23.    
    24.     ConvRGB.Lng = FromCol
    25.     LSet FromRGB = ConvRGB
    26.    
    27.     ConvRGB.Lng = ToCol
    28.     LSet ToRGB = ConvRGB
    29.    
    30.     CurrColR = FromRGB.R
    31.     CurrColG = FromRGB.G
    32.     CurrColB = FromRGB.B
    33.    
    34.     RS = (CSng(ToRGB.R) - CSng(FromRGB.R)) / Radius
    35.     GS = (CSng(ToRGB.G) - CSng(FromRGB.G)) / Radius
    36.     BS = (CSng(ToRGB.B) - CSng(FromRGB.B)) / Radius
    37.    
    38.     For I = 1 To Radius
    39.         Obj.Circle (X, Y), I, RGB(CurrColR, CurrColG, CurrColB)
    40.        
    41.         CurrColR = CurrColR + RS
    42.         CurrColG = CurrColG + GS
    43.         CurrColB = CurrColB + BS
    44.     Next I
    45.    
    46.     Obj.DrawWidth = ObjPrevDrawWidth
    47. End Sub
    48.  
    49. Private Sub Form_Load()
    50.     Me.AutoRedraw = True
    51.     DrawGradient 4000, 4000, 1000, RGB(100, 0, 0), RGB(20, 20, 180), Me
    52. End Sub
    If you notice, I changed the drawing object type to "Object", therefore you can pass to it a Form object, or PictureBox object, and it will still work...
    Last edited by CVMichael; Jan 30th, 2007 at 04:43 PM.

  5. #5
    Hyperactive Member rjbudz's Avatar
    Join Date
    Jul 2005
    Location
    San Diego
    Posts
    262

    Re: VB - Gradient Circle

    Hey CVMichael,

    I copied/pasted your 'inspired' code into a form in a new project and ran it.

    Worked great except for the part where it draws something!

    It looks great on the surface, and options to set the fade colors is pretty cool too.

    Any ideas?

  6. #6
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,794

    Re: VB - Gradient Circle

    Quote Originally Posted by rjbudz
    Worked great except for the part where it draws something!

    Any ideas?
    What do you mean, what did not work ?

  7. #7
    Hyperactive Member rjbudz's Avatar
    Join Date
    Jul 2005
    Location
    San Diego
    Posts
    262

    Re: VB - Gradient Circle

    The code ran, but there was no result. Nothing drew on the form

  8. #8
    PowerPoster
    Join Date
    Feb 2002
    Location
    Canada, Toronto
    Posts
    5,794

    Re: VB - Gradient Circle

    Set AutoRedraw = True...

    I did not do that in code because if you use the same function from Form_Paint it will slow down the code a lot, so I let it up to the user...

    Edit, I changed the code in post #4, and I added the line "Me.AutoRedraw = True", so no more confusions...
    Last edited by CVMichael; Jan 30th, 2007 at 04:44 PM.

  9. #9
    Hyperactive Member rjbudz's Avatar
    Join Date
    Jul 2005
    Location
    San Diego
    Posts
    262

    Re: VB - Gradient Circle

    Sweet!

  10. #10
    Hyperactive Member rjbudz's Avatar
    Join Date
    Jul 2005
    Location
    San Diego
    Posts
    262

    Re: VB - Gradient Circle

    I'm uploading a toy I built with the finalized code. It uses scrollbars to adjust the RGB values of the inner and outer parts of the sphere, and the same for the Picture Box control that contains it. I'm sure someone will be able to use it for something. If not just to look at all the pretty colors
    Attached Files Attached Files

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width