1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SWL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Sub UserForm_Activate()
Me.Caption = "Excel Player V2.0: lecture de : " & StrReverse(Split(StrReverse(Me.Tag), "\")(0))
H = FindWindow(vbNullString, Me.Caption) ' on determine le handle de l'userform
x = ExtractIconA(0, "C:\Program Files\Windows Media Player\wmplayer.exe", 0)
SendMessageA H, &H80, False, x
Me.WebBrowser1.Move 0, 0, Me.InsideWidth + 12, Me.InsideHeight, 0
video = Replace("H:\" & Me.Tag, "\", "/")
'ecriture du code html dans le webbrowser
code = code & "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">" & vbCrLf
code = code & "<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""fr"" >" & vbCrLf
code = code & "<head><meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & vbCrLf
code = code & "<style>* { margin:0; padding:0; }</style></head>" & vbCrLf
code = code & "<body><div id=""DV"">" & vbCrLf
code = code & "<embed src=""" & video & """ type=""application/x-shockwave-flash"" wmode=""transparent"" width=""100%"" height=""100%""></embed>" & vbCrLf
code = code & "</div></body></html>" & vbCrLf
With WebBrowser1
.Navigate "about:blank"
Do: DoEvents: Loop Until .ReadyState = 4
.Document.write code
End With
SWL H, -16, &H94CF0080 ''j'ajoute le bouton minimiser et maximiser a la caption du userform avec l'api SetWindowLongA
Debug.Print code
End Sub
Private Sub UserForm_Resize()
WebBrowser1.Move 0, 0, Me.InsideWidth + 12, Me.InsideHeight, 0
End Sub |
Partager