السلام عليكم ورحمة الله
اليكم هذا الكود الرائع الذى يقوم بعمل تأثير انفجار على الفورم وهو منقول من برنامج مكتبة الاكواد للاستاذ هيثم القلاف ارجو أن يعجبكم :rolleyes:
Sub Explode(frm As Form) frm.Width = 0 frm.Height = 0 frm.Show For x = 0 To 5000 Step 250 frm.Width = x frm.Height = x With frm .Left = (Screen.Width - .Width) / 2 .Top = (Screen.Height - .Height) / 2 End With Next x End Sub
وهذ كود اخر يؤثر على طريقة دخول وخروج الفورم وهو من نفس البرنامج
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open) 'Add 1 Command Button to your form. 'Insert the following code to your module: 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 ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal _ hdc As Long) As Long Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal _ crColor 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 CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Private Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject _ As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private 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 Private 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 'Insert this code to your form: Private Sub Command1_Click() 'Replace all the '500' below with the Speed of the Explode\Implode Effect. Call ImplodeForm(Me, 500) End Set Form1 = Nothing End Sub Private Sub Form_Load() Call ExplodeForm(Me, 500) End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Call ImplodeForm(Me, 500) End Sub
شكراً للجميع :rolleyes:
