modcommon.bas

一个类似于WinAmp的Mp3播放器,功能不错,有换肤等功能,是一个不错的vb播放器.

Attribute VB_Name = "modCommon"
'VB-Amp Pro Common Code
'======================
' These are routines used by the other forms. There are common
' filename manipulation and low-level API calling routines.
' This code also contains the definitions for structures used
' by the API's etc, and declarations for common/public variables
' (such as preference options).
'
'Additional code submitted personally:
'* Tnatsni ([e-mail]):
'   - Snap2ViewPoint, AlwaysOnTop, GetRealEstate
'* [e-mail]:
'   - Volume API calling/variable conversion help
'
'Code found on the web and incorporated:
'* Ben Baird <[e-mail]>:
'   - NotifyIcon, stuff for system tray icon and menu
'---------------------------------------------------------------

'Option Explicit

Public Const SPI_GETWORKAREA& = 48
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const MIXER_SHORT_NAME_CHARS = 16
Public Const MIXER_LONG_NAME_CHARS = 64

'Used for tray icon图标属性
Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * MAX_TOOLTIP
End Type

'Used for screen functions为荧屏功能用

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

'Used for browsing directories为浏览目录用

Public Type SHITEMID
  cb      As Long
  abID    As Byte
End Type

'Used for browsing directories为浏览目录用
Public Type ITEMIDLIST
  mkid    As SHITEMID
End Type

'Used for browsing directories为浏览目录用
Public Type BROWSEINFO
  hOwner          As Long
  pidlRoot        As Long
  pszDisplayName  As String
  lpszTitle       As String
  ulFlags         As Long
  lpfn            As Long
  lParam          As Long
  iImage          As Long
End Type

'Used for region points为区域点用

Type Coord
  X As Long
  Y As Long
End Type

'Used to store extended coordinate info for skin elements为皮肤元素储存广大的同等信息

Type DEx
  X  As Integer 'source来源
  Y  As Integer
  W  As Integer
  H  As Integer
  X2 As Integer 'dest目标
  Y2 As Integer
  W2 As Integer
  H2 As Integer
  G  As Integer 'graphic format绘图的格式
  S  As Integer 'spacing间隔
  F  As Integer 'format格式
  V  As Single  'value of slider滑动器的值
End Type

' Used for Volume Control体积控制
Type lVolType
  V As Long
End Type

Type VolType
  LV As Integer
  RV As Integer
End Type

' Used to Hold MP3 Info Tag把握 MP3 信息标签
Type IDTag
    Title As String * 30
    Artist As String * 30
    Album As String * 30
    Year As String * 4
    Comment As String * 29
    Track As String * 1 'ID3v1.1 format
    Genre As String * 1
End Type

' Used for transparent bitmaps为透明的位图用
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type


Public Prg As String, Sect As String

Public StartTime As Single, MaxTime As Single
Public Reg_Name As String, Reg_Code As String
Public InActCnt As Integer, Balance As Single

Public OptDefPath As String
Public OptCardType As Integer, OptCardPort As Integer
Public OptAlwaysOnTop As Integer, OptSnap As Integer
Public OptAuto As Integer, OptSnooze As Integer, OptSnoozeMd As Integer
Public SnoozeTm As Integer, OptSnoozeAt As String, OptMinOnSnz As Integer
Public OptSkinName As String, OptSkinPath As String, OptSavePos As Integer
Public OptExitMd As Integer, OptStartMd As Integer, OptValExt As String
Public OptStartMin As Integer, OptStartMute As Integer
Public OptStartFile As String, OptVisPLPath As String
Public OptTimeFmt As Integer, OptClrPl As Integer, OptUseTagCover As Integer
Public OptAutoPlay As Integer, OptPBOverlap As Integer, OptFriendly As Integer
Public OptSkinImport As String, OptScrollName As Integer
Public SkinInfo As String, InfoTag As IDTag

Public nfIconData As NOTIFYICONDATA

'System tray functions系统盘功能
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'SetWindowPos 这个函数能为窗口指定一个新位置和状态。它也可改变窗口在内部窗口列表中的位置。该函数与DeferWindowPos函数相似，只是它的作用是立即表现出来的（在vb里使用：针对vb窗体，如它们在win32下屏蔽或最小化，则需重设最顶部状态。如有必要，请用一个子类处理模块来重设最顶部状态
'hwnd Long，欲定位的窗口
'hWndInsertAfter Long，窗口句柄。在窗口列表中，窗口hwnd会置于这个窗口句柄的后面。也可能选用下述值之一：
'HWND_BOTTOM 将窗口置于窗口列表底部
'HWND_TOP 将窗口置于Z序列的顶部；Z序列代表在分级结构中，窗口针对一个给定级别的窗口显示的顺序
'HWND_TOPMOST 将窗口置于列表顶部，并位于任何最顶部窗口的前面
'HWND_NOTOPMOST 将窗口置于列表顶部，并位于任何最顶部窗口的后面
'x Long，窗口新的x坐标。如hwnd是一个子窗口，则x用父窗口的客户区坐标表示
'y Long，窗口新的y坐标。如hwnd是一个子窗口，则y用父窗口的客户区坐标表示
'cx Long，指定新的窗口宽度
'cy Long，指定新的窗口高度
'wFlags Long，包含了旗标的一个整数
'SWP_DRAWFRAME 围绕窗口画一个框
'SWP_HIDEWINDOW 隐藏窗口
'SWP_NOACTIVATE 不激活窗口
'SWP_NOMOVE 保持当前位置(x和y设定将被忽略)
'SWP_NOREDRAW 窗口不自动重画
'SWP_NOSIZE 保持当前大小(cx和cy会被忽略)
'SWP_NOZORDER 保持窗口在列表的当前位置(hWndInsertAfter将被忽略)
'SWP_SHOWWINDOW 显示窗口
'SWP_FRAMECHANGED 强迫一条WM_NCCALCSIZE消息进入窗口，即使窗口的大小没有改变
Declare Function 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) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

'Directory browsing functions目录浏览功能
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

'Window Region declares窗户区域宣布
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Coord, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function CreatePolyPolygonRgn Lib "gdi32" (lpPoint As Coord, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long

'Transparent form support functions透明的形式支持功能
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long

'Mixer functions混合器功能
Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long

'Popup menu functions弹出菜单功能
Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lpReserved As Any) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
'

'Sets the specified form to be on top or not设定被叙述的窗体在顶端上

Public Sub AlwaysOnTop(frmForm As Form, fOnTop)
        
    Const HWND_TOPMOST = -1
    Const HWND_NOTOPMOST = -2
        
    Dim lState As Long
    Dim iLeft As Integer, iTop As Integer, iWidth As Integer, iHeight As Integer
    
    With frmForm
        iLeft = .Left / Screen.TwipsPerPixelX
        iTop = .Top / Screen.TwipsPerPixelY
        iWidth = .Width / Screen.TwipsPerPixelX
        iHeight = .Height / Screen.TwipsPerPixelY
    End With
        
    If fOnTop Then
        lState = HWND_TOPMOST
    Else
        lState = HWND_NOTOPMOST
    End If
    Call SetWindowPos(frmForm.hwnd, lState, iLeft, iTop, iWidth, iHeight, 0)
    
End Sub

'Snaps form to edges of screen area
Sub Snap2ViewPoint(ThaForm As Form)
   Dim RC As RECT, Zone As Integer
    
    RC = GetRealEstate
    Zone = 240
    
    'Snap Main Window to Viewpoint
    If OptSnap Then
        If (ThaForm.Top > -Zone) And (ThaForm.Top < Zone) Then ThaForm.Top = 0
        If (ThaForm.Left > -Zone) And (ThaForm.Left < Zone) Then ThaForm.Left = 0
        If (ThaForm.Top + ThaForm.Height > RC.Bottom - Zone) And (ThaForm.Top + ThaForm.Height < RC.Bottom + Zone) Then ThaForm.Top = RC.Bottom - ThaForm.Height - 15
        If (ThaForm.Left + ThaForm.Width > RC.Right - Zone) And (ThaForm.Left + ThaForm.Width < RC.Right + Zone) Then ThaForm.Left = RC.Right - ThaForm.Width
    End If
End Sub

'Find the desktop size找桌面大小

Public Function GetRealEstate() As RECT
    Dim RC As RECT
    Dim R As Long
    Dim Msg As String
    
    R = SystemParametersInfo(SPI_GETWORKAREA, 0&, RC, 0&)

    RC.Left = RC.Left * Screen.TwipsPerPixelX
    RC.Top = RC.Top * Screen.TwipsPerPixelY
    RC.Right = RC.Right * Screen.TwipsPerPixelX
    RC.Bottom = RC.Bottom * Screen.TwipsPerPixelY

    GetRealEstate = RC

End Function

'Determines if the filename is a supported bitmap file
Public Function IsPic(F As String) As Boolean
    Dim X As String
    
    X = UCase$(Right$(F, 4))
    If X = ".BMP" Or X = ".GIF" Or X = ".JPG" Then
      IsPic = True
    Else
      IsPic = False
    End If
End Function

Public Function FindCover(ByVal F As String) As String
    Dim A As String, Ext As String
    
    F = Trim$(F)
    A = ""
    Ext = ".BMP": GoSub TestIt
    Ext = ".GIF": GoSub TestIt
    Ext = ".JPG": GoSub TestIt
        
    FindCover = A
    Exit Function
  
TestIt: