1
Hi!
I am trying to use the following code in a little VB.Net project and I just cant get it to work. I get an error that says the "adressof"-command isnt using the right delegate type and some functions seem to be missin return commands?!? Could someone please have a look at this and maybe change it, so it works in VB.Net?
Thank you :)
Christian
====
Attribute VB_Name = "Module_PaceMaker"
' ==========================================
' PaceMaker plug-in message control routines
' ==========================================
' Copyleft (c) Olli Parviainen 2004
'
' These routines allow Visual Basic programs to control PaceMaker plug-in.
' Please visit http://www.iki.fi/oparviai/pacemaker for more information about
' PaceMaker plug-in.
'
' Usage:
' - First grab handle of active PaceMaker plug-in window by calling
' PaceMaker_SeekHandle()
' - Then use the handle to control the PaceMaker plug-in with routines
' PaceMaker_GetVersion(), PaceMaker_SetTempo(), PaceMaker_SetPitch() and so on.
'
' License: All permissions granted. This source code can be used, modified and
' included in applications without restrinctions.
'
' $Id: PaceMaker.bas,v 1.1 2004/08/28 13:16:34 Olli Exp $
'
' ================================================== ===========================
' Windows API function declarations
Private Declare Function EnumWindows Lib "USER32.dll" (ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "USER32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, _
ByVal lpString As String, ByVal aint As Long) As Long
Private Declare Function SendMessageTimeout Lib "USER32.dll" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As _
Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function PostMessage Lib "USER32.dll" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private hPaceMaker As Long
' Constants
Private Const SMTO_ABORTIFHUNG = 2
Private Const WM_APP = 32768
Private Const SCALE_COEFF = 1000
Public Const PM_IDENTIFY = WM_APP + 0
Public Const PM_GETVERSION = WM_APP + 1
Public Const PM_ENABLE_SHADOWMODE = WM_APP + 2
Public Const PM_ENABLE_TWEAKING = WM_APP + 3
Public Const PM_RESET = WM_APP + 5
Public Const PM_SET_TEMPO = WM_APP + 6
Public Const PM_SET_PITCH = WM_APP + 7
Public Const PM_SET_SPEED = WM_APP + 8
Public Const PM_IS_REGISTERED = WM_APP + 10
' This function checks if a window being enumerated has a title beginning
' with "PaceMaker"
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sWindowTitle As String
Dim r As Integer
Dim response As Long
sWindowTitle = Space(255)
' Compare beginning of window title
r = GetWindowText(hwnd, sWindowTitle, 255)
EnumWindowsProc = True
If Left(sWindowTitle, 9) = "PaceMaker" Then
' Found a window having title beginning with "PaceMaker...".
' Test now that it's the real thing.
If PaceMaker_SendCommand(hwnd, PM_IDENTIFY, 0, response) <> 0 Then
' We got a response of some kind
If response = &H1770 Then
' Ho! found PaceMaker
hPaceMaker = hwnd
EnumWindowsProc = False
End If
End If
End If
End Function
'Function that returns handle to PaceMaker window if found
Public Function PaceMaker_SeekHandle() As Long
hPaceMaker = 0
' Call function 'EnumWindows' to seek for a window with title
' beginning with 'PaceMaker'
r = EnumWindows(AddressOf EnumWindowsProc, hPaceMaker)
PaceMaker_SeekHandle = hPaceMaker
End Function
' Subroutine for sending a command query message to PaceMaker
Public Function PaceMaker_SendCommand(hPaceMaker As Long, command As Long, _
param As Long, response As Long) As Long
PaceMaker_SendCommand = SendMessageTimeout(hPaceMaker, command, param, 0, SMTO_ABORTIFHUNG, 1000, response)
End Function
' Get PaceMaker version identifier.
Public Function PaceMaker_GetVersion(hPaceMaker As Long) As Long
r = PaceMaker_SendCommand(hPaceMaker, PM_GETVERSION, 0, PaceMaker_GetVersion)
End Function
' Query if PaceMaker plug-in has been registered (requirement for commercial use etc).
Public Function PaceMaker_IsRegistered(hPaceMaker As Long) As Long
r = PaceMaker_SendCommand(hPaceMaker, PM_IS_REGISTERED, 0, PaceMaker_IsRegistered)
End Function
' Enable/disable PaceMaker window shadow mode
Public Sub PaceMaker_EnableShadowMode(hPaceMaker As Long, bEnable As Boolean)
r = PostMessage(hPaceMaker, PM_ENABLE_SHADOWMODE, 0, bEnable)
End Sub
' Enable/disable PaceMaker sound tweaking
Public Sub PaceMaker_EnableTweaking(hPaceMaker As Long, bEnable As Boolean)
r = PostMessage(hPaceMaker, PM_ENABLE_TWEAKING, 0, bEnable)
End Sub
' Reset PaceMaker tempo/pitch/speed controls
Public Sub PaceMaker_Reset(hPaceMaker As Long)
r = PostMessage(hPaceMaker, PM_RESET, 0, 0)
End Sub
' Set new tempo setting
Public Sub PaceMaker_SetTempo(hPaceMaker As Long, ByVal Tempo As Double)
Dim value As Long
value = Tempo * SCALE_COEFF
r = PostMessage(hPaceMaker, PM_SET_TEMPO, 0, value)
End Sub
' Set new pitch setting
Public Sub PaceMaker_SetPitch(hPaceMaker As Long, ByVal Pitch As Double)
Dim value As Long
value = Pitch * SCALE_COEFF
r = PostMessage(hPaceMaker, PM_SET_PITCH, 0, value)
End Sub
' Set new speed setting
Public Sub PaceMaker_SetSpeed(hPaceMaker As Long, ByVal Speed As Double)
Dim value As Long
value = Speed * SCALE_COEFF
r = PostMessage(hPaceMaker, PM_SET_SPEED, 0, value)
End Sub
