VB 5/6-Tipp 0182: Form mit Effekt öffnen und schließen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

Option Explicit

Private Declare Function SetRect Lib "User32" (lpRect _
        As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal _
        X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function DrawAnimatedRects Lib "User32" _
        (ByVal hWnd As Long, ByVal idAni As Long, lprcFrom _
        As RECT, lprcTo As RECT) As Long

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

Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3

Dim TPP%

Private Sub Form_Load()
  Dim R1 As RECT, R2 As RECT
    
    TPP = Screen.TwipsPerPixelX
    
    Call SetRect(R1, Screen.Width / TPP, Screen.Height / TPP, _
                 Screen.Width / TPP, Screen.Height / TPP)
    Call SetRect(R2, 0, 0, Me.Width / TPP, Me.Height / TPP)
    
    Call DrawAnimatedRects(Me.hWnd, IDANI_CLOSE Or _
                           IDANI_CAPTION, R1, R2)

    Me.Top = 0
    Me.Left = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim R1 As RECT, R2 As RECT
  
    Call SetRect(R1, 0, 0, Me.Width / TPP, Me.Height / TPP)
    Call SetRect(R2, Screen.Width / TPP, Screen.Height / TPP, _
                 Screen.Width / TPP, Screen.Height / TPP)

    Call DrawAnimatedRects(Me.hWnd, IDANI_OPEN Or _
                           IDANI_CAPTION, R1, R2)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Günther Schubert am 23.03.2011 um 16:09

Es läuft nicht unter Win7 mit VB6

Kommentar von Rainer Wewers am 25.04.2005 um 18:33

Zwei Fehler haben sich in meinen vorherigen Beitrag eingeschlichen:
1. Width und Height werden in Right und Bottom umgerechnet, damit der Effekt auch weiter rechts oder weiter unten funktioniert.
2. Im Quelltext sollte im Form_Unload IDANI_ClOSE (statt IDANI_OPEN) stehen.

mfg Rainer

Kommentar von Rainer Wewers am 23.04.2005 um 23:15

Muss einen ja nicht immer vom Hocker hauen - ist trotzdem ganz nett!
Leider hat die Routine einen kleinen Fehler beim Aufruf. Alle Koordinaten müssen auf Pixel umgerechnet werden. Also auch Left und Top.
Dann funktionierts auch wenn das Fenster weiter rechts oder weiter unten steht.

Hier eine Korrektur.

Option Explicit

Private Declare Function SetRect Lib "User32" (lpRect _
        As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal _
        X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function DrawAnimatedRects Lib "User32" _
        (ByVal hWnd As Long, ByVal idAni As Long, lprcFrom _
        As RECT, lprcTo As RECT) As Long

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

Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3

Private Sub Form_Load()
   Dim R1 As RECT
   Dim R2 As RECT
    
   Call SetRectangle(R1, Left, Top, Width, Height)
   Call SetRectangle(R2, Screen.Width, Screen.Height, Screen.Width, Screen.Height)
   Call DrawAnimatedRects(Me.hWnd, IDANI_OPEN Or IDANI_CAPTION, R2, R1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Dim R1 As RECT
   Dim R2 As RECT

   Call SetRectangle(R1, Left, Top, Width, Height)
   Call SetRectangle(R2, Screen.Width, Screen.Height, Screen.Width, Screen.Height)
   Call DrawAnimatedRects(Me.hWnd, IDANI_OPEN Or IDANI_CAPTION, R1, R2)
End Sub

Private Function SetRectangle(ByRef Rectangle As RECT, ByVal Left As Single, ByVal Top As Single, ByVal Width As Single, ByVal Height As Single)
   Call SetRect(Rectangle, _
                Left / Screen.TwipsPerPixelX, _
                Top / Screen.TwipsPerPixelY, _
                (Left + Width) / Screen.TwipsPerPixelX, _
                (Top + Height) / Screen.TwipsPerPixelY)
End Function

mfg Rainer

Kommentar von tuhde am 19.11.2002 um 23:39

hi, ich verwende den Tipp um beim Beenden eines Messengers dem User zu signalisieren, dass noch ein TrayIcon aktiv ist (soviel zum Sinn dieses Tipps..)
Ich hab es jedoch folgendermaßen angepasst, das es auch immer von der aktuellen Position verkleinert:

Call SetRect(R1, Me.Left / TPP, Me.Top / TPP, Me.Width / TPP, Me.Height / TPP)

Nun hab ich aber das Problem, dass wenn ich das Fenster zu weit Rechts habe (also steigende x-Werte), keine Animation mehr ausgeführt wird.

Kommentar von Hendrik Jordt am 22.08.2002 um 11:33

@ Cobra: Es geht hier sicherlich nur um die Demonstration das eine solche Aktion möglich ist.
Hoffe meine Antwort hat Dir geholfen deine Frage zu lösen.

Kommentar von Cobra am 09.07.2002 um 15:58

Wozu solch eine Animation?
Is ja lächerlich

Kommentar von Jan Thiede am 03.06.2001 um 16:42

Man könnte noch viel bessere Effekte mit der folgenden Funktion machen:
Declare Function AnimateWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean

Kommentar von Pawel am 21.03.2001 um 15:36

Hinweis: Damit der Effekt überhaupt sichtbar wird, muss in den Desktopeigenschaften auf der Seite Effekte die Option [ Fenster, Menüs und Listen animieren ] aktiviert werden!