Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Good morning, I'm working on a proj

Status
Not open for further replies.

Goodloe

Programmer
Sep 4, 2001
25
US
Good morning, I'm working on a project that requires the form background to change or rotate colors according to the colors I specify.

Do you know of any VB Code that can fade form background colors in and out, or more specifically rotate specified
colors from a fading perspective?

I am using a timer for rotating purposes, and it's doing
pretty much what I would like for it do in terms of rotating. However, it doesn't fade the colors in and out.
I would like the colors to fade in and out.

THANKS
 
Hi Goodloe,

2 examples which i got from Planet Source code some time ago might help:

1/

Option Explicit

'Shade a form

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

' Shade a form
'
' Optional Arguments:
' StartColor is what color to start with.
' (Default = vbBlue)
' Fstep is the number of steps to use to fill the form.
' (Default = 64)
' Cstep is the color step (change in color per step).
' (Default = 4)
'
' Note: the effect can be reversed by calling ShadeForm with
' a StartColor near black (but not completely 0) and by
' setting a negative color step.
'
Public Sub ShadeForm(f As Form, Optional StartColor As Variant, Optional Fstep As Variant, Optional Cstep As Variant)
Dim FillStep As Single ' Not an integer because sometimes
' rounding leaves a large bottom region
Dim c As Long
Dim FillArea As RECT
Dim i As Integer
Dim oldm As Integer
Dim hBrush As Long
Dim c2(1 To 3) As Long
Dim cs2(1 To 3) As Long
Dim fs As Long
Dim cs As Integer

' Set defaults
fs = IIf(IsMissing(Fstep), 64, CLng(Fstep))
cs = IIf(IsMissing(Cstep), 4, CInt(Cstep))
c = IIf(IsMissing(StartColor), vbBlue, CLng(StartColor))


oldm = f.ScaleMode
f.ScaleMode = vbPixels
FillStep = f.ScaleHeight / fs
FillArea.Left = 0
FillArea.Right = f.ScaleWidth
FillArea.Top = 0

' Break down the color and set individual
' color steps
c2(1) = c And 255#
cs2(1) = IIf(c2(1) > 0, cs, 0)
c2(2) = (c \ 256#) And 255#
cs2(2) = IIf(c2(2) > 0, cs, 0)
c2(3) = (c \ 65536#) And 255#
cs2(3) = IIf(c2(3) > 0, cs, 0)


For i = 1 To fs
FillArea.Bottom = FillStep * i

hBrush = CreateSolidBrush(RGB(c2(1), c2(2), c2(3)))
FillRect f.hdc, FillArea, hBrush
DeleteObject hBrush

' Could do this in a loop, but it's simple
' and may be faster.
c2(1) = (c2(1) - cs2(1)) And 255#
c2(2) = (c2(2) - cs2(2)) And 255#
c2(3) = (c2(3) - cs2(3)) And 255#

FillArea.Top = FillArea.Bottom
Next i

f.ScaleMode = oldm
End Sub


Private Sub Command1_Click()
ShadeForm Me
End Sub


2/

Public Function Gradient(form1 As Form, col As String)
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = 0
k = form1.ScaleWidth / 300

On Error GoTo err

If LCase(col) = "yellow" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, 0)
j = j + 1
Next i
End If

If LCase(col) = "red" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, 0, 0)
j = j + 1
Next i
End If

If LCase(col) = "white" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, c$)
j = j + 1
Next i
End If

If LCase(col) = "blue" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(0, 0, c$)
j = j + 1
Next i
End If

If LCase(col) = "marine" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(0, b$, c$)
j = j + 1
Next i
End If

If LCase(col) = "aqua" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(0, b$, c$)
j = j + 1
Next i
End If

If LCase(col) = "purple" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, 0, c$)
j = j + 1
Next i
End If

If LCase(col) = "gold" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, 0)
j = j + 1.5
Next i
End If

If LCase(col) = "silver" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, c$)
j = j + 1.5
Next i
End If

If LCase(col) = "green" Then
For i = 0 To form1.ScaleWidth
a$ = i / k
b$ = i / k
c$ = i / k
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(0, b$, 0)
j = j + 1
Next i
End If

If LCase(col) = "mystic01" Then
For i = 0 To form1.ScaleWidth
a$ = i / k + 97
b$ = i / k
c$ = i / k + 191
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, c$)
j = j + 1
Next i
End If

If LCase(col) = "mystic02" Then
For i = 0 To form1.ScaleWidth
a$ = i / k + 200
b$ = i / k + 25
c$ = i / k + 75
form1.Line (j, 0)-(j, form1.ScaleHeight), RGB(a$, b$, c$)
j = j + 1
Next i
End If

err:
End Function

---------------

This Code is "Copied and Pasted" from the original Zip downloaded from the Web Site. Its not MY code, so sorry for the readability and its presentation, but it does work.

Regards,

Codefish
 
I used the code that you recommended regarding form background color changes with the fade concept. It didn't
quite do what I was looking for, it basically gave a form
with one faded solid color.

I was looking for something like form background colors
that rotate from one color to another, but in a fading
format.

In other words, when the form gets loaded; it might be a
certain solid color, and it fade its way into another solid
color, and then another, and so on.

The colors I'm working with are White, Light Grey, Med Grey,
Dark Grey, Dark Dark Grey, and finally Black.

The purpose or idea is to get a Day Light Scene that will
graudially fade into a Night Scene. I know this might be a
bit much to ask, but is it possible that you know of to
create such a thing in Visual Basic, and if so can you help
me out including providing sample code? Thanks a Million.
 
within the timer

Set the form.backcolor via the RGB(Red, Green, Blue).

Where Red, Green and Blue are the component color intensities. White would be 0, 0, 0 and Black is 255, 255, 255.

You can fiddle / play with colors for the start / finish, or even set up a number of "stops" and fade from one to the next. Typically, "Early Morning" would start w/ a dark Grey, fading to an Orange / Silver (lt Grey) and then to the day's lighting? (Clea and sunny, overcast, rainy, snowy, ...) and so on throughout the day. It SHOULD be possible to even place clouds, sun, moon, stars on the background and have them move and change colors and shapes w/ much trouble (but perhaps w/ a fair duty cycle on the the old cpu).

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
I just wanted to take this time to thank you for your
efforts in trying to help me solve the problems regarding
my Form Color Changes. However, I wasn't able to get it to
work. I guess in order for it to have worked, I would have had to see the actual code the way it would be appear in
the Timer1_Timer Sub, and the Form_Load Sub, or anywhere
else where their would be VB Code.

I decided to let it go and go onto something else. I realize that what I was asking of you was very tedious and
timely. So, once again thanks, and happy holiday's.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top