Hi there
Ive have a picture box witha single colour background, but how do you fade one colour into another, as an example vbblue -> vbgreen
thanks in advance
Printable View
Hi there
Ive have a picture box witha single colour background, but how do you fade one colour into another, as an example vbblue -> vbgreen
thanks in advance
Code:For x=0 to picture1.scalewidth
for y=0 to picture1.scaleheight
a=x/picture1.scalewidth
ColorC=(a*(ColorA mod 256)+(1-a)*(ColorB mod 256))\2+(a*((ColorA\256) mod 256)+(1-a)*(ColorB\256 mod 256))*128+(a*(ColorA\65536)+(1-a)*(ColorB\65536))*32768
pset(x,y),ColorC
next y
next x
J/K!
Thanks for the code, but it doesnt seem to work, the form itself starts to fade, although the fade is only the same height as the picture box, also it is very slow and the program is almost unusable.
Is it me or the code, i feel cheeky telling a guru that this does not work, ;)
ok sorry, i got the fade into the picture box(Pset), but there are still lots of colours,(not just 2) and it is still very slow.
You can call the following sub something like this:
TwoColorFade Picture1, RGB(255, 153, 0), , 1
and it would create a orange to black vertical fade on Picture1.
Public Sub TwoColorFade(objDest As Object, _
Optional StartColor As Long = vbWhite, _
Optional EndColor As Long = vbBlack, _
Optional Direction As Integer = 0)
Dim sInc(2) As Single
Dim sCol(2) As Single, sCol2(2) As Single
Dim i As Integer, j As Integer
Dim iWid As Integer, iHgt As Integer
Dim lCol As Long
Dim iTimes As Integer
With objDest
.ScaleMode = vbPixels
' this line important if using the circular fade
.DrawWidth = 2
iWid = .ScaleWidth
iHgt = .ScaleHeight
End With
' to prevent Division by zero(11) or Overflow(6) errors
If iWid = 0 Or iHgt = 0 Then Exit Sub
Select Case Direction
Case 0: iTimes = iHgt
Case 1: iTimes = iWid
Case 2: iTimes = Sqr(((iWid ^ 2) + (iHgt ^ 2)) / 4)
End Select
' populate arrays with R, G, B data based on given colors
LNGtoRGB StartColor, sCol()
LNGtoRGB EndColor, sCol2()
' calculate separate increments for R,G, and B componets
For i = 0 To 2
sInc(i) = (sCol2(i) - sCol(i)) / iTimes
Next
For i = 0 To iTimes
' get color
lCol = RGB(sCol(0), sCol(1), sCol(2))
Select Case Direction
' horizontal
Case 0: objDest.Line (0, i)-(iWid, i), lCol
' vertical
Case 1: objDest.Line (i, 0)-(i, iHgt), lCol
' circular
Case 2: objDest.Circle (iWid / 2, iHgt / 2), i, lCol
End Select
' increment the R, G, B componets of the starting color
For j = 0 To 2: sCol(j) = sCol(j) + sInc(j): Next
Next
End Sub
Public Sub LNGtoRGB(ByVal lCol As Long, ByRef sngRGB() As Single)
sngRGB(0) = lCol And &HFF
sngRGB(1) = (lCol \ &H100) And &HFF
sngRGB(2) = (lCol \ &H10000) And &HFF
End Sub