Private Const WM_USER = &H400&
Private Const ACM_OPEN = WM_USER + 100&






Private Type BITMAP
bmType As Long 'LONG
bmWidth As Long 'LONG
bmHeight As Long 'LONG
bmWidthBytes As Long 'LONG
bmPlanes As Integer 'WORD
bmBitsPixel As Integer 'WORD
bmBits As Long 'LPVOID
End Type

Private Const WM_SETICON = &H80
Private Const ICON_BIG = 1

Private Const SND_APPLICATION = &H80
Private Const SND_ALIAS = &H10000
Private Const SND_ALIAS_ID = &H110000
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000
Private Const SND_LOOP = &H8
Private Const SND_MEMORY = &H4
Private Const SND_NODEFAULT = &H2
Private Const SND_NOSTOP = &H10
Private Const SND_NOWAIT = &H2000
Private Const SND_PURGE = &H40
Private Const SND_RESOURCE = &H40004
Private Const SND_SYNC = &H0

Private Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hLib As Long, _
ByVal lpName As String, ByVal lpType As String) As Long

Private Declare Function FreeResource Lib "kernel32" (ByVal hResData As Long) As Long

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLib As Long) As Long 'BOOL

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
ByVal strFilePath As String) As Long

Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, _
ByVal lngBitmapID As Long) As Long

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hLib As Long, _
ByVal lngCursorID As Long) As Long

Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hLib As Long, _
ByVal lngIconID As Long) As Long

Private Declare Function LoadString Lib "user32" Alias "LoadStringA" (ByVal hLib As Long, _
ByVal ResourceID As Long, ByVal lpBuffer As String, ByVal nBufferSize As Long) As Long

Private Declare Function LoadResource Lib "kernel32" (ByVal hLib As Long, _
ByVal hRes As Long) As Long

Private Declare Function LockResource Lib "kernel32" (ByVal hRes As Long) As Long





Private Declare Function SizeofResource Lib "kernel32" (ByVal hModule As Long, _
ByVal hResInfo As Long) As Long

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByRef Sound As Any, _
ByVal hLib As Long, ByVal lngFlag As Long) As Long 'BOOL

Private Declare Function SendMessage Lib "USER32.DLL" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Declare Function SetCursor Lib "USER32.DLL" (ByVal hCursor As Long) As Long

Private Declare Function BitBlt Lib "GDI32" (ByVal hDC_Destination As Long, _
ByVal X_Dest As Long, ByVal Y_Dest As Long, ByVal Width_Dest As Long, _
ByVal Height_Dest As Long, ByVal hDC_Source As Long, ByVal X_Src As Long, _
ByVal Y_Src As Long, ByVal RasterOperation As Long) As Long

Private Declare Function DeleteDC Lib "GDI32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hdc As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function SelectObject Lib "GDI32" (ByVal hdc As Long, ByVal hGDIObj As Long) As Long

Private Declare Function DeleteObject Lib "GDI32" (ByVal hGDIObj As Long) As Long

Private Declare Function GetObjectAPI Lib "GDI32" Alias "GetObjectA" ( _
ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDst As Any, pSrc As Any, ByVal ByteLen As Long) As Long

Private 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

Private Declare Function mciGetErrorString Lib "winmm" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Private Type PICTDESC
cbSizeofStruct As Long
picType As Long
hImage As Long
xExt As Long
yExt As Long
End Type


Dim l As Integer

'//Note : This demo assumes that you have Resource ID=101 for first iteam for each resource type
Private Function IconHandleToPicture(ByVal hIcon As Long) As IPicture
Dim pd As PICTDESC, IPic(15) As Byte
If hIcon = 0 Then Exit Function
pd.cbSizeofStruct = Len(pd)
pd.picType = vbPicTypeIcon
pd.hImage = hIcon
CLSIDFromString StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IPic(0)
OleCreatePictureIndirect pd, IPic(0), True, IconHandleToPicture
End Function

Private Sub Command1_Click()
On Error Resume Next
' Close the Resource DLL
Dim avis(0 To 1) As Integer
avis(0) = 150
avis(1) = 160
If l < UBound(avis) + 1 Then
Label2.Caption = avis(l)
Dim hRsrc As Long
Dim hGlobal As Long
Dim lpString As String
Dim strCmd As String, ret As Long
Dim nbuf As Long
'//Loads the resource
'//Change the filename argument in the next line to the path and
'//filename of your resource dll file.
'hInst = LoadLibrary(App.Path & "\test.exe") ' <<<<
hInst = LoadLibrary("SHELL32") ' <<<<


'hRsrc = FindResource(hInst, lpString, "AVI")
hRsrc = FindResource(hInst, "#" & avis(l), "AVI")

hGlobal = LoadResource(hInst, hRsrc)
lpData = LockResource(hGlobal)
fileSize = SizeofResource(hInst, hRsrc)

Call mmioInstallIOProc(MEY, AddressOf IOProc, MMIO_INSTALLPROC + MMIO_GLOBALPROC)
nbuf = 256

'//Close all opened MCI device for this app before running any new avi
Call mciSendString("Close all", 0&, 0&, 0&)

'//Play the AVI file
strCmd = "open test.MEY+ type avivideo alias test parent " & Picture2.hwnd & " Style child"
ret = mciSendString(strCmd, 0&, 0&, 0&)
If ret > 0 Then ShowMCIError (ret)

strCmd = "play test repeat"
ret = mciSendString(strCmd, 0&, 0&, 0&)
If ret > 0 Then ShowMCIError (ret)

Call mmioInstallIOProc(MEY, vbNull, MMIO_REMOVEPROC)
FreeLibrary hInst
l = l + 1

End If
If l > UBound(avis) Then
l = 0
End If
End Sub

Private Sub Form_Initialize()

XPStyle
End Sub

Private Sub Form_Load()
l = 0
Dim DataBuffer() As Byte
Dim strFilePath As String
Dim hLibrary As Long
Dim hResource As Long
Dim hData As Long
Dim lpData As Long
Dim lDataSize As Long
Dim hIcon As Long
Dim hCursor As Long
Dim hBitmap As Long
Dim strString As String
Dim lngStringLen As Long
Dim BitmapInfo As BITMAP
Dim hDC_Screen As Long
Dim hDC_Temp As Long
Dim hBMP_Prev As Long
Dim id As String

Me.Show
Me.AutoRedraw = True

'//Get the path to the Resource DLL
'//Load the Resource Dll/Exe
hLibrary = LoadLibrary("SHELL32")
If hLibrary = 0 Then
MsgBox "Failed to load the specified library with error code " & Err.LastDllError
Exit Sub
End If

Dim ics(0 To 9) As String
ics(0) = 1
ics(1) = 2
ics(2) = 3
ics(3) = 4
ics(4) = 8
ics(5) = 14
ics(6) = 16
ics(7) = 25
ics(8) = 26
ics(9) = 33
Dim i As Integer

'/////////////////////////////////////////////////////////////////////////////
' Get an icon from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////
For i = 0 To 9
hIcon = LoadIcon(hLibrary, ics(i))
If hIcon <> 0 Then
'SendMessage Me.hWnd, WM_SETICON, ICON_BIG, ByVal hIcon
Picture1.Picture = IconHandleToPicture(hIcon)
Call ImageList1.ListImages.Add(, , Picture1.Picture)
Call ListView1.ListItems.Add(, , ics(i), i + 1)

End If
Next


'/////////////////////////////////////////////////////////////////////////////
' Get a cursor from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////
'Note: Cursor will go away once this procedure is executed so put play wave
'file Synchronously so we can see the changed cursor
hCursor = LoadCursor(hLibrary, 101)
If hCursor <> 0 Then SetCursor hCursor



'/////////////////////////////////////////////////////////////////////////////
' Get a string from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////
strString = String(256, Chr(0))
lngStringLen = LoadString(hLibrary, 101, strString, Len(strString))
If lngStringLen <> 0 Then Me.Caption = Left(strString, lngStringLen)

'/////////////////////////////////////////////////////////////////////////////
' Get a bitmap from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////
hBitmap = LoadBitmap(hLibrary, 131)
If hBitmap <> 0 Then
'//Load bitmap attributes (i.e. height/width/colors... etc) into BitmapInfo
GetObjectAPI hBitmap, Len(BitmapInfo), BitmapInfo
hDC_Screen = GetDC(0)
hDC_Temp = CreateCompatibleDC(hDC_Screen)
hBMP_Prev = SelectObject(hDC_Temp, hBitmap)
BitBlt Me.hdc, 0, 0, BitmapInfo.bmWidth, BitmapInfo.bmHeight, hDC_Temp, 0, 0, vbSrcCopy
Me.Refresh
SelectObject hDC_Temp, hBMP_Prev
DeleteDC hDC_Temp
ReleaseDC 0, hDC_Screen
End If

'/////////////////////////////////////////////////////////////////////////////
' Get a .WAV file from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////



'/////////////////////////////////////////////////////////////////////////////
' Get a .AVI file from the Resource DLL/Exe
'/////////////////////////////////////////////////////////////////////////////




'Close #1

End Sub

Private Sub SaveArrayToFile(DataArray() As Byte, sSaveFilePath As String)
Dim FileNum As Long
FileNum = FreeFile
Open sSaveFilePath For Binary As #FileNum
Put #FileNum, , DataArray()
Close #FileNum
End Sub

Public Function PlayAVI(sAviFilePath As String, hWndDisplay As Long) As Boolean
Dim mciCmd As String
Dim sReturn As String * 128
Dim nWidth As Long, nHeight As Long
Dim lStart As Long, lPos As Long
Dim picWidth As Long, picHeight As Long
Dim ret As Long

mciCmd = "open """ & sAviFilePath & """ Type avivideo Alias myvideo parent " & hWndDisplay & " Style child"
ret = mciSendString(mciCmd, 0&, 0, 0)
If ret > 0 Then MsgBox GetMCIErrorString(ret), vbCritical: Exit Function

ret = mciSendString("play myvideo repeat", 0&, 0, 0)
If ret > 0 Then MsgBox GetMCIErrorString(ret), vbCritical: Exit Function

PlayAVI = True
End Function

' Get the description of a MCI error.
' ErrorCode is the code of the error
' Return a string with the description of the error.

Function GetMCIErrorString(ErrorCode As Long) As String
Dim buffer As String * 256
mciGetErrorString ErrorCode, buffer, Len(buffer)
GetMCIErrorString = Left$(buffer, InStr(buffer, vbNullChar) - 1)
End Function

Private Sub Form_Unload(Cancel As Integer)
'//Close if already playing
Call mciSendString("close all", 0&, 0, 0)
End Sub