home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Matt_Playe176515722004.psc / FFT / mixer / modFrmOps.bas < prev    next >
BASIC Source File  |  2004-07-02  |  4KB  |  120 lines

  1. Attribute VB_Name = "modFrmOps"
  2. 'This module is for basic api declares and some form effects
  3. 'Author: Matt Gillmore (SCO_STINKS@Yahoo.com)
  4.  
  5. Type RECT
  6.     Left As Long
  7.     Top As Long
  8.     Right As Long
  9.     Bottom As Long
  10. End Type
  11. Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
  12. Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
  13. Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal _
  14.     hdc As Long) As Long
  15. Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal _
  16.     crColor As Long) As Long
  17. Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, _
  18.     ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  19. Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
  20. Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
  21. Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  22.  
  23. Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
  24. Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  25. Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  26.  
  27. Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  28. Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  29. Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  30. Declare Function BitBlt Lib "gdi32" ( _
  31.     ByVal hDestDC As Long, _
  32.     ByVal lngX As Long, ByVal lngY As Long, _
  33.     ByVal nWidth As Long, _
  34.     ByVal nHeight As Long, _
  35.     ByVal hSrcDC As Long, _
  36.     ByVal lngXSrc As Long, ByVal lngYSrc As Long, _
  37.     ByVal dwRop As Long) As Long
  38. Declare Function GetDesktopWindow Lib "user32" () As Long
  39.  
  40.  
  41. Type POINTAPI
  42.         X As Long
  43.         Y As Long
  44. End Type
  45.  
  46. Public Sub ExplodeForm(f As Form, Movement As Integer)
  47. Dim myRect As RECT
  48. Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
  49. Dim TheScreen As Long
  50. Dim Brush As Long
  51.     
  52.     GetWindowRect f.hWnd, myRect
  53.     formWidth = (myRect.Right - myRect.Left)
  54.     formHeight = myRect.Bottom - myRect.Top
  55.     TheScreen = GetDC(0)
  56.     Brush = CreateSolidBrush(f.BackColor)
  57.     For i = 1 To Movement
  58.         Cx = formWidth * (i / Movement)
  59.         Cy = formHeight * (i / Movement)
  60.         X = myRect.Left + (formWidth - Cx) / 2
  61.         Y = myRect.Top + (formHeight - Cy) / 2
  62.         Rectangle TheScreen, X, Y, X + Cx, Y + Cy
  63.         DoEvents
  64.     Next i
  65.     X = ReleaseDC(0, TheScreen)
  66.     DeleteObject (Brush)
  67. End Sub
  68. Public Sub ImplodeForm(f As Form, Movement As Integer)
  69. Dim myRect As RECT
  70. Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
  71. Dim TheScreen As Long
  72. Dim Brush As Long
  73.     
  74.     GetWindowRect f.hWnd, myRect
  75.     formWidth = (myRect.Right - myRect.Left)
  76.     formHeight = myRect.Bottom - myRect.Top
  77.     TheScreen = GetDC(0)
  78.     Brush = CreateSolidBrush(f.BackColor)
  79.     For i = Movement To 1 Step -1
  80.         Cx = formWidth * (i / Movement)
  81.         Cy = formHeight * (i / Movement)
  82.         X = myRect.Left + (formWidth - Cx) / 2
  83.         Y = myRect.Top + (formHeight - Cy) / 2
  84.         Rectangle TheScreen, X, Y, X + Cx, Y + Cy
  85.         DoEvents
  86.     Next i
  87.     X = ReleaseDC(0, TheScreen)
  88.     DeleteObject (Brush)
  89. End Sub
  90. Function GetNumTracks%()
  91. Dim s As String * 30
  92.     
  93.     GetNumTracks = "0"
  94.     mciSendString "status cd number of tracks wait", s, Len(s), 0
  95.     
  96.     If Left(s, 1) <> vbNullChar Then
  97.         
  98.         GetNumTracks = CInt(Mid$(s, 1, 2))
  99.  
  100.     End If
  101.  
  102. End Function
  103.  
  104. Function GetCurTrack() As Integer
  105.  
  106. Dim lRet As Integer
  107. Dim c1(2) As POINTAPI
  108. Dim sPos As String * 30
  109. Dim sTrack As Integer
  110. Dim sMin As Integer
  111. Dim sSec As Integer
  112.  
  113.     lRet = mciSendString("status cd position", sPos, Len(sPos), 0)
  114.     If lRet = 0 Then
  115.         GetCurTrack = CInt(Mid$(sPos, 1, 2))
  116.     End If
  117.     
  118. End Function
  119.  
  120.