Faded Background with API
This handy little chunk of code will show you how to create a faded background on a form, using the Windows API.
Option Explicit
' Data type used by FillRect
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' API Functions used to create solid brush and draw brush on form
Public Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Public Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Public Sub FadeForm(frm As Form, colStart As Long, colEnd As Long)
Dim red As Single
Dim green As Single
Dim blue As Single
Dim redStep As Single
Dim greenStep As Single
Dim blueStep As Single
Dim StepInterval As Single
Dim X As Long
Dim ret As Long
Dim OldMode As Long
Dim FillArea As RECT
Dim rTop As Single
Dim hBrush As Long
' retrive the old scale mode of the form
OldMode = frm.ScaleMode
' set the Scale Mode of the form to Pixels
frm.ScaleMode = vbPixels
' calculate the vertical step and the colors step
StepInterval = frm.ScaleHeight / 64
blue = (colStart \ &H10000) And &HFF
blueStep = (blue - ((colEnd \ &H10000) And &HFF)) / 64
green = (colStart \ &H100) And &HFF
greenStep = (green - ((colEnd \ &H100) And &HFF)) / 64
red = (colStart And &HFF)
redStep = (red - (colEnd And &HFF)) / 64
rTop = 0
FillArea.Left = 0
FillArea.Right = frm.ScaleWidth
FillArea.Top = 0
FillArea.Bottom = StepInterval
' paint the form with a gradient brush
For X = 1 To 64
hBrush = CreateSolidBrush(RGB(red, green, blue))
ret = FillRect(frm.hdc, FillArea, hBrush)
ret = DeleteObject(hBrush)
red = red - redStep
green = green - greenStep
blue = blue - blueStep
rTop = rTop + StepInterval
FillArea.Top = rTop
FillArea.Bottom = rTop + StepInterval
Next
End Sub
Usage
Create a Form and add the following code in the Paint and Resize events
Private Sub Form_Paint()
' Paint the Form's Background starting with Blue on top and fading to black
FadeForm Me, RGB(0, 0, 255), RGB(0, 0, 0)
End Sub
Private Sub Form_Resize()
' Do the same on the resize event
FadeForm Me, RGB(0, 0, 255), RGB(0, 0, 0)
End Sub
Special Instructions
This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.