home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / explodit / explode2.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-01  |  2.3 KB  |  62 lines
  1. 'User and GDI Functions for Explode to work
  2. Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
  3. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  4. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  5. Declare Sub SetBkColor Lib "GDI" (ByVal hDC As Integer, ByVal crColor As Long)
  6. 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)
  7. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  8. Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  9. Declare Sub DeleteObject Lib "GDI" (ByVal hObject As Integer)
  10.  
  11. Sub CenterForm (frm As Form)
  12.     Dim X, y                    ' New top, left for the form
  13.     X = (Screen.Width - frm.Width) / 2
  14.     y = (Screen.Height - frm.Height) / 2
  15.     frm.Move X, y             ' Change location of the form
  16. End Sub
  17.  
  18. Sub Explode (frm As Form, CFlag As Integer)
  19. Const STEPS = 150 'Lower Number Draws Faster, Higher Number Slower
  20. Dim FRect As RECT
  21. Dim FWidth, FHeight As Integer
  22. Dim I, X, y, Cx, Cy As Integer
  23. Dim hScreen, Brush As Integer, OldBrush
  24.  
  25. ' If CFlag = True, then explode from center of form, otherwise
  26. ' explode from upper left corner.
  27.     GetWindowRect frm.hWnd, FRect
  28.     FWidth = (FRect.Right - FRect.Left)
  29.     FHeight = FRect.Bottom - FRect.Top
  30.     
  31. ' Create brush with Form's background color.
  32.     hScreen = GetDC(0)
  33.     Brush = CreateSolidBrush(frm.BackColor)
  34.     OldBrush = SelectObject(hScreen, Brush)
  35.     
  36. ' Draw rectangles in larger sizes filling in the area to be occupied
  37. ' by the form.
  38.     For I = 1 To STEPS
  39.         Cx = FWidth * (I / STEPS)
  40.         Cy = FHeight * (I / STEPS)
  41.         If CFlag Then
  42.             X = FRect.Left + (FWidth - Cx) / 2
  43.             y = FRect.Top + (FHeight - Cy) / 2
  44.         Else
  45.             X = FRect.Left
  46.             y = FRect.Top
  47.         End If
  48.         Rectangle hScreen, X, y, X + Cx, y + Cy
  49.     Next I
  50.     
  51. ' Release the device context to free memory.
  52. ' Make the Form visible
  53.  
  54.     If ReleaseDC(0, hScreen) = 0 Then
  55.         MsgBox "Unable to Release Device Context", 16, "Device Error"
  56.     End If
  57.     DeleteObject (Brush)
  58.     frm.Show 1
  59.  
  60. End Sub
  61.  
  62.