Form açılışına ve kapanışına zoom efekti

[mayhemious]

Küçülerek Kapanan Form



'Projeye 1 adet modül ekleyin

‘Formunuza 1 adet buton ekleyin



‘Asagıdakileri modüle kopyalayın



#If Win16 Then

Type RECT

Left As Integer

Top As Integer

Right As Integer

Bottom As Integer

End Type

#Else

Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

#End If



#If Win16 Then

Declare Sub GetWindowRect Lib "User" (ByVal hwnd As Integer, lpRect As RECT)

Declare Function GetDC Lib "User" (ByVal hwnd As Integer) As Integer

Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer

Declare Sub SetBkColor Lib "GDI" (ByVal hdc As Integer, ByVal crColor As Long)

Declare Sub Rectangle Lib "GDI" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)

Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer

Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject As Integer) As Integer

Declare Sub DeleteObject Lib "GDI" (ByVal hObject As Integer)

#Else

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

#End If



Sub ExplodeForm(f As Form, Movement As Integer)

Dim myRect As RECT

Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%

Dim TheScreen As Long

Dim Brush As Long

GetWindowRect f.hwnd, myRect

formWidth = (myRect.Right - myRect.Left)

formHeight = myRect.Bottom - myRect.Top

TheScreen = GetDC(0)

Brush = CreateSolidBrush(f.BackColor)

For i = 1 To Movement

Cx = formWidth * (i / Movement)

Cy = formHeight * (i / Movement)

X = myRect.Left + (formWidth - Cx) / 2

Y = myRect.Top + (formHeight - Cy) / 2

Rectangle TheScreen, X, Y, X + Cx, Y + Cy

Next i

X = ReleaseDC(0, TheScreen)

DeleteObject (Brush)

End Sub



Public Sub ImplodeForm(f As Form, Movement As Integer)

Dim myRect As RECT

Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%

Dim TheScreen As Long

Dim Brush As Long

GetWindowRect f.hwnd, myRect

formWidth = (myRect.Right - myRect.Left)

formHeight = myRect.Bottom - myRect.Top

TheScreen = GetDC(0)

Brush = CreateSolidBrush(f.BackColor)

For i = Movement To 1 Step -1

Cx = formWidth * (i / Movement)

Cy = formHeight * (i / Movement)

X = myRect.Left + (formWidth - Cx) / 2

Y = myRect.Top + (formHeight - Cy) / 2

Rectangle TheScreen, X, Y, X + Cx, Y + Cy

Next i

X = ReleaseDC(0, TheScreen)

DeleteObject (Brush)

End Sub



'Asagıdakileri formunuza kopyalayın



Private Sub Command1_Click()

'Asagıdaki rakamı degistirebilirsiniz

Call ImplodeForm(Me, 5000)

End

Set Form1 = Nothing

End Sub



Private Sub Form_Load()

'Asagıdaki rakamı degistirebilirsiniz

Call ExplodeForm(Me, 5000)

End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

'Asagıdaki rakamı degistirebilirsiniz

Call ImplodeForm(Me, 5000)

End Sub

[mayhemious]

aynı mantıktaki bir baska örnek, daha basit ve sade fakat sadece form açılısında çalısıyor...

Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Sub Explode(Newform As Form, Increment As Integer)
Dim Size As RECT ' setup form as rect type
GetWindowRect Newform.hwnd, Size
Dim FormWidth, FormHeight As Integer ' establish dimension variables
FormWidth = (Size.Right - Size.Left)
FormHeight = (Size.Bottom - Size.Top)
Dim TempDC
TempDC = GetDC(ByVal 0&) ' obtain memory dc for resizing
Dim Count, LeftPoint, TopPoint, nWidth, nHeight As Integer ' establish resizing variables
For Count = 1 To Increment ' loop to new sizes
nWidth = FormWidth * (Count / Increment)
nHeight = FormHeight * (Count / Increment)
LeftPoint = Size.Left + (FormWidth - nWidth) / 2
TopPoint = Size.Top + (FormHeight - nHeight) / 2
Rectangle TempDC, LeftPoint, TopPoint, LeftPoint + nWidth, TopPoint + nHeight ' draw rectangles to build form
Next Count
DeleteDC (TempDC) ' release memory resource
End Sub
Private Sub Form_Load()
Explode Me, 10000 ' open this form by number of desired increment
End Sub