Programming Forums > Application Development > Visual Basic

fox123 · Apr 1st, 2005, 1:54 PM

Hi,
Does anyone know some code which enables a form to "Fade in and Fade Out"
Also Does anyone know how to make a form "Shrink" Below is some code to make a form Grow

You must first create a module (See Below)

(Toggle Plain Text)

Public Sub CentreForm(F As Form)
  F.Move (Screen.Width - F.Width) \ 2, (Screen.Height - F.Height) \ 2
End Sub

Now insert this into the form

(Toggle Plain Text)

 Private Sub Form_Load()
    Me.Width = 0 'Starting Size Can Be Changed To What You Want
    Me.Height = 0
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    Timer1.Enabled = True
    End Sub 

    Private Sub Timer1_Timer()  
    Me.Height = Me.Height + 50
         Me.Width = Me.Width + 72

    If Me.Width > 6195 Then  'Can be change accordingly
         Timer1.Enabled = False
    End If
    CentreForm Me ' Relates to module
    End Sub

Timers must be set to an interval of 1

Can the above code be change to make it shrink?
Any Ideas about the fading?
Thanks

Rory · Apr 2nd, 2005, 9:47 PM

I can't be held responsible for tasteless misuse of this code

So put this in your form:

(Toggle Plain Text)

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 Sub Form_Activate()
Dim Alpha As Byte
Dim Delay As Single
Do
    Delay = Timer
    Do While (Timer - Delay) < 0.01
        DoEvents
    Loop
    Alpha = Alpha + 5
    SetLayeredWindowAttributes Me.hWnd, 0, Alpha, LWA_ALPHA
Loop Until Alpha = 255
End Sub

Private Sub Form_Load()
    Dim Ret As Long
    Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
End Sub

charge · Oct 20th, 2005, 5:44 AM

Hi. The fading form works if its mdi value is false. I have created an mdi main form and two mdi client form and i want to apply the fading effect on one of the client mdi form. Does anyone know how to make this happen?

Thanks!

Rory · Oct 20th, 2005, 12:23 PM

Unfortunately the layered window attribute LWA_ALPHA is only directly exposed for parent (top level) objects, meaning you could use this code only on the MDI parent as it is. One work-around, aside from complex subclassing, would be to use the SetParent API plus pictureboxes instead of the MDI form system (which I personally think is rather crap).

So say if you had two forms, Form1 and Form2 on screen, form1 being the simulated "MDI parent" with a picture box called PictureBox1:

(Toggle Plain Text)

' in some module
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

' called on startup
SetParent Form2.Hwnd, Form1.PictureBox1.Hwnd

Then if you put the fade in code onto form2 it should work.

As an aside, I think that's a much better way of creating container forms than the built in VB6 way, as it allows much more control over layout, window region etc, even in VB.NET and C# when using Windows.Forms.

13EN · Nov 22nd, 2005, 2:34 PM

i downloaded some help for vb6 and the shrink code was in it but not the fade sorry. here is the grow shrink anyway:

(Toggle Plain Text)

'Shrink the form
'Decrease the form height by 100 twips
frmFormFun.Height = frmFormFun.Height - 100
'Decrease the form width by 100 twips
frmFormFun.Width = frmFormFun.Width - 100
End Sub

13EN · Nov 22nd, 2005, 2:34 PM

by the way make a command box and put that code in

Rory · Nov 23rd, 2005, 2:47 PM

Quote:

Originally Posted by 13EN

by the way make a command box and put that code in

Surely you mean a timer control, a loop or a repeating thread? Anyway the best way to make an animation like this would be to use a sprite rather than the window itself (custom type for the window animation API or manually implemented using graphical methods) as the form DC is constantly re-drawn and consequently looks jerky.

Also the question was fairly specific, about alphablending on a MDI form, as well as being several months old!

13EN · Dec 21st, 2005, 7:03 AM

i mean a command box. you click the button and the form shrinks and shrinks untill u stop.

Apr 1st, 2005, 1:54 PM	#1
fox123 Newbie Join Date: Mar 2005 Posts: 25 Rep Power: 0	Visual Basic 6.0 Form Effects Hi, Does anyone know some code which enables a form to "Fade in and Fade Out" Also Does anyone know how to make a form "Shrink" Below is some code to make a form Grow You must first create a module (See Below) (Toggle Plain Text) Public Sub CentreForm(F As Form) F.Move (Screen.Width - F.Width) \ 2, (Screen.Height - F.Height) \ 2 End Sub Public Sub CentreForm(F As Form) F.Move (Screen.Width - F.Width) \ 2, (Screen.Height - F.Height) \ 2 End Sub Now insert this into the form (Toggle Plain Text) Private Sub Form_Load() Me.Width = 0 'Starting Size Can Be Changed To What You Want Me.Height = 0 Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() Me.Height = Me.Height + 50 Me.Width = Me.Width + 72 If Me.Width > 6195 Then 'Can be change accordingly Timer1.Enabled = False End If CentreForm Me ' Relates to module End Sub Private Sub Form_Load() Me.Width = 0 'Starting Size Can Be Changed To What You Want Me.Height = 0 Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() Me.Height = Me.Height + 50 Me.Width = Me.Width + 72 If Me.Width > 6195 Then 'Can be change accordingly Timer1.Enabled = False End If CentreForm Me ' Relates to module End Sub Timers must be set to an interval of 1 Can the above code be change to make it shrink? Any Ideas about the fading? Thanks Last edited by fox123; Apr 1st, 2005 at 2:06 PM.

Apr 2nd, 2005, 9:47 PM	#2
Rory Expert Programmer Join Date: Jan 2005 Location: London Posts: 542 Rep Power: 4	I can't be held responsible for tasteless misuse of this code So put this in your form: (Toggle Plain Text) Const LWA_COLORKEY = &H1 Const LWA_ALPHA = &H2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 Sub Form_Activate() Dim Alpha As Byte Dim Delay As Single Do Delay = Timer Do While (Timer - Delay) < 0.01 DoEvents Loop Alpha = Alpha + 5 SetLayeredWindowAttributes Me.hWnd, 0, Alpha, LWA_ALPHA Loop Until Alpha = 255 End Sub Private Sub Form_Load() Dim Ret As Long Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret End Sub Const LWA_COLORKEY = &H1 Const LWA_ALPHA = &H2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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 Sub Form_Activate() Dim Alpha As Byte Dim Delay As Single Do Delay = Timer Do While (Timer - Delay) < 0.01 DoEvents Loop Alpha = Alpha + 5 SetLayeredWindowAttributes Me.hWnd, 0, Alpha, LWA_ALPHA Loop Until Alpha = 255 End Sub Private Sub Form_Load() Dim Ret As Long Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret End Sub

Oct 20th, 2005, 5:44 AM	#3
charge Newbie Join Date: Oct 2005 Posts: 1 Rep Power: 0	Fade not working in MDI Hi. The fading form works if its mdi value is false. I have created an mdi main form and two mdi client form and i want to apply the fading effect on one of the client mdi form. Does anyone know how to make this happen? Thanks!

Oct 20th, 2005, 12:23 PM	#4
Rory Expert Programmer Join Date: Jan 2005 Location: London Posts: 542 Rep Power: 4	Unfortunately the layered window attribute LWA_ALPHA is only directly exposed for parent (top level) objects, meaning you could use this code only on the MDI parent as it is. One work-around, aside from complex subclassing, would be to use the SetParent API plus pictureboxes instead of the MDI form system (which I personally think is rather crap). So say if you had two forms, Form1 and Form2 on screen, form1 being the simulated "MDI parent" with a picture box called PictureBox1: (Toggle Plain Text) ' in some module Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long ' called on startup SetParent Form2.Hwnd, Form1.PictureBox1.Hwnd ' in some module Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long ' called on startup SetParent Form2.Hwnd, Form1.PictureBox1.Hwnd Then if you put the fade in code onto form2 it should work. As an aside, I think that's a much better way of creating container forms than the built in VB6 way, as it allows much more control over layout, window region etc, even in VB.NET and C# when using Windows.Forms.

Nov 22nd, 2005, 2:34 PM	#5
13EN Newbie Join Date: Nov 2005 Posts: 13 Rep Power: 0	i downloaded some help for vb6 and the shrink code was in it but not the fade sorry. here is the grow shrink anyway: (Toggle Plain Text) 'Shrink the form 'Decrease the form height by 100 twips frmFormFun.Height = frmFormFun.Height - 100 'Decrease the form width by 100 twips frmFormFun.Width = frmFormFun.Width - 100 End Sub 'Shrink the form 'Decrease the form height by 100 twips frmFormFun.Height = frmFormFun.Height - 100 'Decrease the form width by 100 twips frmFormFun.Width = frmFormFun.Width - 100 End Sub

Dec 21st, 2005, 7:03 AM	#8
13EN Newbie Join Date: Nov 2005 Posts: 13 Rep Power: 0	i mean a command box. you click the button and the form shrinks and shrinks untill u stop.

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Programming Forums > Application Development > Visual Basic

Visual Basic 6.0 Form Effects