Is there a way to make a picturebox upside down then gradient in color.
for example if I have picture1 loaded with the picture and I want picture2 right under picture1, then picture2 would gradient in color. like as if you had a box and set it on a piece of glass you would see its reflection.
There are reflection posts on PSC and maybe here too (haven't searched). Here is an the idea. Give it a shot and if you have problems let us know. If you have not used GradientFill, AlphaBlend & StretchBlt APIs before, do a little research on MSDN.com; many examples exist on this forum.
1. Start with 2 bitmaps. 1 for a copy of the image & a blank one for the gradient
2. Use StretchBlt to copy the image to one of those bitmaps. Passing a negative source height to that API will paint image upside down.
3. Gradient fill the blank copy, top to bottom: GradientFill API can be used. Probably gray to black
4. Alphablend the gradient copy over the image copy using about 50-60% opacity (change percentage to taste): AlphaBlend API
5. Now BitBlt or StretchBlt the combined copy to your form
Last edited by LaVolpe; Jan 6th, 2008 at 01:55 PM.
Either the source or the target width/height can be negative, you have to adjust the origin accordingly.
Code:
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Form_Load()
Dim W As Long, H As Long
With Me
W = ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
H = ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
.AutoRedraw = True
StretchBlt .hDC, 0, H - 1, W, -H, .hDC, 0, 0, W, H, vbSrcCopy
'or
'StretchBlt .hDC, 0, 0, W, H, .hDC, 0, H - 1, W, -H, vbSrcCopy
End With
End Sub
Here is a working example. The actual blending of the reflection into the background, from your example, is not done the way I did it. It is using a different algorithm. My goal was to get close, replicating it 100% requires more work and, honestly, not my responsibility.
1. Start a new project
2. Add 2 pictureboxes to the form: Picture1 & Picture2
3. Add the attached image to Picture2
4. Copy this code to the form & run the project
5. Play around with different backcolors & different images. Also play with different opacity values for the lBlend variable.
Code:
Option Explicit
Private Type TRIVERTEX
X As Long
Y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Private Declare Function GradientFill Lib "msimg32" (ByVal hdc As Long, pVertex As Any, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Const STRETCH_HALFTONE As Long = 4
Private Sub Form_Load()
' source image goes into picture2
With Picture2
.Appearance = 0
.BorderStyle = 0
.AutoSize = True
.AutoRedraw = True
.Visible = False
End With
With Picture1
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.BackColor = RGB(38, 58, 88) ' set destination backcolor
End With
DoSample
End Sub
Private Sub DoSample()
Dim cx As Long, cy As Long, lBlend As Long, reflectCy As Long
Dim bdrCx As Long, bdrCy As Long, sMode As Long
Dim scaleCx As Long, scaleCy As Long, scaleReflect As Long
Const imgScale As Long = 100 ' 100 pct of image, change to < > 100% as needed
' get actual image size
cx = ScaleX(Picture2.Picture.Width, vbHimetric, vbPixels)
cy = ScaleY(Picture2.Picture.Height, vbHimetric, vbPixels)
reflectCy = (cy \ 2) ' how much of image to reflect; cannot be > cy
scaleReflect = (reflectCy * imgScale) \ 100
scaleCx = (cx * imgScale) \ 100
scaleCy = (cy * imgScale) \ 100
bdrCx = 8: bdrCy = 8 ' borders around image, set to taste
' resize destination picbox to imagesize + reflection + borders
Picture1.Width = ScaleX(bdrCx * 2 + scaleCx, vbPixels, Me.ScaleMode)
Picture1.Height = ScaleY(bdrCy * 2 + scaleCy + scaleReflect, vbPixels, Me.ScaleMode)
' gradient fill a rectangle = to reflection size. We will use top portion of destination
' since it will be painted over anyway. Prevents needing another DC to hold gradient box
Call DrawGradientFill(Picture1.hdc, Picture1.BackColor, vbBlack, bdrCx, bdrCy, scaleCx, scaleReflect - 1, True)
' copy flipped source to destination, offset for borders
sMode = SetStretchBltMode(Picture1.hdc, STRETCH_HALFTONE) ' makes stretching better quality
' flip portion of source to bottom of destination. Bottom edges of normal & flipped images will overlap by 1 pixel
Call StretchBlt(Picture1.hdc, bdrCx, scaleReflect - 2 + bdrCy + scaleCy, scaleCx, -scaleReflect, Picture2.hdc, 0, cy - reflectCy, cx, reflectCy, vbSrcCopy)
' blend the gradient box over the flipped portion
lBlend = (192 * &H10000) ' change 192 to level of opacity of gradient over image. Range 0-255
AlphaBlend Picture1.hdc, bdrCx, scaleCy + bdrCy, scaleCx, scaleReflect - 1, Picture1.hdc, bdrCx, bdrCy, scaleCx, scaleReflect - 1, lBlend
' copy source to destination, offset for borders
StretchBlt Picture1.hdc, bdrCx, bdrCy, scaleCx, scaleCy, Picture2.hdc, 0, 0, cx, cy, vbSrcCopy
SetStretchBltMode Picture1.hdc, sMode ' reset stretchmode
Picture1.Refresh
End Sub
Private Sub DrawGradientFill(ByVal gDC As Long, ByVal dwColour1 As Long, ByVal dwColour2 As Long, _
ByVal gLeft As Long, ByVal gTop As Long, _
ByVal gWidth As Long, ByVal gHeight As Long, Vertical As Boolean)
Dim vert(0 To 1) As TRIVERTEX
Dim grRc As GRADIENT_RECT
'Colour at upper-left corner
With vert(0)
.X = gLeft
.Y = gTop
.Red = LongToSignedShort((dwColour1 And &HFF&) * 256)
.Green = LongToSignedShort(((dwColour1 And &HFF00&) \ &H100&) * 256)
.Blue = LongToSignedShort(((dwColour1 And &HFF0000) \ &H10000) * 256)
.Alpha = 0
End With
'Colour at bottom-right corner
With vert(1)
.X = gWidth + gLeft
.Y = gHeight + gTop
.Red = LongToSignedShort((dwColour2 And &HFF&) * 256)
.Green = LongToSignedShort(((dwColour2 And &HFF00&) \ &H100&) * 256)
.Blue = LongToSignedShort(((dwColour2 And &HFF0000) \ &H10000) * 256)
.Alpha = 0
End With
With grRc
.LowerRight = 0
.UpperLeft = 1
End With
Call GradientFill(gDC, vert(0), 2, grRc, 1, Abs(Vertical))
End Sub
Private Function LongToSignedShort(dwUnsigned As Long) As Integer
'convert from long to signed short
If dwUnsigned < 32768 Then
LongToSignedShort = CInt(dwUnsigned)
Else
LongToSignedShort = CInt(dwUnsigned - &H10000)
End If
End Function
Edited: Added scaling functionality so final image can be stretched
Last edited by LaVolpe; Jan 7th, 2008 at 01:16 PM.
Curiosity got the best of me. Here is the same, or nearly the same, algorithm used in the image you originally posted. Note that the only differnece is the percentages of what is reflected and how much of that reflection is blended.
Follow the same instructions for setting up the form as I posted in #8 above, but use this code. There is no gradient boxes being used here, it is a line by line blending into the background and because of this, it should be overall slower than using the gradient box. Now you have at least 2 choices.
Code:
Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal WidthDest As Long, ByVal HeightDest As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, ByVal Blendfunc As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Const STRETCH_HALFTONE As Long = 4
Private Sub Form_Load()
' source image goes into picture2
With Picture2
.Appearance = 0
.BorderStyle = 0
.AutoSize = True
.AutoRedraw = True
.Visible = False
End With
With Picture1
.Appearance = 0
.BorderStyle = 0
.AutoRedraw = True
.BackColor = RGB(38, 58, 88) ' set destination backcolor
End With
DoSample2
End Sub
Private Sub DoSample2()
Dim cx As Long, cy As Long, lBlend As Long, reflectCy As Long
Dim bdrCx As Long, bdrCy As Long, sMode As Long
Dim scaleCx As Long, scaleCy As Long, scaleReflect As Long
Dim blendScale As Single, blendStep As Single
Dim Y As Long
Const imgScale As Long = 100 ' 100 pct of image, change to < > 100% as needed
' get actual image size
cx = ScaleX(Picture2.Picture.Width, vbHimetric, vbPixels)
cy = ScaleY(Picture2.Picture.Height, vbHimetric, vbPixels)
reflectCy = (cy * 0.45) ' how much of image to reflect; cannot be > cy
scaleReflect = (reflectCy * imgScale) \ 100
scaleCx = (cx * imgScale) \ 100
scaleCy = (cy * imgScale) \ 100
bdrCx = 8: bdrCy = 8 ' borders around image, set to taste
' resize destination picbox to imagesize + reflection + borders
Picture1.Width = ScaleX(bdrCx * 2 + scaleCx, vbPixels, Me.ScaleMode)
Picture1.Height = ScaleY(bdrCy * 2 + scaleCy + scaleReflect, vbPixels, Me.ScaleMode)
' copy flipped source to destination, offset for borders
sMode = SetStretchBltMode(Picture1.hdc, STRETCH_HALFTONE) ' makes stretching better quality
' flip portion of source to bottom of destination. Bottom edges of normal & flipped images will overlap by 1 pixel
Call StretchBlt(Picture1.hdc, bdrCx, bdrCy + scaleReflect, scaleCx, -scaleReflect, Picture2.hdc, 0, cy - reflectCy, cx, reflectCy, vbSrcCopy)
blendScale = (255 * (reflectCy / cy)) ' calc how many steps from refelction pct to 0
blendStep = blendScale / (scaleReflect * 0.7) * 2 ' divide that by the percentage of the reflection to be blended
Y = bdrCy ' start blending at this line
For blendScale = blendScale To 2 Step -blendStep ' loop thru blending each line to the background
lBlend = CLng(blendScale) * &H10000 ' calc Blend ratio & and blend
AlphaBlend Picture1.hdc, bdrCx, Y + scaleCy - 2, scaleCx, 2, Picture1.hdc, bdrCx, Y, scaleCx, 2, lBlend
Y = Y + 2 ' move to next line to be blended, stepping by 2 is faster overall
Next
' copy source to destination, offset for borders
StretchBlt Picture1.hdc, bdrCx, bdrCy, scaleCx, scaleCy, Picture2.hdc, 0, 0, cx, cy, vbSrcCopy
SetStretchBltMode Picture1.hdc, sMode ' reset stretchmode
Picture1.Refresh
End Sub
Last edited by LaVolpe; Jan 7th, 2008 at 02:40 PM.
Ok, Thank you everyone for the help. LaVolpe, I didn't mean for you to do it for me I had just gotten frustrated at that time because I had been working and trying to figure it out for several hours and had gotten almost nowhere, so I figured I'd give up from the time being and do something else for awhile.
But I thank you very much for what you did and it works perfectly.
jlt7
jlt7, no problem -- I had some time to kill and I actually like doing graphics coding, even though I'm color-blind. It seems to be pretty robust; might even tuck it away in my repository for future use if needed. Anyway, if it works for you, don't forget to resolve the thread.
Got a question for you LaVolpe... I took your code and attempted to modify it to paint a PictureBox and I can't get it to work. Perhaps you may guide me. The end game here is to basically paint a gradient SSTAB...
It's gotten the best of me... Here is what I have now
Multicolor gradient (any no. of colors, as such) or at least a Rainbow gradient (7 colors) possible using VB6, in a PictureBox?
I did search for quite a time in the net and also in our forum but I am somehow not able to find any code to achieve my above wish. Sorry if I missed out a code in our forum which can do the above though I searched reasonably well with very many different kinds of search texts on gradients.
I did see GradientFill API suggested by LaVolpe and I am able to achieve 2-color gradient easily in PictureBox. May be I have to work on myself to extend it by logic to 7 or multicolors? If so, I am not that much an expert. Neither do I have time to explore on it further. So, if somebody can kindly provide me with a code through which I can achieve multicolor gradient or at least upto 7 colors gradient in a PictureBox (both top to bottom and bottom to top; if radial is also possible then that would be a bonus), then I would remain grateful to him/her.
I guess you mean something like this (having the colors "fade into each other")?If there's no "seamless fading" (as in the above picture) required, then a simple loop (using the VB6-Line-call) would be sufficient.Olaf
Yes, I need it exactly in the way it is illustrated in the above picture. "Seamless fading" indeed.
Divide the picture in 6 equal parts, then call GradientFill API 6 times for the 7 colors:
C1-C2
C2-C3
C3-C4
C4-C5
C5-C6
C6-C7
Oh, that itself will do, is it! Thanks a TON. I thought about it but presumed that the colors may not seamlessly fade in or merge then! Okay. Will try it out.
FWIW, here's Code which renders a "seamless RainBow-Pattern" with the help of the VB6-CairoWrapper (available on vbRichClient.com):
Code:
Option Explicit
Private Sub Form_Resize()
RenderToFormOrPicBox Me, Array(vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
End Sub
Private Sub RenderToFormOrPicBox(Canvas, ColorStops)
Canvas.ScaleMode = vbPixels
Dim CC As cCairoContext, Pat As cCairoPattern, i As Long
Set CC = Cairo.CreateSurface(Canvas.ScaleWidth, Canvas.ScaleHeight).CreateContext
Set Pat = Cairo.CreateLinearPattern(0, 0, CC.Surface.Width, 0)
For i = 0 To UBound(ColorStops) 'add the Color-Stops for this gradient-pattern
Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
Next
CC.Paint 1, Pat 'now render the gradient-pattern via the CairoContext
Set Canvas.Picture = CC.Surface.Picture
End Sub
HTH
Olaf
Last edited by Schmidt; Aug 19th, 2021 at 02:02 PM.
Option Explicit
Private Declare Function ColorHLSToRGB Lib "shlwapi" ( _
ByVal wHue As Integer, _
ByVal wLuminance As Integer, _
ByVal wSaturation As Integer) As Long
Private Sub Form_Load()
ScaleMode = vbPixels
End Sub
Private Sub Form_Resize()
Dim lX As Long
Dim dX As Single
dX = 240 / ScaleWidth
For lX = 0 To ScaleWidth - 1
Line (lX, 0)-(lX, ScaleHeight), ColorHLSToRGB(dX * lX, 120, 240)
Next
End Sub
@ The Trick. This seems to be very fast with little code. Could you please show me how to do a vertical gradient of just 26 pixels x scalewidth between &HD98468 & &H700000. Many thanks.
@ The Trick. This seems to be very fast with little code. Could you please show me how to do a vertical gradient of just 26 pixels x scalewidth between &HD98468 & &H700000. Many thanks.
Code:
Option Explicit
Private Declare Function ColorHLSToRGB Lib "shlwapi" ( _
ByVal wHue As Integer, _
ByVal wLuminance As Integer, _
ByVal wSaturation As Integer) As Long
Private Sub Form_Load()
ScaleMode = vbPixels
End Sub
Private Sub Form_Resize()
Dim lY As Long
Dim dT As Single
For lY = 0 To 25
dT = 1 / 25 * lY
Line (0, lY)-(ScaleWidth, lY), ColorHLSToRGB(dT * 10 + 150, 151 - dT * 98, dT * 97 + 143)
Next
End Sub
Option Explicit
... .. .
Private Sub Form_Resize()
Dim lX As Long
Dim dX As Single
dX = 240 / ScaleWidth
For lX = 0 To ScaleWidth - 1
Line (lX, 0)-(lX, ScaleHeight), ColorHLSToRGB(dX * lX, 120, 240)
Next
End Sub
Amazing! I never thought a gradient could be achieved so easily with such a simple cute logic! Wow! Thanks a TON. Really. I played around changing the values and it seems like I can create a pretty little fun graphics application itself with this simple 2 'Line' code.
FWIW, here's Code which renders a "seamless RainBow-Pattern" with the help of the VB6-CairoWrapper (available on vbRichClient.com):
Code:
Option Explicit
Private Sub Form_Resize()
RenderToFormOrPicBox Me, Array(vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
End Sub
Private Sub RenderToFormOrPicBox(Canvas, ColorStops)
Canvas.ScaleMode = vbPixels
Dim CC As cCairoContext, Pat As cCairoPattern, i As Long
Set CC = Cairo.CreateSurface(Canvas.ScaleWidth, Canvas.ScaleHeight).CreateContext
Set Pat = Cairo.CreateLinearPattern(0, 0, CC.Surface.Width, 0)
For i = 0 To UBound(ColorStops) 'add the Color-Stops for this gradient-pattern
Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
Next
CC.Paint 1, Pat 'now render the gradient-pattern via the CairoContext
Set Canvas.Picture = CC.Surface.Picture
End Sub
HTH
Olaf
Professional and sophisticated indeed. Great! I know about this superb work (RichClient) of yours since many years but somehow not able to get the opportunity to utilize your grand work in my programs. Many others must be using it and getting benefited of course. Thanks a TON for the same.
Option Explicit
Private Declare Function ColorHLSToRGB Lib "shlwapi" ( _
ByVal wHue As Integer, _
ByVal wLuminance As Integer, _
ByVal wSaturation As Integer) As Long
Private Sub Form_Load()
ScaleMode = vbPixels
End Sub
Private Sub Form_Resize()
Dim lY As Long
Dim dT As Single
For lY = 0 To 25
dT = 1 / 25 * lY
Line (0, lY)-(ScaleWidth, lY), ColorHLSToRGB(dT * 10 + 150, 151 - dT * 98, dT * 97 + 143)
Next
End Sub
This code interpolate between D98568...710000
Quite interesting. I am very curious to know as to what would be the code if I choose my own color stops as follows (to generate the resultant horizontal and vertical gradients as shown below). I have used only 7 color stops. Is it possible to modify/expand the above code suitably so that I can choose to have any no. of color stops and choose any color as one of those color stops? Thanks.
Quite interesting. I am very curious to know as to what would be the code if I choose my own color stops as follows (to generate the resultant horizontal and vertical gradients as shown below). I have used only 7 color stops. Is it possible to modify/expand the above code suitably so that I can choose to have any no. of color stops and choose any color as one of those color stops? Thanks.
Kind regards.
This is just the HSL pallete. If you need to draw an arbitrary gradient i can suggest you such function:
Code:
Option Explicit
Private Sub Gradient( _
ParamArray vColors() As Variant)
Dim lX As Long
Dim lCount As Long
Dim lNextIdx As Long
lCount = (UBound(vColors) - LBound(vColors))
For lX = 0 To ScaleWidth - 1
If Int((lX / ScaleWidth) * lCount) = lNextIdx Then
lNextIdx = lNextIdx + 1
End If
Line (lX, 0)-(lX, ScaleHeight), lerp_color(vColors(lNextIdx - 1), vColors(lNextIdx), _
lX / ScaleWidth * lCount - lNextIdx + 1)
Next
End Sub
Private Function lerp_color( _
ByVal lCol1 As Long, _
ByVal lCol2 As Long, _
ByVal fT As Single) As Long
lerp_color = ((lCol1 And &HFF) * (1 - fT) + (lCol2 And &HFF) * fT) Or _
Int(((lCol1 And &HFF00&) \ &H100) * (1 - fT) + ((lCol2 And &HFF00&) \ &H100) * fT) * &H100 Or _
Int(((lCol1 And &HFF0000) \ &H10000) * (1 - fT) + ((lCol2 And &HFF0000) \ &H10000) * fT) * &H10000
End Function
Private Sub Form_Resize()
Gradient vbRed, vbBlue, vbGreen, vbYellow, vbMagenta, vbCyan, vbYellow, vbBlack, vbWhite
End Sub
For completeness, to allow an influencing of the Angle of the Gradient-Vector -
the routine I've posted in #18, would need to be changed to:
Code:
Private Sub RenderToFormOrPicBox(Canvas, AngDeg0to90, ColorStops)
Canvas.ScaleMode = vbPixels
Dim CC As cCairoContext, Pat As cCairoPattern, i As Long
Set CC = Cairo.CreateSurface(Canvas.ScaleWidth, Canvas.ScaleHeight).CreateContext
Set Pat = Cairo.CreateLinearPattern(0, 0, Cos(AngDeg0to90 / 180 * Cairo.PI) * CC.Surface.Width, _
Sin(AngDeg0to90 / 180 * Cairo.PI) * CC.Surface.Height)
For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern
Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
Next
CC.Paint 1, Pat 'now render the gradient-pattern via the CairoContext
Set Canvas.Picture = CC.Surface.Picture
End Sub
For completeness, to allow an influencing of the Angle of the Gradient-Vector -
the routine I've posted in #18, would need to be changed to:
Code:
Private Sub RenderToFormOrPicBox(Canvas, AngDeg0to90, ColorStops)
Canvas.ScaleMode = vbPixels
Dim CC As cCairoContext, Pat As cCairoPattern, i As Long
Set CC = Cairo.CreateSurface(Canvas.ScaleWidth, Canvas.ScaleHeight).CreateContext
Set Pat = Cairo.CreateLinearPattern(0, 0, Cos(AngDeg0to90 / 180 * Cairo.PI) * CC.Surface.Width, _
Sin(AngDeg0to90 / 180 * Cairo.PI) * CC.Surface.Height)
For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern
Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
Next
CC.Paint 1, Pat 'now render the gradient-pattern via the CairoContext
Set Canvas.Picture = CC.Surface.Picture
End Sub
Oh great!!!!! That would be a nice addition to the gradient repertoire indeed. Thanks a lot. Additionally, color stops at different percentages also possible for multicolors? Say, for a gradient of 3 colors, red upto 70%, then green upto 95% and blue upto 100%.
This is just the HSL pallete. If you need to draw an arbitrary gradient i can suggest you such function:
Originally Posted by The trick
Code:
Option Explicit
Code:
Private Sub Gradient( _ ParamArray vColors() As Variant) Dim lX As Long Dim lCount As Long Dim lNextIdx As Long lCount = (UBound(vColors) - LBound(vColors)) For lX = 0 To ScaleWidth - 1 If Int((lX / ScaleWidth) * lCount) = lNextIdx Then lNextIdx = lNextIdx + 1 End If Line (lX, 0)-(lX, ScaleHeight), lerp_color(vColors(lNextIdx - 1), vColors(lNextIdx), _ lX / ScaleWidth * lCount - lNextIdx + 1) NextEnd SubPrivate Function lerp_color( _ ByVal lCol1 As Long, _ ByVal lCol2 As Long, _ ByVal fT As Single) As Long lerp_color = ((lCol1 And &HFF) * (1 - fT) + (lCol2 And &HFF) * fT) Or _ Int(((lCol1 And &HFF00&) \ &H100) * (1 - fT) + ((lCol2 And &HFF00&) \ &H100) * fT) * &H100 Or _ Int(((lCol1 And &HFF0000) \ &H10000) * (1 - fT) + ((lCol2 And &HFF0000) \ &H10000) * fT) * &H10000End FunctionPrivate Sub Form_Resize() Gradient vbRed, vbBlue, vbGreen, vbYellow, vbMagenta, vbCyan, vbYellow, vbBlack, vbWhiteEnd Sub
Additionally, color stops at different percentages also possible for multicolors? Say, for a gradient of 3 colors, red upto 70%, then green upto 95% and blue upto 100%.
You should register and really try out the Wrapper-lib, so that intellisense can kick in with the method-parameters.
In short, the cCairoPattern.AddColorStop-Method already does exactly what you want -
the loop it is used in currently, just ensures equidistant percentages between the ColorArray-Members.
If you comment out the loop, and use the method eplicitely, you can easily ensure what you want.
(the easiest way to make this generic again with a loop, would be to pass a second array along with the percentages)
Code:
' For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern
' Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
' Next
Pat.AddColorStop 0.7, vbRed
Pat.AddColorStop 0.95, vbGreen
Pat.AddColorStop 1, vbBlue
See Guide to Image Composition with Win32 MsImg32.dll. Most of it applies to use of the dynamic library from a VB6 program. Actually you can use the entrypoints in msimg32.dll or the renamed ones in gdi32.dll as well:
Code:
Declare Function GradientFill Lib "msimg32" (
or:
Code:
Declare Function GradientFill Lib "gdi32" Alias "GdiGradientFill" (
I'm not sure what value these stunts have in most programs. Why would you need to do this dynamically instead of just displaying an image made during the development process?
There are ways to simulate radial gradients, as in this quick and dirty demo. It just paints a centered circular area.
Run the program, resize the Form, maximize it, etc. and it seems to repaint to fit the size plenty fast enough for normal purposes. Rectangular gradients are even simpler. All using GDI calls.
This is just the HSL pallete. If you need to draw an arbitrary gradient i can suggest you such function:
Code:
Option Explicit
Private Sub Gradient( _
ParamArray vColors() As Variant)
Dim lX As Long
Dim lCount As Long
Dim lNextIdx As Long
lCount = (UBound(vColors) - LBound(vColors))
For lX = 0 To ScaleWidth - 1
If Int((lX / ScaleWidth) * lCount) = lNextIdx Then
lNextIdx = lNextIdx + 1
End If
Line (lX, 0)-(lX, ScaleHeight), lerp_color(vColors(lNextIdx - 1), vColors(lNextIdx), _
lX / ScaleWidth * lCount - lNextIdx + 1)
Next
End Sub
Private Function lerp_color( _
ByVal lCol1 As Long, _
ByVal lCol2 As Long, _
ByVal fT As Single) As Long
lerp_color = ((lCol1 And &HFF) * (1 - fT) + (lCol2 And &HFF) * fT) Or _
Int(((lCol1 And &HFF00&) \ &H100) * (1 - fT) + ((lCol2 And &HFF00&) \ &H100) * fT) * &H100 Or _
Int(((lCol1 And &HFF0000) \ &H10000) * (1 - fT) + ((lCol2 And &HFF0000) \ &H10000) * fT) * &H10000
End Function
Private Sub Form_Resize()
Gradient vbRed, vbBlue, vbGreen, vbYellow, vbMagenta, vbCyan, vbYellow, vbBlack, vbWhite
End Sub
Thanks again because by modifying your code suitably, I was able to achieve 'gradients at any given angle' too (just like what Schmidt's CairoWrapper does in post #29).
I used 'Line' calls itself. The display was quick and smooth, with the colors spread out evenly. Thanks a TON.
You should register and really try out the Wrapper-lib, so that intellisense can kick in with the method-parameters.
In short, the cCairoPattern.AddColorStop-Method already does exactly what you want -
the loop it is used in currently, just ensures equidistant percentages between the ColorArray-Members.
If you comment out the loop, and use the method eplicitely, you can easily ensure what you want.
(the easiest way to make this generic again with a loop, would be to pass a second array along with the percentages)
Code:
' For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern
' Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
' Next
Pat.AddColorStop 0.7, vbRed
Pat.AddColorStop 0.95, vbGreen
Pat.AddColorStop 1, vbBlue
HTH
Olaf
Sorry that I did not focus my attention on the "Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)" line. So, I missed the obvious. I could get time to try it out well 2 days back only. Its really great^^ but the last color in the gradient always shows up more. For e.g. even if I give 0.99 as in the following specification, the blue color still shows up for a significant portion.
--
Pat.AddColorStop 0.7, vbRed
Pat.AddColorStop 0.99, vbGreen
Pat.AddColorStop 1, vbBlue
--
(^^) its not just this alone. I happened to download the Cairo tutorial too and see its voluminous contents (and what all can be done). Amazing. Absolutely amazing. I had time to see the gradients demo alone in it. Great! I wish the name of the download was CairoTutorialWithVbDemos so that instantly I knew that detailed VB demos were also included in it because initially I presumed(its my mistake of course) that it will be some help file with lots of screenshots and hence did not see its contents at once. I am not an expert coder. Also, I don't know whether I will get time in future to see all that you have done and use them but seeing the tutorial contents, I get a sense that it is something awesome. Hence, my sincere appreciation.
See Guide to Image Composition with Win32 MsImg32.dll. Most of it applies to use of the dynamic library from a VB6 program. Actually you can use the entrypoints in msimg32.dll or the renamed ones in gdi32.dll as well:
Code:
Declare Function GradientFill Lib "msimg32" (
or:
Code:
Declare Function GradientFill Lib "gdi32" Alias "GdiGradientFill" (
Thank you so much. I could get time to look into it 2 days back. It was quite useful, esp. to know what can be achieved with the GRADIENT_TRIANGLE. After that, I searched in the net and downloaded a vb6 radial gradient demo also promptly (GradientVariation.zip) from this page - https://www.vbforums.com/showthread....radient-Circle. Cool. Now I see that you have also provided one (post #35). Super cool. Thanks a ton.
By the by, I tried to think out a logic for whether GRADIENT_TRIANGLE can be used to create 'gradients at any given angle' but could not. Anyway, I had already modified the code given by 'The trick' in post #28 and achieved the same smoothly and quickly using 'Line' calls itself.
...even if I give 0.99 as in the following specification,
the blue color still shows up for a significant portion.
--
Pat.AddColorStop 0.7, vbRed
Pat.AddColorStop 0.99, vbGreen
Pat.AddColorStop 1, vbBlue
--
In the above setting, Blue has to be rendered with 1% - e.g. when you render a horz-Gradient over the whole ScreenWidth,
then Blue would (on a HD-Screen) occupy 1% = 19 Pixels ... so yes, that would definitely be visible.
In the above setting, Blue has to be rendered with 1% - e.g. when you render a horz-Gradient over the whole ScreenWidth,
then Blue would (on a HD-Screen) occupy 1% = 19 Pixels ... so yes, that would definitely be visible.
Olaf
But, in my system, in a picturebox of 300 pixels width and 105 pixels height, the blue color was occuping more than 100 pixels. I don't know why. So, what I did was to try the following:
--
Pat.AddColorStop 0.75, vbRed
Pat.AddColorStop 0.24, vbGreen
Pat.AddColorStop 0.01, vbBlue
--
The above case seemed to work. Thanks a TON. Yes, the blue color was visible to a lesser width only (about 10 pixels, before the mixing with green color starts). But, the blue color appeared first rather than the last. I attach a screenshot hereunder for the purpose of elucidating. Thanks again.
EDIT:
Okay, the stop is at 0.01 now. So, the blue appears first. I missed the obvious again. Sorry.
Well, I am trying to achieve the gradient of red 75%, green 24% and blue 1% in my system correctly, in a PictureBox of 300*105 (w*h), using your Cairo Wrapper. When I succeed in achieving it, I will write here again. Thanks. As of now, as mentioned earlier, the blue is occupying more width than it should. Some mistake I am doing, I think.
Edit 2:
Well, I was all the while trying a setting of "0.75, 0.99, 1" for an angle of 45 degrees. In that case only (i.e. in case of gradient at an angle only), the blue was appearing with more width. For an angle of 0 or 90, the blue appears correctly (as it should, for 1%)
Well, finally, for illustrating hereunder, I tried the setting of "0.75, 0.95, 1". The result was - for an angle of 0 or 90, the blue appears correctly (as it should, for 5%). For any other angle I give, the blue color's width increases. For an angle of 45, it is as hereunder (for the "0.75, 0.95, 1" setting). What mistake am I doing? To the same code, if I pass 0 or 90 as angle, the width of blue is correct. So, I don't know what mistake I am doing while giving other angles.
What I was/am "expecting" (for an angle of 45 degree) is as hereunder:
Kindly point out my mistake and kindly please help me achieve the above "expected" gradient (at 45 degree) in Cairo. Kindly point out to me the correct 'ColorStop setting' values. My PictureBox size is 300*79.
Note:
When I was trying out the above, I tried out "CC.Surface.WriteContentToPngFile", etc. too. Awesome. Facility to straightaway save the image in this manner is very useful. Actually, I need to ask more about "PDF saving" but I think it is proper to ask about it in a separate thread. So, I shall do that later. Also, I need to know whether/how I can deploy your DLLs "registration free" (just copy them) in end-user systems? Well, for asking questions like these, is there a separate and "dedicated thread" already running (like in the case of "Krool's CommonControls replacement" thread) where I can ask any question related to your stupendous vbRichClient work? If so, kindly let me know. If not, kindly let me know whether I have to open a new thread for each query I have regarding your DLLs. Thanks.
[RESOLVED] picturebox upsidedown-gradient
Reply With Quote
Originally Posted by LaVolpe
