Option Explicit

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
Declare Function mciGetErrorString Lib "winmm.dll" _
  Alias "mciGetErrorStringA" _
 (ByVal dwError As Long, ByVal lpstrBuffer As String, _
  ByVal uLength As Long) As Long

Private Const LENCMDS = 512
Private Const LENERROR = 256
Private szCmds As String * LENCMDS
Private szError As String * LENERROR

Public Const MM_MCINOTIFY = &H3B9
Public Const MCI_WAIT = &H2&
Public Const MCI_NOTIFY = &H1&
Public Const MCI_NOTIFY_SUCCESSFUL = &H1
Public Const MCI_NOTIFY_SUPERSEDED = &H2
Public Const MCI_NOTIFY_ABORTED = &H4
Public Const MCI_NOTIFY_FAILURE = &H8

Declare Function GetWindowLong Lib "user32" Alias _
  "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias _
  "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias _
  "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
  ByVal msg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_HINSTANCE = (-6)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_ID = (-12)
Public Const GWL_STYLE = (-16)
Public Const GWL_USERDATA = (-21)
Public Const GWL_WNDPROC = (-4)

Private lpOrg As Long

' mciSendString を呼び出し，ステータスを得る (通知付き)
' 引数
'   s : コマンド文字列
'   ErrString : エラー時の説明文字列 or
'               正常終了時にはStatus取得
'   hWnd    : 通知するウィンドウハンドル
' 戻り値
'   エラー時にはエラー番号
'   (0は正常終了, -1 はコマンド文字列が指定されていない)
Public Function mSendString _
  (s As String, ErrString As String, hWnd As Long) As Long
   Dim r As Long

  If s <> "" Then ' コマンド文字列が指定されている
    r = mciSendString(s, szCmds, LENCMDS, hWnd)
    If r <> 0 Then  ' エラー
      If mciGetErrorString(r, szError, LENERROR) = False Then
	    ' エラー文字列が取得できなかった
	ErrString = "Error (文字列が取れません)"
      Else
	    ' エラー文字列が取得できた
	ErrString = Left(szError, InStr(szError, Chr$(0)) - 1)
      End If
      mSendString = r
    Else    ' 正常終了時にはステータスを得る
      ErrString = Left(szCmds, InStr(szCmds, Chr$(0)) - 1)
      mSendString = 0
    End If
  Else	  ' コマンド文字列が指定されていない
    ErrString = "コマンド文字列が指定されていません"
    mSendString = -1
  End If
End Function

' SubClassing WindowProc
Public Function WindowProc _
 (ByVal hWnd As Long, ByVal uMsg As Long, ByVal  _
  wParam As Long, lParam As Long) As Long
    Dim duml As Long

    'Debug.Print Hex(hWnd), Hex(uMsg), Hex(wParam), Hex(lpOrg)
    Select Case uMsg
    Case MM_MCINOTIFY
	'Debug.Print "MCI Notify " & CStr(wParam)
	frmMCITest2.picNotify.BackColor = RGB(0, 255, 0)
    End Select

    WindowProc = CallWindowProc(lpOrg, hWnd, uMsg, wParam, lParam)
End Function

' Start SubClassing
Public Sub SubClass(hWndS As Long)
    lpOrg = SetWindowLong(hWndS, GWL_WNDPROC, AddressOf WindowProc)
End Sub

' Stop SubClassing
Public Sub UnSubClass(hWndS As Long)
    Dim lpX As Long
    If lpOrg <> 0 Then
	lpX = SetWindowLong(hWndS, GWL_WNDPROC, lpOrg)
	lpOrg = 0
    End If
End Sub