I would like to have a picture appear gradually (like a fade)
I thought something like this might work:
crappy code I know - but should this work?Code:picAdvert.Width = 0
Dim i As Integer
For i = 1 To picAdvert.Width
picAdvert.Width = i
Next
SImon
Printable View
I would like to have a picture appear gradually (like a fade)
I thought something like this might work:
crappy code I know - but should this work?Code:picAdvert.Width = 0
Dim i As Integer
For i = 1 To picAdvert.Width
picAdvert.Width = i
Next
SImon
You've got the right idea but that would be more of a scroll than a fade and on higher end computers it would happen so fast you wouldn't even see it, add a sleep call of 5ms or something.
Also you set the width of the picturebox to 1 at the start, preventing it from working. The for loop starts the i var off at one so you don't need to do it.
Here is an example of fading a form using a slider control. I know
you can change it to the picturebox, but only works on Windows 2K +.
HTHVB Code:
Option Explicit 'CONTROLS: '1 Slider (Slider1) 'Microsoft Windows Common Controls 6.0 (SP 5 or SP 6) Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _ (ByVal lpLibFileName As String) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _ ByVal lpProcName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, _ ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Public Sub AlphaBlendForm(ByVal lHwnd As Long, ByVal intTranslucenceLevel As Integer) If APIExists("SetLayeredWindowAttributes", "User32") Then SetWindowLong lHwnd, GWL_EXSTYLE, WS_EX_LAYERED SetLayeredWindowAttributes lHwnd, 0, intTranslucenceLevel, LWA_ALPHA Else MsgBox "Your OS does not support Alpha Blending.", vbExclamation, "Alpha Blend" End If End Sub Public Function APIExists(ByVal pstrFunctionName As String, ByVal pstrDllName As String) As Boolean Dim lngHandle As Long Dim lngAddr As Long lngHandle = LoadLibrary(pstrDllName) If Not (lngHandle = 0) Then lngAddr = GetProcAddress(lngHandle, pstrFunctionName) FreeLibrary lngHandle End If APIExists = Not (lngAddr = 0) End Function Private Sub Form_Load() Slider1.Max = 255 Slider1.Min = 10 Slider1.LargeChange = 5 AlphaBlendForm Me.hwnd, 255 'MAX VALUE = OPAIC/ MIN VALUE = 0 CAN'T SEE Slider1.Value = 255 End Sub Private Sub Slider1_Scroll() AlphaBlendForm Me.hwnd, Slider1.Value End Sub