modcfmp3.bas

一个很小的在任务栏上运行的MP3播放器。

Attribute VB_Name = "modcfmp3"
Option Explicit

Public success As Long
Public T As String
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

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

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Private rectLastTray As RECT
Private rectLastRebar As RECT
Private rectLastNotify As RECT
Private hwndForm As Long
Private lngTimer As Long
Private intWidth As Integer
Private intHeight As Integer
Private blnGrow As Boolean



Public Sub AttachForm(MyForm As Form, Optional intForceWidth As Integer = 0, Optional intForceHeight As Integer = 0, Optional blnGrowWithTray As Boolean = False)
    hwndForm = MyForm.hWnd

    If intForceWidth <> 0 Then
        intWidth = intForceWidth
    Else
        intWidth = MyForm.Width
    End If

    If intForceHeight <> 0 Then
        intHeight = intForceHeight
    Else
        intHeight = MyForm.Height
    End If

    blnGrow = blnGrowWithTray

    SetParent hwndForm, GetTrayHandle

    lngTimer = SetTimer(hwndForm, 0, 50, AddressOf MainLoop)

End Sub

Public Sub DetachForm()
    Dim rectTray As RECT
    Dim rectTrayClient As RECT
    Dim rectRebar As RECT
    Dim rectNotify As RECT

    Dim X As Long
    Dim y As Long
    Dim W As Long
    Dim H As Long

    GetWindowRect GetTrayHandle, rectTray
    GetClientRect GetTrayHandle, rectTrayClient
    GetWindowRect GetRebarHandle, rectRebar
    GetWindowRect GetNotifyHandle, rectNotify

    SetParent hwndForm, vbNull

    KillTimer hwndForm, lngTimer

        If (rectTray.Right - rectTray.Left) = (Screen.Width / Screen.TwipsPerPixelX) Then

            X = rectRebar.Left - rectTray.Left
            y = rectTrayClient.Top
            W = rectNotify.Left - rectRebar.Left
            H = rectRebar.Bottom - rectRebar.Top
            MoveWindow GetRebarHandle, X, y, W, H, 1
            GetWindowRect GetRebarHandle, rectRebar
        ElseIf (rectTray.Bottom - rectTray.Top) = (Screen.Height / Screen.TwipsPerPixelY) Then

            X = rectTrayClient.Left
            y = rectRebar.Top - rectTray.Top
            H = rectNotify.Top - rectRebar.Top
            W = rectRebar.Right - rectRebar.Left
            MoveWindow GetRebarHandle, X, y, W, H, 1
            GetWindowRect GetRebarHandle, rectRebar
        End If
End Sub


Sub MainLoop()
    Dim rectTray As RECT
    Dim rectTrayClient As RECT
    Dim rectRebar As RECT
    Dim rectNotify As RECT

    Dim X As Long
    Dim y As Long
    Dim W As Long
    Dim H As Long
    
    On Error Resume Next
    
    DoEvents

    GetWindowRect GetTrayHandle, rectTray
    GetClientRect GetTrayHandle, rectTrayClient
    GetWindowRect GetRebarHandle, rectRebar
    GetWindowRect GetNotifyHandle, rectNotify

    If rectTray.Top <> rectLastTray.Top Or rectRebar.Right <> rectLastRebar.Right Or rectNotify.Left <> rectLastNotify.Left Then

        If (rectTray.Right - rectTray.Left) > (rectTray.Bottom - rectTray.Top) Then

            X = rectRebar.Left - rectTray.Left
            y = rectTrayClient.Top
            W = rectNotify.Left - rectRebar.Left - intWidth
            H = rectRebar.Bottom - rectRebar.Top
            MoveWindow GetRebarHandle, X, y, W, H, 1
            GetWindowRect GetRebarHandle, rectRebar

            X = rectRebar.Right
            y = rectTrayClient.Top + 4
            W = intWidth

            If (intHeight > (rectTrayClient.Bottom - rectTrayClient.Top - 6)) Or blnGrow = True Then
                H = rectTrayClient.Bottom - rectTrayClient.Top - 6
            Else
                H = intHeight
            End If
            MoveWindow hwndForm, X, y, W, H, 1
        
        ElseIf (rectTray.Bottom - rectTray.Top) > (rectTray.Right - rectTray.Left) Then

            X = rectTrayClient.Left
            y = rectRebar.Top - rectTray.Top
            H = rectNotify.Top - rectRebar.Top - intHeight
            W = rectRebar.Right - rectRebar.Left
            MoveWindow GetRebarHandle, X, y, W, H, 1
            GetWindowRect GetRebarHandle, rectRebar

            X = rectTrayClient.Left + 4
            y = rectRebar.Bottom
            H = intHeight

            If (intWidth > (rectTrayClient.Right - rectTrayClient.Left - 6)) Or blnGrow = True Then
                W = rectTrayClient.Right - rectTrayClient.Left - 6
            Else
                W = intWidth
            End If
            MoveWindow hwndForm, X, y, W, H, 1
        End If
    
    End If
    
    rectLastTray = rectTray
    rectLastRebar = rectRebar
    rectLastNotify = rectNotify
End Sub


Private Function GetTrayHandle() As Long
    
    Dim hWnd_Tray As Long
    
    hWnd_Tray = FindWindow("Shell_TrayWnd", "")
    GetTrayHandle = hWnd_Tray
End Function

Private Function GetRebarHandle() As Long

    Dim hWnd_Tray As Long
    Dim hWnd_Rebar As Long
    
    hWnd_Tray = FindWindow("Shell_TrayWnd", "")
    
    If hWnd_Tray <> 0 Then
        hWnd_Rebar = FindWindowEx(hWnd_Tray&, 0, "ReBarWindow32", vbNullString)
    End If
    
    GetRebarHandle = hWnd_Rebar
End Function

Function GetNotifyHandle() As Long

    Dim hWnd_Tray As Long
    Dim hWnd_Notify As Long
    
    hWnd_Tray = FindWindow("Shell_TrayWnd", "")
    
    If hWnd_Tray <> 0 Then
        hWnd_Notify = FindWindowEx(hWnd_Tray&, 0, "TrayNotifyWnd", vbNullString)
    End If
    
    GetNotifyHandle = hWnd_Notify
End Function