• Home
 · 
• Games
 · 
• Single module including API calls and simplified methods for the following tasks: Play Wave audio,

Single module including API calls and simplified methods for the following tasks: Play Wave audio,

Single module including API calls and simplified methods for the following tasks: Play Wave audio, Midi music, stopping music, BitBlt,

API Declarations



'Miscellaneous API and methods library by SPARAL It.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Written March 29th, 2006
' Visit http://www.sparal.com for more!


Option Explicit

'API Calls
'==========

'Various Standard API Functions for manipulation of DCs and Bitmaps
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

'For clicking and draggong forms
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

'Wave and MIDI functions
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
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 mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private MidiFile As String

'returns state of a specified key
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

'executes a shell command. eg an URL
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'check if a character is alphabetic
Private Declare Function IsCharAlpha Lib "user32" Alias "IsCharAlphaA" (ByVal cChar As Byte) As Long
Private Declare Function IsCharAlphaNumeric Lib "user32" Alias "IsCharAlphaNumericA" (ByVal cChar As Byte) As Long

'for always on top
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1

'checks if system can play sound.
Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long



Rate Single module including API calls and simplified methods for the following tasks: Play Wave audio,

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'Determines wether the system can play sounds.
Function CheckSoundHardware() As Boolean
If waveOutGetNumDevs() > 0 Then
    CheckSoundHardware = True
Else
    CheckSoundHardware = False
End If
End Function

'Plays a MIDI file. Note that the path is set to App.Path
Public Sub PlayMidi(ByVal FileName As String)
FileName = App.Path & "\" & FileName
MidiFile = FileName
mciSendString "OPEN " + FileName + " TYPE SEQUENCER ALIAS " + "midifile", 0&, 0, 0
mciSendString "PLAY " + FileName + " FROM 0", 0&, 0, 0
mciSendString "CLOSE ANIMATION", 0&, 0, 0
End Sub

'Stops the current MIDI file.
Public Sub StopMidi()
mciSendString "OPEN " + MidiFile + " TYPE SEQUENCER ALIAS " + "midifile", 0&, 0, 0
mciSendString "STOP " + MidiFile, 0&, 0, 0
mciSendString "CLOSE ANIMATION", 0&, 0, 0
End Sub

'Plays wave audio. Note that the path is set to App.Path.
Function PlaySound(ByVal File As String, Optional ByVal spFlags As Integer = 1) As Long
PlaySound = sndPlaySound(App.Path & "\" & File, spFlags)
End Function

'Makes the target form stay on top of other windows. Call it in the
'Load() event of a form.
Sub AlwaysOnTop(ByRef frm As Form)
Call SetWindowPos(frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub

'Executes an url, e.g. http://www.sparal.com
Function HyperLink(ByVal hlURL As String, Optional ByVal hlOperation As String = "open") As Long
    HyperLink = ShellExecute(hwnd, hlOperation, hlURL, vbNullString, vbNullString, conSwNormal)
End Function

'Determines wether a specific key is down.
'Sample usage: result = KeyDown(vbKeyLeft)
Public Function KeyDown(ByVal KeyCode As Long) As Boolean
    If GetKeyState(KeyCode) < 0 Then
        KeyDown = True
    End If
End Function

'Returns wether the specified file exists.
Function FileExists(FileName As String) As Boolean
If Not Dir$(FileName, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbArchive) = vbNullString Then
    FileExists = True
End If
End Function

'Allows you to click and drag a form on a Form_MouseDown event.
'Sample:
'   Private Sub Form_MouseDown()
'       Dim result As Long
'       result = ClickDragForm(Me.hwnd)
'   End Sub
Function ClickDragForm(ByVal hwnd, Optional ByVal wMsg As Long = WM_NCLBUTTONDOWN, Optional ByVal wParam As Long = HTCAPTION, Optional ByVal lParam As Variant = 0&) As Long
ReleaseCapture
ClickDragForm = SendMessage(hwnd, wMsg, wParam, lParam)
End Function