Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

mciSendString with callback

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin mciSendString with callback

    Here is some code that will play a wav file embedded in a resource using mciSendString.
    To play from there, a mmioInstallIOProc callback is required. :-)

    A resource with a wav file is needed...
    You may download MciNotification.zip (wav, rc, pbr, bas, exe)

    Have fun ;-)

    Pierre
    .
    Click image for larger version

Name:	mmioIoProc.png
Views:	3
Size:	13.2 KB
ID:	753323

    Code:
    #COMPILE EXE '#Win 8.04#
    #DIM ALL
    #REGISTER NONE
    #INCLUDE "Win32Api.inc"
    #INCLUDE "CommCtrl.inc"
    #RESOURCE "MciNotification.pbr"
    
    %MMIO_GLOBALPROC = &H10000000
    
    DECLARE FUNCTION MemCpy CDECL LIB "MsVcRt.dll" ALIAS "memcpy" _
    (BYREF Dst AS DWORD, BYREF Src AS DWORD, BYVAL dwSize AS DWORD) AS DWORD 'Dst, Src, Size
    
    DECLARE FUNCTION mmioInstallIOProcExA LIB "WinMM.dll" ALIAS "mmioInstallIOProcA" _
    (BYVAL fccIOProc AS DWORD, BYVAL pIOProc AS DWORD, BYVAL dwFlags AS DWORD) AS LONG
    
    GLOBAL hDlg  AS DWORD
    
    $AppName = "mciSendString"
    
    %ButtonPlay   = 101
    %ButtonPause  = 102
    %ButtonResume = 103
    %ButtonStop   = 104
    %LabelInfo    = 204
    '______________________________________________________________________________
    
    FUNCTION ResourceRead(sResName AS STRING, sResType AS STRING) AS DWORD
     STATIC pData  AS DWORD
     STATIC sData  AS STRING
     LOCAL  hRes   AS DWORD
     LOCAL  dwSize AS DWORD
     LOCAL  hMem   AS DWORD
     LOCAL  pByte  AS DWORD
    
     hRes   = FindResource(GetModuleHandle(BYVAL 0), BYVAL STRPTR(sResName), BYVAL STRPTR(sResType))
     dwSize = SizeofResource(0, hRes)
     hMem   = LoadResource(0, hRes)
     pByte  = LockResource(hMem)
     sData  = NUL$(dwSize)
     pData  = STRPTR(sData)
     COPYMEMORY(pData, pByte, dwSize)
     FUNCTION = pData
    
    END FUNCTION
    '______________________________________________________________________________
    
    FUNCTION mciGetError$(mciError AS LONG) AS STRING
     DIM sError AS STRING
    
     sError = NUL$(1023)
     IF MciGetErrorString(mciError, BYVAL STRPTR(sError), 1023) THEN
       sError = RTRIM$(sError, $NUL)
     ELSE
       sError = "Unknown MCI Error"
     END IF
     FUNCTION = sError & " 0x" & HEX$(mciError, 8) & " (" & FORMAT$(mciError) & ")"
    
    END FUNCTION
    '______________________________________________________________________________
    
    FUNCTION mciNotifyFlag$(Flag AS DWORD) AS STRING
    
     SELECT CASE FLAG
       CASE %MCI_NOTIFY_SUCCESSFUL : FUNCTION = "MCI_NOTIFY_SUCCESSFUL"  '1 The conditions initiating the callback function have been met.
       CASE %MCI_NOTIFY_SUPERSEDED : FUNCTION = "MCI_NOTIFY_SUPERSEDED"  '2 The device received another command with the "notify" flag set and the current conditions for initiating the callback function have been superseded.
       CASE %MCI_NOTIFY_FAILURE    : FUNCTION = "MCI_NOTIFY_FAILURE"     '8 A device error occurred while the device was executing the command.
       CASE %MCI_NOTIFY_ABORTED    : FUNCTION = "MCI_NOTIFY_ABORTED"     '4 The device received a command that prevented the current conditions for initiating the callback function from being met.
     END SELECT                                                          '  If a new command interrupts the current command and it also requests notification, the device sends this message only and not MCI_NOTIFY_SUPERSEDED
    
    END FUNCTION
    '______________________________________________________________________________
    
    FUNCTION mmIoProc(BYVAL pMMIOInfo AS MMIOINFO POINTER, BYVAL uMessage AS LONG, _
                      BYVAL lParam1 AS LONG, BYVAL lParam2 AS LONG) AS LONG
     STATIC alreadyOpened AS LONG
     STATIC pData         AS DWORD
     STATIC DataSize      AS DWORD
    
     SELECT CASE uMessage
    
       CASE %MMIOM_USER
         pData    = lParam1
         DataSize = lParam2
    
       CASE %MMIOM_OPEN
         IF alreadyOpened = 0 THEN
           alreadyOpened          = %TRUE
           @pMMIOInfo.lDiskOffset = 0
         END IF
    
       CASE %MMIOM_READ
         MemCpy(BYVAL lParam1, BYVAL pData + @pMMIOInfo.lDiskOffset, lParam2)
         @pMMIOInfo.lDiskOffset = @pMMIOInfo.lDiskOffset + lParam2
         FUNCTION = lParam2
    
       CASE %MMIOM_SEEK
         SELECT CASE lParam2
    
           CASE %SEEK_SET
             @pMMIOInfo.lDiskOffset = lParam1
    
           CASE %SEEK_CUR
             @pMMIOInfo.lDiskOffset = DataSize - 1
    
           CASE %SEEK_END
             @pMMIOInfo.lDiskOffset = DataSize - 1 - lParam1
    
         END SELECT
         FUNCTION = @pMMIOInfo.lDiskOffset
    
       CASE %MMIOM_CLOSE
         'Life goes on
    
       CASE ELSE
         FUNCTION = -1 'Some other messages. Say we don't proceed
    
     END SELECT
    
    END FUNCTION
    '______________________________________________________________________________
    
    CALLBACK FUNCTION DlgProc
     STATIC pMmioProc AS DWORD
     STATIC dwMey     AS DWORD
     STATIC pData     AS DWORD
     STATIC DataSize  AS DWORD
     LOCAL  dwRetVal  AS DWORD
     LOCAL  mciFlag   AS DWORD
     LOCAL  mciDevId  AS LONG
    
     SELECT CASE CBMSG
    
       CASE %WM_INITDIALOG
         dwMey     = MmioStringToFOURCC("MEY ", %MMIO_TOUPPER) 'dwMEY = 0x2059454D
         pMmioProc = mmioInstallIOProcExA(dwMey, BYVAL CODEPTR(mmIoProc), %MMIO_INSTALLPROC OR %MMIO_GLOBALPROC)
         IF pMmioProc = 0 THEN PostMessage(hDlg, %WM_APP, 0, 0)
    
         CONTROL ENABLE  hDlg, %ButtonPLay
         CONTROL DISABLE hDlg, %ButtonPause
         CONTROL DISABLE hDlg, %ButtonResume
         CONTROL DISABLE hDlg, %ButtonStop
    
       CASE %WM_APP
         CONTROL DISABLE  hDlg, %ButtonPLay
         MessageBox(hDlg, "mmioInstallIOProc error", "Error 01", %MB_OK OR %MB_TOPMOST)
    
       CASE %WM_COMMAND
         SELECT CASE CBCTL
    
           CASE %ButtonPlay
             IF (CBCTLMSG = %BN_CLICKED) OR (CBCTLMSG = 1) THEN
               IF pData = 0 THEN 'First time data read init
                 pData = ResourceRead("WavWav1", "WAVE")
                 IF pData = 0 THEN MSGBOX _
                 "A resource file with a waw is needed"           & $CRLF & _
                 "Something like: WavWav1 WAVE ""C:\MySong.wav""" & $CRLF & _
                 "See PowerBASIC help for resource...",, $AppName & " - Error 02" : EXIT FUNCTION
                 DataSize = PEEK(DWORD, pData - 4) 'Get string lenght
                 IF DataSize = 0 THEN MSGBOX "DataSize = 0",, $AppName & " - Error 03" : EXIT FUNCTION
                 mmIoProc(0, %MMIOM_USER, pData, DataSize) 'Tell ioProc where is data and size
               END IF
    
               dwRetVal = MciSendString("Close all", BYVAL 0, 0, 0) 'Close all opened MCI device for this app
               dwRetVal = MciSendString("open MyWav.MEY+ type waveaudio alias MyWav", "", %NULL, %NULL)
               IF dwRetVal THEN MSGBOX mciGetError$(dwRetVal),, $AppName & " - Error 04" : EXIT FUNCTION
               dwRetVal = MciSendString("Play MyWav notify", "", %NULL, hDlg) 'Returns zero if successful
    
               CONTROL DISABLE hDlg, %ButtonPLay
               CONTROL ENABLE  hDlg, %ButtonPause
               CONTROL DISABLE hDlg, %ButtonResume
               CONTROL ENABLE  hDlg, %ButtonStop
             END IF
    
           CASE %ButtonPause
             IF (CBCTLMSG = %BN_CLICKED) OR (CBCTLMSG = 1) THEN
               dwRetVal = MciSendString("Pause MyWav", "", %NULL, %NULL)
               CONTROL DISABLE hDlg, %ButtonPause
               CONTROL ENABLE  hDlg, %ButtonResume
             END IF
    
           CASE %ButtonResume
             IF (CBCTLMSG = %BN_CLICKED) OR (CBCTLMSG = 1) THEN
               dwRetVal = MciSendString("Resume MyWav", "", %NULL, %NULL)
               CONTROL ENABLE  hDlg, %ButtonPause
               CONTROL DISABLE hDlg, %ButtonResume
             END IF
    
           CASE %ButtonStop
             IF (CBCTLMSG = %BN_CLICKED) OR (CBCTLMSG = 1) THEN
               dwRetVal = MciSendString("Close MyWav", "", %NULL, %NULL)
               CONTROL ENABLE  hDlg, %ButtonPLay
               CONTROL DISABLE hDlg, %ButtonPause
               CONTROL DISABLE hDlg, %ButtonResume
               CONTROL DISABLE hDlg, %ButtonStop
             END IF
    
         END SELECT
    
       CASE %MM_MCINOTIFY
         mciFlag  = CBWPARAM
         mciDevId = CBLPARAM
         CONTROL SET TEXT hDLG, %LabelInfo, mciNotifyFlag$(mciFlag) & $CRLF & "DeviceId 0x" & HEX$(mciDevId)
    
         CONTROL ENABLE  hDlg, %ButtonPLay
         CONTROL DISABLE hDlg, %ButtonPause
         CONTROL DISABLE hDlg, %ButtonResume
         CONTROL DISABLE hDlg, %ButtonStop
    
       CASE %WM_DESTROY
         IF pMmioProc THEN
           MmioInstallIOProcA(BYVAL dwMey, %NULL, %MMIO_REMOVEPROC)
         END IF
    
     END SELECT
    
    END FUNCTION
    '______________________________________________________________________________
    
    FUNCTION PBMAIN()
     LOCAL hIcon AS DWORD
    
     DIALOG FONT "Segoe UI", 9
     DIALOG NEW %HWND_DESKTOP, $AppName, , , 120, 100, _
     %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
    
     hIcon = ExtractIcon(GetModuleHandle(""), "C:\Windows\system32\DXPTaskRingtone.dll", 0 )
     SetClassLong(hDlg, %GCL_HICON, hIcon)
     DestroyIcon(hIcon)
    
     CONTROL ADD BUTTON, hDlg, %ButtonPlay,   "Play",   30, 16, 60, 14
     CONTROL ADD BUTTON, hDlg, %ButtonPause,  "Pause",  30, 32, 60, 14
     CONTROL ADD BUTTON, hDlg, %ButtonResume, "Resume", 30, 48, 60, 14
     CONTROL ADD BUTTON, hDlg, %ButtonStop,   "Stop",   30, 64, 60, 14
     CONTROL ADD LABEL,  hDlg, %LabelInfo,    "mciSendString", 5, 80, 110, 18, _
     %SS_CENTER OR %SS_NOTIFY
    
     DIALOG SHOW MODAL hDlg CALL DlgProc
    
     DestroyIcon(hIcon)
    
    END FUNCTION
    '______________________________________________________________________________
    '
    Attached Files
    Last edited by Pierre Bellisle; 5 Oct 2016, 07:24 AM.
Working...
X