|
Option Strict On
Option Explicit On
Imports Microsoft.Win32
Public Class Form1
Private Const EffectsRoot As String = _
"SOFTWARE\Microsoft\MediaPlayer\Objects\Effects"
Private Structure InstWmpVis
Dim VisName As String
Dim ClassID As Guid
End Structure
Private rnd As New Random()
Private bolRenderWin As Boolean = False
Private cVis As New WmpVisual
Private tRect As New WmpVisual.RECT
Private tTimedLevel As New WmpVisual.TimedLevel
Private bDummyFreq As Byte() = New Byte(WmpVisual.SA_BUFFER_SIZE - 1) {}
Private bDummyWave As Byte() = New Byte(WmpVisual.SA_BUFFER_SIZE - 1) {}
Private tInstWmpVis As InstWmpVis() = New InstWmpVis() {}
Private Sub Form1_FormClosed(ByVal sender As Object, _
ByVal e As System.Windows.Forms.FormClosedEventArgs) _
Handles Me.FormClosed
Timer1.Enabled = False
If bolRenderWin = True Then
If cVis.Destroy = True Then
bolRenderWin = False
End If
End If
cVis.DestroyVis()
cVis = Nothing
End Sub
Private Sub Form1_Load(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles Me.Load
cmdPropPage.Enabled = False
cmdPropPage.Text = "Show Propertypage"
cmdPresetDown.Enabled = False
cmdPresetDown.Text = "<< Preset"
cmdPresetUp.Enabled = False
cmdPresetUp.Text = "Preset >>"
Using VisRoot As RegistryKey = _
Registry.LocalMachine.OpenSubKey(EffectsRoot)
Dim VisSubKeyNames As String() = VisRoot.GetSubKeyNames()
Dim VisCount As Integer = VisRoot.SubKeyCount
Array.Resize(tInstWmpVis, VisCount)
For VisItem As Integer = 0 To VisCount - 1
tInstWmpVis(VisItem).VisName = VisSubKeyNames(VisItem)
cbInstVis.Items.Add(VisSubKeyNames(VisItem))
Using VisProp As RegistryKey = _
Registry.LocalMachine.OpenSubKey( _
EffectsRoot & "\" & VisSubKeyNames(VisItem) & _
"\Properties")
tInstWmpVis(VisItem).ClassID = _
New Guid(VisProp.GetValue("classid").ToString)
End Using
Next
End Using
cbInstVis.SelectedIndex = 0
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Timer1.Tick
rnd.NextBytes(bDummyFreq)
rnd.NextBytes(bDummyWave)
With tTimedLevel
.State = WmpVisual.PlayerState.Play_State
.Frequency.Data0 = bDummyFreq
.Frequency.Data1 = bDummyFreq
.Waveform.Data0 = bDummyWave
.Waveform.Data1 = bDummyWave
End With
Timer1.Enabled = False
If bolRenderWin = True Then
If cVis.RenderWindowed(tTimedLevel, True) = True Then
Timer1.Enabled = True
End If
Else
With tRect
.Left = 0
.Top = 0
.Right = pbRenderVis.Size.Width
.Bottom = pbRenderVis.Size.Height
End With
If cVis.Render(tTimedLevel, pbRenderVis.Handle, tRect) = True Then
Timer1.Enabled = True
End If
End If
End Sub
Private Sub cmdPropPage_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles cmdPropPage.Click
cVis.DisplayPropertyPage(Me.Handle)
End Sub
Private Sub cmdPresetUp_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles cmdPresetUp.Click
If cVis.GetCurrentPreset < cVis.GetPresetCount - 1 Then
cmdPresetDown.Enabled = True
If cVis.SetCurrentPreset(cVis.GetCurrentPreset + 1) = True Then
If cVis.GetCurrentPreset = cVis.GetPresetCount - 1 Then
cmdPresetUp.Enabled = False
End If
End If
Else
cmdPresetUp.Enabled = True
End If
SetLblPresetName()
End Sub
Private Sub cmdPresetDown_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles cmdPresetDown.Click
If cVis.GetCurrentPreset > 0 Then
cmdPresetUp.Enabled = True
If cVis.SetCurrentPreset(cVis.GetCurrentPreset - 1) = True Then
If cVis.GetCurrentPreset = 0 Then
cmdPresetDown.Enabled = False
End If
End If
Else
cmdPresetDown.Enabled = True
End If
SetLblPresetName()
End Sub
Private Sub SetLblPresetName()
lblPresetName.Text = cVis.GetPresetTitle(cVis.GetCurrentPreset) & _
" [Preset " & (cVis.GetCurrentPreset + 1).ToString & _
" von " & cVis.GetPresetCount.ToString & "]"
End Sub
Private Sub cbInstVis_SelectedIndexChanged(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles cbInstVis.SelectedIndexChanged
Timer1.Enabled = False
If bolRenderWin = True Then
If cVis.Destroy = True Then
bolRenderWin = False
End If
End If
cVis.DestroyVis()
cmdPropPage.Enabled = False
cmdPresetDown.Enabled = False
cmdPresetUp.Enabled = False
If cVis.InitVis( _
tInstWmpVis(cbInstVis.SelectedIndex).ClassID) = True Then
Me.Text = cVis.GetTitle
If cVis.GetPresetCount - 1 > 0 Then
cmdPresetUp.Enabled = True
End If
If (cVis.GetCapabilities And _
WmpVisual.Capabilities.EFFECT_HASPROPERTYPAGE) = _
WmpVisual.Capabilities.EFFECT_HASPROPERTYPAGE Then
cmdPropPage.Enabled = True
End If
SetLblPresetName()
If cVis.UsedIWmpEffects2 = True Then
bolRenderWin = cVis.Create(pbRenderVis.Handle)
End If
Timer1.Interval = 25
Timer1.Enabled = True
Else
pbRenderVis.Invalidate()
lblPresetName.Text = _
"Diese Visualisierung lässt sich nicht anzeigen."
Me.Text = "Error"
End If
End Sub
End Class
Option Strict On
Option Explicit On
Imports System.Runtime.InteropServices
Public Class WmpVisual
Public Const SA_BUFFER_SIZE As Integer = 1024
Private Const TimedLevelMaxFrequency As Single = 22050
Private Const TimedLevelMinFrequency As Single = 20
Private Const S_OK As Integer = 0
Private Const CLSCTX_INPROC_SERVER As Integer = 1
Private IID_IUnknown As New Guid("00000000-0000-0000-C000-000000000046")
Private WmpVis As Object = Nothing Private Effects As IWmpEffects Private Effects2 As IWmpEffects2
<DllImport("ole32.dll", EntryPoint:="CoCreateInstance")> _
Private Shared Function CoCreateInstance(ByRef clsid As Guid, _
<MarshalAs(UnmanagedType.IUnknown)> ByVal inner As Object, _
ByVal context As Integer, ByRef uuid As Guid, _
<MarshalAs(UnmanagedType.IUnknown)> _
ByRef rReturnedComObject As Object) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="GetDC")> _
Private Shared Function GetDC(ByVal hwnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="ReleaseDC")> _
Private Shared Function ReleaseDC(ByVal hwnd As IntPtr, _
ByVal hdc As IntPtr) As Integer
End Function
Public Enum PlayerState As Integer
Stop_State = 0
Pause_State = 1
Play_State = 2
End Enum
Public Enum Capabilities As Integer
EFFECT_CANGOFULLSCREEN = &H1
EFFECT_HASPROPERTYPAGE = &H2
EFFECT_VARIABLEFREQSTEP = &H4
EFFECT_WINDOWED_ONLY = &H8
EFFECT2_FULLSCREENEXCLUSIVE = &H10
End Enum
<StructLayout(LayoutKind.Sequential)> _
Public Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure Data
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=SA_BUFFER_SIZE)> _
Public Data0() As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=SA_BUFFER_SIZE)> _
Public Data1() As Byte
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure TimedLevel
Public Frequency As Data
Public Waveform As Data
Public State As PlayerState
Public TimeStamp As Int64
End Structure
<Guid("D3984C13-C3CB-48e2-8BE5-5168340B4F35")> _
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IWmpEffects
Function Render(ByRef pLevels As TimedLevel, ByVal Hdc As IntPtr, _
ByRef pRC As RECT) As Integer
Function MediaInfo(ByVal lChannelCount As Integer, _
ByVal lSampleRate As Integer, _
ByVal bstrTitle As String) As Integer
Function GetCapabilities(ByRef pdwCapabilities As Integer) As Integer
Function GetTitle(ByRef bstrTitle As String) As Integer
Function GetPresetTitle(ByVal nPreset As Integer, _
ByRef bstrPresetTitle As String) As Integer
Function GetPresetCount(ByRef count As Integer) As Integer
Function SetCurrentPreset(ByVal currentpreset As Integer) As Integer
Function GetCurrentPreset(ByRef currentpreset As Integer) As Integer
Function DisplayPropertyPage(ByVal hwndOwner As IntPtr) As Integer
Function GoFullScreen(ByVal fFullscreen As Boolean) As Integer
Function RenderFullScreen(ByRef pLevels As TimedLevel) As Integer
End Interface
<Guid("695386EC-AA3C-4618-A5E1-DD9A8B987632")> _
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IWmpEffects2
Inherits IWmpEffects
Shadows Function Render(ByRef pLevels As TimedLevel, _
ByVal Hdc As IntPtr, ByRef pRC As RECT) As Integer
Shadows Function MediaInfo(ByVal lChannelCount As Integer, _
ByVal lSampleRate As Integer, ByVal bstrTitle As String) As Integer
Shadows Function GetCapabilities( _
ByRef pdwCapabilities As Integer) As Integer
Shadows Function GetTitle(ByRef bstrTitle As String) As Integer
Shadows Function GetPresetTitle(ByVal nPreset As Integer, _
ByRef bstrPresetTitle As String) As Integer
Shadows Function GetPresetCount(ByRef count As Integer) As Integer
Shadows Function SetCurrentPreset( _
ByVal currentpreset As Integer) As Integer
Shadows Function GetCurrentPreset( _
ByRef currentpreset As Integer) As Integer
Shadows Function DisplayPropertyPage( _
ByVal hwndOwner As IntPtr) As Integer
Shadows Function GoFullScreen(ByVal fFullscreen As Boolean) As Integer
Shadows Function RenderFullScreen( _
ByRef pLevels As TimedLevel) As Integer
Function SetCore(ByVal pPlayer As IntPtr) As Integer
Function Create(ByVal hwndParent As IntPtr) As Integer
Function Destroy() As Integer
Function NotifyNewMedia(ByVal pMedia As IntPtr) As Integer
Function OnWindowMessage(ByVal Msg As Integer, _
ByVal WParam As Integer, ByVal LParam As Integer, _
ByRef plResultParam As Integer) As Integer
Function RenderWindowed(ByRef pData As TimedLevel, _
ByVal fRequiredRender As Boolean) As Integer
End Interface
Public Function InitVis(ByVal VisGUID As Guid) As Boolean
If WmpVis Is Nothing Then
If CoCreateInstance(VisGUID, Nothing, _
CLSCTX_INPROC_SERVER, IID_IUnknown, WmpVis) = S_OK Then
Effects = TryCast(WmpVis, IWmpEffects)
If Effects IsNot Nothing Then
Effects2 = TryCast(WmpVis, IWmpEffects2)
If Effects2 IsNot Nothing Then
Effects = Nothing
End If
Me.SetCurrentPreset(0)
InitVis = True
End If
End If
End If
End Function
Public Function DestroyVis() As Boolean
If WmpVis IsNot Nothing Then
If Marshal.FinalReleaseComObject(WmpVis) = 0 Then
If Effects2 IsNot Nothing Then
Effects2 = Nothing
End If
If Effects IsNot Nothing Then
Effects = Nothing
End If
WmpVis = Nothing
DestroyVis = True
End If
End If
End Function
Public Function UsedIWmpEffects2() As Boolean
If Effects2 IsNot Nothing Then
UsedIWmpEffects2 = True
End If
End Function
Public Function Render(ByRef pLevels As TimedLevel, _
ByVal hwndParent As IntPtr, _
ByRef pRC As RECT) As Boolean
Dim dcParent As IntPtr = GetDC(hwndParent)
If dcParent <> IntPtr.Zero Then
If Effects2 Is Nothing Then
If Effects.Render(pLevels, dcParent, pRC) = S_OK Then
Render = True
End If
Else
If Effects2.Render(pLevels, dcParent, pRC) = S_OK Then
Render = True
End If
End If
ReleaseDC(hwndParent, dcParent)
End If
End Function
Public Function MediaInfo(ByVal lChannelCount As Integer, _
ByVal lSampleRate As Integer, ByVal bstrTitle As String) As Boolean
If Effects2 Is Nothing Then
If Effects.MediaInfo(lChannelCount, lSampleRate, _
bstrTitle) = S_OK Then
MediaInfo = True
End If
Else
If Effects2.MediaInfo(lChannelCount, lSampleRate, _
bstrTitle) = S_OK Then
MediaInfo = True
End If
End If
End Function
Public Function GetCapabilities() As Integer
Dim intRet As Integer = -1
If Effects2 Is Nothing Then
If Effects.GetCapabilities(intRet) = S_OK Then
GetCapabilities = intRet
End If
Else
If Effects2.GetCapabilities(intRet) = S_OK Then
GetCapabilities = intRet
End If
End If
End Function
Public Function GetTitle() As String
Dim strRet As String = ""
If Effects2 Is Nothing Then
If Effects.GetTitle(strRet) = S_OK Then
GetTitle = strRet
Else
GetTitle = ""
End If
Else
If Effects2.GetTitle(strRet) = S_OK Then
GetTitle = strRet
Else
GetTitle = ""
End If
End If
End Function
Public Function GetPresetTitle(ByVal nPreset As Integer) As String
Dim strRet As String = ""
If Effects2 Is Nothing Then
If Effects.GetPresetTitle(nPreset, strRet) = S_OK Then
GetPresetTitle = strRet
Else
GetPresetTitle = ""
End If
Else
If Effects2.GetPresetTitle(nPreset, strRet) = S_OK Then
GetPresetTitle = strRet
Else
GetPresetTitle = ""
End If
End If
End Function
Public Function GetPresetCount() As Integer
Dim intRet As Integer = -1
If Effects2 Is Nothing Then
If Effects.GetPresetCount(intRet) = S_OK Then
GetPresetCount = intRet
End If
Else
If Effects2.GetPresetCount(intRet) = S_OK Then
GetPresetCount = intRet
End If
End If
End Function
Public Function SetCurrentPreset(ByVal currentpreset As Integer) As Boolean
If Effects2 Is Nothing Then
If Effects.SetCurrentPreset(currentpreset) = S_OK Then
SetCurrentPreset = True
End If
Else
If Effects2.SetCurrentPreset(currentpreset) = S_OK Then
SetCurrentPreset = True
End If
End If
End Function
Public Function GetCurrentPreset() As Integer
Dim intRet As Integer = -1
If Effects2 Is Nothing Then
If Effects.GetCurrentPreset(intRet) = S_OK Then
GetCurrentPreset = intRet
End If
Else
If Effects2.GetCurrentPreset(intRet) = S_OK Then
GetCurrentPreset = intRet
End If
End If
End Function
Public Function DisplayPropertyPage(ByVal hwndOwner As IntPtr) As Boolean
If Effects2 Is Nothing Then
If Effects.DisplayPropertyPage(hwndOwner) = S_OK Then
DisplayPropertyPage = True
End If
Else
If Effects2.DisplayPropertyPage(hwndOwner) = S_OK Then
DisplayPropertyPage = True
End If
End If
End Function
Public Function GoFullScreen(ByVal fFullscreen As Boolean) As Boolean
If Effects2 Is Nothing Then
If Effects.GoFullScreen(fFullscreen) = S_OK Then
GoFullScreen = True
End If
Else
If Effects2.GoFullScreen(fFullscreen) = S_OK Then
GoFullScreen = True
End If
End If
End Function
Public Function RenderFullScreen(ByRef pLevels As TimedLevel) As Boolean
If Effects2 Is Nothing Then
If Effects.RenderFullScreen(pLevels) = S_OK Then
RenderFullScreen = True
End If
Else
If Effects2.RenderFullScreen(pLevels) = S_OK Then
RenderFullScreen = True
End If
End If
End Function
Public Function SetCore(ByVal pPlayer As IntPtr) As Boolean
If Effects2 IsNot Nothing Then
If Effects2.SetCore(pPlayer) = S_OK Then
SetCore = True
End If
End If
End Function
Public Function Create(ByVal hwndParent As IntPtr) As Boolean
If Effects2 IsNot Nothing Then
If Effects2.Create(hwndParent) = S_OK Then
Create = True
End If
End If
End Function
Public Function Destroy() As Boolean
If Effects2 IsNot Nothing Then
If Effects2.Destroy = S_OK Then
Destroy = True
End If
End If
End Function
Public Function NotifyNewMedia(ByVal pMedia As IntPtr) As Boolean
If Effects2 IsNot Nothing Then
If Effects2.NotifyNewMedia(pMedia) = S_OK Then
NotifyNewMedia = True
End If
End If
End Function
Public Function OnWindowMessage(ByVal Msg As Integer, _
ByVal WParam As Integer, ByVal LParam As Integer) As Integer
Dim intRet As New Integer
If Effects2 IsNot Nothing Then
If Effects2.OnWindowMessage(Msg, WParam, LParam, intRet) = S_OK Then
OnWindowMessage = intRet
End If
End If
End Function
Public Function RenderWindowed(ByRef pData As TimedLevel, _
ByVal fRequiredRender As Boolean) As Boolean
If Effects2 IsNot Nothing Then
If Effects2.RenderWindowed(pData, fRequiredRender) = S_OK Then
RenderWindowed = True
End If
End If
End Function
Public Function Frequency_Index(ByVal Freq As Single) As Integer
Frequency_Index = CInt((Freq - TimedLevelMinFrequency) / (( _
TimedLevelMaxFrequency - TimedLevelMinFrequency) / _
SA_BUFFER_SIZE))
End Function
End Class |