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

PBPiano custom control...

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

  • PBWin PBPiano custom control...

    Here's something silly I have been playing around with for a while. It's a virtual midi keyboard custom control. Screenshots show what it is. 3 codes follow, 1 simple demo, 1 more advanced demo showing all features and finally the actual custom control include file, PBPiano.inc. All this code plus compiled exes have also been attached in PBPiano.zip. Click image for larger version

Name:	PBPianoDemo.png
Views:	159
Size:	9.3 KB
ID:	749521


    Code:
    ' PBPianoDemo.bas - Public Domain by Borje Hagsten, June, 2016.
    ' A clean and simple basic demo of how easy PBPiano.inc makes it to
    ' build a fullblown midi piano with both mouse and keyboard control
    ' in PBWin. Up/down arrow keys controls pitch bend and Left/Right
    ' arrow keys changes base octave.
    ' See also PBPiano.bas, where all features are shown in use
    ' and PBPiano.inc, where features and messages are explained.
    
    '====================================================================
    ' Declares
    '--------------------------------------------------------------------
    #COMPILE EXE
    '------------------------------------------------
    #INCLUDE "WIN32API.INC"
    #INCLUDE "PBPiano.inc"
    '------------------------------------------------
    %IDC_PIANO     = 200  ' PBPiano custom control id
    
    
    '====================================================================
    ' Program entrance
    '--------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
      LOCAL hDlg, hPiano AS DWORD, w, h AS LONG
    
      DIALOG NEW PIXELS, 0, "PBPiano Demo",,, 1000, 200, _
                         %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
    
      '------------------------------------------------------------------
      hPiano = CreatePiano(hDlg, %IDC_PIANO, "", 10, 10, 1000, 200, _
                           %WS_CHILD OR %WS_TABSTOP OR %WS_VISIBLE, 0, 0)
    
      '------------------------------------------------------------------
      CONTROL SEND hDlg, %IDC_PIANO, %PM_SETKEYCOUNT, 48, 0 ' for 4 full octaves
      CONTROL SEND hDlg, %IDC_PIANO, %PM_SETOCTAVE, 3, 0    ' base octave 3
    
      CONTROL GET SIZE hDlg, %IDC_PIANO TO w, h  ' keycount may change piano control width
      DIALOG SET CLIENT hDlg, w + 20, h + 20     ' adjust dialog to piano control width
    
      '------------------------------------------------------------------
      DIALOG SHOW MODAL hDlg CALL DlgProc
    
    END FUNCTION
    
    
    '====================================================================
    ' Main Dialog procedure
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc() AS LONG
    
      SELECT CASE AS LONG CB.MSG
      CASE %WM_INITDIALOG
    
      CASE %WM_COMMAND
          SELECT CASE AS LONG CB.CTL
          CASE %IDCANCEL   ' Esc key triggers %IDCANCEL
             IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                DIALOG END CB.HNDL  ' End program
             END IF
          END SELECT
    
      END SELECT
    END FUNCTION
    And here's a more advanced PBPiano: Click image for larger version

Name:	PBPiano.png
Views:	55
Size:	22.6 KB
ID:	749522



    Code:
    ' PBPiano.bas - Public Domain by Borje Hagsten, June, 2016.
    ' A complete demo of how to use PBPiano.inc to build a virtual
    ' midi keyboard with both mouse and computer keyboard control.
    ' See also PBPianoDemo.bas, a basic example showing how easy it is
    ' to use and PBPiano.inc, where features and messages are explained.
    
    '====================================================================
    ' Declares
    '--------------------------------------------------------------------
    #COMPILE EXE
    #DIM ALL
    '------------------------------------------------
    #INCLUDE "WIN32API.INC"
    #INCLUDE "COMMCTRL.INC"
    #INCLUDE "PBPiano.inc"
    
    '--------------------------------------------------------------------
    %IDC_LABEL1    = 101  ' octave info
    %IDC_LABEL2    = 103  ' < "button"
    %IDC_LABEL3    = 104  ' > "button"
    %IDC_LABEL4    = 105  ' F1 - help text
    %IDC_FRAME1    = 111  ' Options
    %IDC_FRAME2    = 112  ' Patch/Instrument
    %IDC_FRAME3    = 113  ' Effects
    %IDC_FRAME4    = 114  ' Pitch bend
    %IDC_CHECKBOX1 = 133  ' Always on top
    %IDC_CHECKBOX2 = 131  ' Show Key text
    %IDC_CHECKBOX3 = 132  ' Show Note text
    %IDC_CHECKBOX4 = 134  ' Sustain
    %IDC_LISTBOX1  = 141  ' Instrument listbox
    %IDC_COMBOBOX1 = 151  ' Channels ComboBox
    %IDC_COMBOBOX2 = 152  ' Midi devices ComboBox
    %IDC_COMBOBOX3 = 153  ' Instrument categories ComboBox
    %IDC_KEYBOARD  = 160  ' Graphic control - piano keys
    %IDC_TRACKBAR1 = 181  ' Volume
    %IDC_TRACKBAR2 = 182  ' Balance
    %IDC_TRACKBAR3 = 183  ' Vibrato
    %IDC_TRACKBAR4 = 184  ' Pitch bend
    %IDC_PIANO     = 200  ' PBPiano custom control
    
    
    '====================================================================
    ' Program entrance
    '--------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
      LOCAL hDlg AS DWORD, hPiano AS DWORD
    
      DIALOG NEW 0, "PBPiano",,, 421, 235, %WS_CAPTION OR _
                 %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
    
      InitCommonControls
    
      '------------------------------------------------------------------
      hPiano = CreatePiano(hDlg, %IDC_PIANO, "", 7, 119, 414, 110, _
                           %WS_CHILD OR %WS_TABSTOP OR %WS_VISIBLE, 0, 1)
    
      '------------------------------------------------------------------
      CONTROL ADD FRAME, hDlg, %IDC_FRAME1, "Options", 5, 2, 130, 108
        CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX1, , 11, 13, 118, 60, _
                              %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
                              %WS_VSCROLL OR %CBS_DROPDOWNLIST
        CONTROL SET COLOR hDlg, %IDC_COMBOBOX1, GetSysColor(%COLOR_INFOTEXT), GetSysColor(%COLOR_INFOBK)
        CONTROL SEND hDlg, %IDC_PIANO, %PM_LISTDEVICES, %IDC_COMBOBOX1, 0
    
        CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX2, , 11, 32, 118, 150, _
                              %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
                              %WS_VSCROLL OR %CBS_DROPDOWNLIST
        CONTROL SET COLOR hDlg, %IDC_COMBOBOX2, GetSysColor(%COLOR_INFOTEXT), GetSysColor(%COLOR_INFOBK)
        CONTROL SEND hDlg, %IDC_PIANO, %PM_LISTCHANNELS, %IDC_COMBOBOX2, 0
    
        CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX1, "Always on top ",  11, 52, 65, 10
        CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX2, "Show Key text ",  11, 64, 65, 10
        CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX3, "Show Note text ", 11, 76, 65, 10
        CONTROL SET CHECK hDlg, %IDC_CHECKBOX2, 1
        CONTROL SET CHECK hDlg, %IDC_CHECKBOX3, 1
    
        CONTROL ADD LABEL, hDlg, %IDC_LABEL4, "Press F1 for help, Esc to Exit", _
                                              11, 98, 118, 10, %SS_CENTER
    
      '--------------------------------------------------------------------------
      CONTROL ADD FRAME, hDlg, %IDC_FRAME2, "Patches/Instrument", 143, 2, 107, 108
        CONTROL ADD COMBOBOX, hDlg, %IDC_COMBOBOX3, , 149, 12, 95, 150, _
                              %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _
                              %WS_VSCROLL OR %CBS_DROPDOWNLIST
        CONTROL SET COLOR hDlg, %IDC_COMBOBOX3, GetSysColor(%COLOR_INFOTEXT), GetSysColor(%COLOR_INFOBK)
        CONTROL SEND hDlg, %IDC_PIANO, %PM_LISTPATCHES, %IDC_COMBOBOX3, 0
        CONTROL SEND hDlg, %IDC_COMBOBOX3, %CB_SETCURSEL, 0, 0
    
        CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX1, , 149, 29, 95, 76, _
                  %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _
                  %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT, %WS_EX_CLIENTEDGE
        CONTROL SET COLOR hDlg, %IDC_LISTBOX1, GetSysColor(%COLOR_INFOTEXT), GetSysColor(%COLOR_INFOBK)
        CONTROL SEND hDlg, %IDC_PIANO, %PM_LISTINSTRUMENTS, %IDC_LISTBOX1, 0
        LISTBOX SELECT hDlg, %IDC_LISTBOX1, 1
    
      '--------------------------------------------------------------------------
      CONTROL ADD FRAME, hDlg, %IDC_FRAME3, "Effects",  258, 2, 104, 108
        CONTROL ADD LABEL, hDlg, -1, "", 265, 12, 90, 19,  %SS_SUNKEN
        CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Octave 4 and 5" + $CRLF + _
                                              "(< or > to change)", _
                                              277, 13, 65, 17, %SS_CENTER
        CONTROL SET COLOR hDlg, %IDC_LABEL1, GetSysColor(%COLOR_INFOTEXT), GetSysColor(%COLOR_INFOBK)
        CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "<", 266, 13, 12, 17, %SS_CENTER OR %SS_CENTERIMAGE OR _
                           %SS_NOTIFY, %WS_EX_DLGMODALFRAME OR %WS_EX_WINDOWEDGE
        CONTROL ADD LABEL, hDlg, %IDC_LABEL3, ">", 342, 13, 12, 17, %SS_CENTER OR %SS_CENTERIMAGE OR _
                           %SS_NOTIFY, %WS_EX_DLGMODALFRAME OR %WS_EX_WINDOWEDGE
    
        '--------------------------------------------------------------------------
        CONTROL ADD LABEL, hDlg, -1, "Volume:", 263, 37, 30, 10
        CONTROL ADD "msctls_trackbar32", hDlg, %IDC_TRACKBAR1, "", _
                    295, 35, 64, 20, %WS_CHILD OR %WS_VISIBLE OR _
                    %TBS_HORZ OR %TBS_AUTOTICKS OR %TBS_TOOLTIPS
        CONTROL SEND hdlg, %IDC_TRACKBAR1, %TBM_SETRANGE , %TRUE, MAK(LONG, 0, 10)
        CONTROL SEND hDlg, %IDC_TRACKBAR1, %TBM_SETTICFREQ, 1, 1  ' interval frequency
        CONTROL SEND hDlg, %IDC_TRACKBAR1, %TBM_SETPOS, %TRUE, 10 ' position
        '--------------------------------------------------------------------------
        CONTROL ADD LABEL, hDlg, -1, "Balance:", 263, 57, 30, 10
        CONTROL ADD "msctls_trackbar32", hDlg, %IDC_TRACKBAR2, "", _
                    295, 55, 64, 20, %WS_CHILD OR %WS_VISIBLE OR _
                    %TBS_HORZ OR %TBS_AUTOTICKS OR %TBS_TOOLTIPS
        CONTROL SEND hdlg, %IDC_TRACKBAR2, %TBM_SETRANGE , %TRUE, MAK(LONG, -10, 10)
        CONTROL SEND hDlg, %IDC_TRACKBAR2, %TBM_SETTICFREQ, 5, 1  '
        CONTROL SEND hDlg, %IDC_TRACKBAR2, %TBM_SETPOS, %TRUE, 0  ' balance center
        '--------------------------------------------------------------------------
        CONTROL ADD LABEL, hDlg, -1, "Vibrato:", 263, 77, 30, 10
        CONTROL ADD "msctls_trackbar32", hDlg, %IDC_TRACKBAR3, "", _
                    295, 75, 64, 20, %WS_CHILD OR %WS_VISIBLE OR _
                    %TBS_HORZ OR %TBS_AUTOTICKS OR %TBS_TOOLTIPS
        CONTROL SEND hdlg, %IDC_TRACKBAR3, %TBM_SETRANGE , %TRUE, MAK(LONG, 0, 10)
        CONTROL SEND hDlg, %IDC_TRACKBAR3, %TBM_SETTICFREQ, 1, 1  ' interval frequency
        CONTROL SEND hDlg, %IDC_TRACKBAR3, %TBM_SETPOS, %TRUE, 0  ' position
        '--------------------------------------------------------------------------
        CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX4, "Sustain ",  264, 96, 40, 10
    
      '--------------------------------------------------------------------------
      CONTROL ADD FRAME, hDlg, %IDC_FRAME4, "Pitch bend",  370, 2, 45, 108
        CONTROL ADD "msctls_trackbar32", hDlg, %IDC_TRACKBAR4, "", _
                    379, 12, 30, 94, %WS_CHILD OR %WS_VISIBLE OR _
                    %TBS_VERT OR %TBS_BOTH OR %TBS_AUTOTICKS
        CONTROL SEND hdlg, %IDC_TRACKBAR4, %TBM_SETRANGE , %TRUE, MAK(LONG, -64, 64)
        CONTROL SEND hDlg, %IDC_TRACKBAR4, %TBM_SETTICFREQ, 10, 1  ' interval frequency
    
      '------------------------------------------------------------------
      DIALOG SHOW MODAL hDlg CALL DlgProc
    
    END FUNCTION
    
    
    '====================================================================
    ' Main Dialog procedure
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc() AS LONG
      LOCAL c, d AS LONG, sText AS STRING
    
      SELECT CASE CB.MSG
      CASE %WM_INITDIALOG
          CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETOCTAVE, 0, 0 TO c
          CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETKEYCOUNT, 0, 0 TO d
          CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, "Octave" + STR$(c) + _
                           " to" + STR$(c + d \ 12 - 1) + $CRLF + "(< or > to change)"
    
      CASE %WM_COMMAND
          SELECT CASE CB.CTL
          CASE %IDC_LABEL2  ' Arrow left < - octave change down
              IF CB.CTLMSG = %STN_CLICKED OR %STN_DBLCLK THEN
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETOCTAVE, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETKEYCOUNT, 0, 0 TO d
                  c = MAX&(0, c - 1)
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETOCTAVE, c, 1
                  CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, "Octave" + STR$(c) + _
                                   " to" + STR$(c + d \ 12 - 1) + $CRLF + "(< or > to change)"
              END IF
    
          CASE %IDC_LABEL3  ' Arrow left < - octave change down
              IF CB.CTLMSG = %STN_CLICKED OR %STN_DBLCLK THEN
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETOCTAVE, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETKEYCOUNT, 0, 0 TO d
                  c = MIN&(11 - d \ 12, c + 1)
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETOCTAVE, c, 1
                  CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, "Octave" + STR$(c) + _
                                   " to" + STR$(c + d \ 12 - 1) + $CRLF + "(< or > to change)"
              END IF
    
          CASE %IDC_CHECKBOX1  ' Topmost or not on screen
              IF CB.CTLMSG = %BN_CLICKED THEN
                  CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX1 TO c
                  IF c THEN c = %HWND_TOPMOST ELSE c = %HWND_NOTOPMOST
                  SetWindowPos CB.HNDL, c, 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
                  CONTROL SET FOCUS CB.HNDL, %IDC_PIANO
              END IF
    
          CASE %IDC_CHECKBOX2 ' Show key text?
              IF CB.CTLMSG = %BN_CLICKED THEN
                  CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX2 TO c   ' key text
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETKEYTEXT, c, 1
              END IF
    
          CASE %IDC_CHECKBOX3  ' Show note text?
              IF CB.CTLMSG = %BN_CLICKED THEN
                  CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX3 TO c  ' note text
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETNOTETEXT, c, 1
              END IF
    
          CASE %IDC_CHECKBOX4  ' Sustain on/off
              IF CB.CTLMSG = %BN_CLICKED THEN
                  CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX4 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETSUSTAIN, c, 1
              END IF
    
          CASE %IDC_COMBOBOX1  ' device
              IF CB.CTLMSG = %CBN_SELCHANGE THEN
                  CONTROL SEND CB.HNDL, %IDC_COMBOBOX1, %CB_GETCURSEL, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETDEVICE, c, 0
    
              ELSEIF CB.CTLMSG = %CBN_CLOSEUP THEN
                  CONTROL SET FOCUS CB.HNDL, %IDC_PIANO
              END IF
    
          CASE %IDC_COMBOBOX2  ' Channel
              IF CB.CTLMSG = %CBN_SELCHANGE THEN
                  CONTROL SEND CB.HNDL, %IDC_COMBOBOX2, %CB_GETCURSEL, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETCHANNEL, c, 0
    
              ELSEIF CB.CTLMSG = %CBN_CLOSEUP THEN
                  CONTROL SET FOCUS CB.HNDL, %IDC_PIANO
              END IF
    
          CASE %IDC_COMBOBOX3  ' Patches
              IF CB.CTLMSG = %CBN_SELCHANGE THEN
                  CONTROL SEND CB.HNDL, %IDC_COMBOBOX3, %CB_GETCURSEL, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_LISTINSTRUMENTS, %IDC_LISTBOX1, c
                  LISTBOX SELECT CB.HNDL, %IDC_LISTBOX1, 1
                  CONTROL SEND CB.HNDL, %IDC_LISTBOX1, %LB_GETITEMDATA, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETINSTRUMENT, c, 1
    
              ELSEIF CB.CTLMSG = %CBN_CLOSEUP THEN
                  CONTROL SET FOCUS CB.HNDL, %IDC_PIANO
              END IF
    
          CASE %IDC_LISTBOX1  ' Instruments
             IF CB.CTLMSG = %LBN_SELCHANGE THEN
                 CONTROL SEND CB.HNDL, %IDC_LISTBOX1, %LB_GETCURSEL, 0, 0 TO c
                 CONTROL SEND CB.HNDL, %IDC_LISTBOX1, %LB_GETITEMDATA, c, 0 TO c
                 CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETINSTRUMENT, c, 1
             END IF
    
          CASE %IDC_PIANO  ' Piano custom control notifications
              SELECT CASE CB.CTLMSG
              CASE %PN_PLAYNOTE   ' when a note is played, notification is sent here
    
              CASE %PN_STOPNOTE   ' when a note is stopped, notification is sent here
    
              CASE %PN_PITCHBEND  ' on up/down arrow key, pitch bend notification is sent here
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR4, %TBM_SETPOS, %TRUE, CB.LPARAM
    
              CASE %PN_OCTAVE     ' on left/right arrow key, octave change notification is sent here
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_GETKEYCOUNT, 0, 0 TO d
                  CONTROL SET TEXT CB.HNDL, %IDC_LABEL1, "Octave" + STR$(CB.LPARAM) + _
                                   " to" + STR$(CB.LPARAM + d \ 12 - 1) + $CRLF + "(< or > to change)"
              END SELECT
    
          CASE %IDCANCEL  ' Esc key triggers %IDCANCEL..
              IF CB.CTLMSG = %BN_CLICKED THEN
                  DIALOG END CB.HNDL
              END IF
    
          END SELECT
    
      CASE %WM_CTLCOLORSTATIC  ' Simple stunt to avoid focus rect flashing in TrackBars
          SELECT CASE GetDlgCtrlID(CB.LPARAM)
          CASE %IDC_TRACKBAR4 TO %IDC_TRACKBAR4
              CONTROL SET FOCUS CB.HNDL, %IDC_PIANO
          END SELECT
    
      CASE %WM_HELP
          sText = "PBPiano accepts both computer keyboard and/or mouse play." + $CRLF + $CRLF + _
                  " Options:" + $CRLF + _
                  "   ComboBox 1 shows available midi devices (usually 1)."  + $CRLF + _
                  "   ComboBox 2 shows a collection of 16 midi channels,"    + $CRLF + _
                  "   but we usually only use channel 1 for normal play."    + $CRLF + _
                  "   Note: Channel 10 is reserved for percussion sets,"     + $CRLF + _
                  "   turning each key from D2# to D7# into an instrument."  + $CRLF + $CRLF + _
                  "   Always on top - program stays topmost on screen."  + $CRLF + _
                  "   Show Key text - show/hide computer keyboard key text."  + $CRLF + _
                  "   Show Note text - show/hide piano key notes."  + $CRLF + $CRLF + _
                  " Effects:" + $CRLF + _
                  "   Arrow left - decrease octave"  + $CRLF + _
                  "   Arrow right - increase octave" + $CRLF + _
                  "   Arrow up - pitch bend up"      + $CRLF + _
                  "   Arrow down - pitch bend down"  + $CRLF + $CRLF + _
                  "   Sustain on/off, for sustain (reverb) on played keys."      + $CRLF + _
                  "   Sustain can cause eternal notes to for example string and" + $CRLF + _
                  "   brass instruments and should therefore be used with care." + $CRLF + _
                  "   If eternal notes occur, just uncheck this checkbox."       + $CRLF + _
                  "   On octave change, pressed notes are repeated for a"        + $CRLF + _
                  "   nice replay effect." + $CRLF + _
                  "   Mouse controls Volume, Balance, Vibrato and Pitch bend."
          MessageBox (CB.HNDL, BYVAL STRPTR(sText), "Information", _
                      %MB_OK OR %MB_ICONINFORMATION)
    
      CASE %WM_HSCROLL ' Horizontal trackbar scrollpos change
          IF CB.LPARAM = GetDlgItem(CB.HNDL, %IDC_TRACKBAR1) THEN  ' Volume
              IF LO(WORD, CB.WPARAM) = %TB_THUMBTRACK THEN         ' get trackbar pos
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR1, %TBM_GETPOS, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETVOLUME, MIN&(127, c * 13), 1
              END IF
    
          ELSEIF CBLPARAM = GetDlgItem(CB.HNDL, %IDC_TRACKBAR2) THEN ' Balance
              IF LO(WORD, CB.WPARAM) = %TB_THUMBTRACK THEN           ' get trackbar pos
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR2, %TBM_GETPOS, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETBALANCE, MIN&(127, c * 6.4 + 64), 1
              END IF
    
          ELSEIF CBLPARAM = GetDlgItem(CB.HNDL, %IDC_TRACKBAR3) THEN ' Modulation (Vibrato)
              IF LO(WORD, CB.WPARAM) = %TB_THUMBTRACK THEN           ' get trackbar pos
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR3, %TBM_GETPOS, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETVIBRATO, MIN&(127, c * 13), 1
              END IF
          END IF
    
      CASE %WM_VSCROLL 'Pitch bend - Vertical trackbar scrollpos change
          IF CB.LPARAM = GetDlgItem(CB.HNDL, %IDC_TRACKBAR4) THEN ' Pitch Bend
              SELECT CASE LO(WORD, CB.WPARAM)
              CASE %TB_THUMBTRACK ' get trackbar pos and set pitch
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR4, %TBM_GETPOS, 0, 0 TO c
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETPITCH, 64 - c, 1
    
              CASE %TB_ENDTRACK   ' reset trackbar (middle) pos and pitch
                  CONTROL SEND CB.HNDL, %IDC_TRACKBAR4, %TBM_SETPOS, %TRUE, 0
                  CONTROL SEND CB.HNDL, %IDC_PIANO, %PM_SETPITCH, 64, 1
              END SELECT
          END IF
    
      END SELECT
    
    END FUNCTION
    And finally the actual custom control include file code:

    Code:
    ' PBPiano.inc - Public Domain by Borje Hagsten, June, 2016.
    ' Compiles with both PBWIN 9 and 10. See PBPiano.bas and
    ' PBPianoDemo.bas for examples of how to use this custom control
    ' include file.
    '
    ' To begin with, computer keyboards are lousy midi keyboards. Some
    ' key combinations when playing chords simply don't work, probably
    ' because of bit mask conflicts. But it's fun to learn new stuff
    ' and investigate, which is why I did this one. Pitch bending and
    ' vibrato were the hardest part to do, because I could not find any
    ' examples or good info how to do them by code, so had to experiment
    ' and finally found a way. Should be easy enough to understand how
    ' to use all features and learn limitations. Both mouse and keyboard
    ' can be used to play at same time.
    '
    ' As always, code is free to use and abuse any way you want. Could
    ' serve as base for a note learning game or a sequenser, build own
    ' custom signals or just use it as it is, for fun.
    
    
    '====================================================================
    ' PBPiano.inc, PB Midi Piano custom control.
    '--------------------------------------------------------------------
    #IF NOT %DEF(%WINAPI)
      #INCLUDE "WIN32API.INC"
    #ENDIF
    
    '--------------------------------------------------------------------
    '  How to include and call in parent:
    ' in declares:
    '     #INCLUDE "PBPiano.inc"
    
    ' in code:
    '  hPiano = CreatePiano(hDlg, %IDC_PIANO, "", x, y, w, h, _
    '                       %WS_CHILD OR %WS_TABSTOP OR %WS_VISIBLE, 0, 1)
    '
    '--------------------------------------------------------------------
    ' Messages for use with SendMessage or CONTROL SEND..
    '--------------------------------------------------------------------
    %PM_SETDEVICE       = %WM_APP + 100  ' wParam sets midi device
    %PM_SETCHANNEL      = %WM_APP + 101  ' wParam sets channel
    %PM_PLAYNOTE        = %WM_APP + 105  ' wParam sets note to play (0 to 127), lParam sets sound volume (0 to 127)
    %PM_STOPNOTE        = %WM_APP + 106  ' wParam determines which note to stop playing (0 to 127)
    
    %PM_LISTDEVICES     = %WM_APP + 110  ' List midi devices. wParam is list id
    %PM_LISTCHANNELS    = %WM_APP + 111  ' List 16 midi channels. wParam list id
    %PM_LISTPATCHES     = %WM_APP + 112  ' List patches. wParam is list id
    %PM_LISTINSTRUMENTS = %WM_APP + 113  ' List instrument. wParam is list id
    
    ' For the following %PM_SET.. messages, lParam (1/0) sets control focus
    %PM_SETINSTRUMENT   = %WM_APP + 120  ' wParam sets instrument (0-127)
    %PM_SETOCTAVE       = %WM_APP + 121  ' wParam sets octave (0-10)
    %PM_SETKEYCOUNT     = %WM_APP + 122  ' wParam sets total number of keys (1 to 128)
    %PM_SETPITCH        = %WM_APP + 123  ' wParam sets pitch bend (-64 to 64, where 0 is normal pitch)
    %PM_SETVOLUME       = %WM_APP + 124  ' wParam sets sound volume (0 to 127)
    %PM_SETBALANCE      = %WM_APP + 125  ' wParam sets sound balance (-64 to 64, where 0 is centered)
    %PM_SETVIBRATO      = %WM_APP + 126  ' wParam sets vibrato/modulation (0 to 127)
    %PM_SETSUSTAIN      = %WM_APP + 127  ' wParam sets sustain off/on (0/127)
    %PM_SETKEYTEXT      = %WM_APP + 130  ' wParam 0/1, if to print computer key letters
    %PM_SETNOTETEXT     = %WM_APP + 131  ' wParam 0/1, if to print note desciptions
    
    %PM_GETOCTAVE       = %WM_APP + 221  ' get base octave
    %PM_GETKEYCOUNT     = %WM_APP + 222  ' get number of keys (1 to 128)
    
    %PN_PLAYNOTE        = %WM_APP + 300  ' note played notification
    %PN_STOPNOTE        = %WM_APP + 301  ' note stopped notification
    %PN_OCTAVE          = %WM_APP + 310  ' octave change notification
    %PN_PITCHBEND       = %WM_APP + 320  ' pitch bend notification
    
    '--------------------------------------------------------------------
    TYPE kbData            ' Program data
      hParent    AS DWORD  ' Parent dialog handle
      CtlId      AS DWORD  ' Piano control id
      hFont      AS DWORD  ' font handle
      hMidi      AS DWORD  ' midi device
      memDC      AS DWORD  ' memory device context
      hBitmap    AS DWORD  '
      hBitOld    AS DWORD  '
      KeyCount   AS DWORD  ' Number of keys to draw
      instrument AS LONG   ' selected instrument (0 - 127)
      chPlay     AS LONG   ' channel &H90 to &H9F, where ch &H99 = percussion
      chStop     AS LONG   ' channel &H80 to &H8F, where ch &H89 = percussion
      chControl  AS LONG   ' channel &HB0 to &HBF, Control mode change
      chInstr    AS LONG   ' channel &HC0 to &HCF, Program (instrument) change
      chBend     AS LONG   ' channel &HE0 to &HEF, Pitch bend
      KeyText    AS LONG   ' Key description on keys on/off
      NoteText   AS LONG   ' Note description on keys on/off
      note       AS LONG   ' note to play (0 - 127)
      octave     AS LONG   ' base octave (1 octave = 12 notes)
      sustain    AS LONG   ' sustain on/off
      volume     AS LONG   ' sound volume
      balance    AS LONG   ' sound balance Left/Right
      vibrato    AS LONG   ' Modulation/Vibrato
    END TYPE
    
    TYPE pKey              ' Key array data
      nt  AS LONG          ' note (0 - 127)
      dn  AS LONG          ' key up/down flag, 0/1
      rc  AS RECT          ' key coordinates
    END TYPE
    
    $KEY1 = "ZSXDCVGBHNJMQ2W3ER5T6Y7UI9O0P"  ' 29 computer key note layout
    
    '====================================================================
    ' Initialize and create the control in one and same call
    '--------------------------------------------------------------------
    FUNCTION CreatePiano(BYVAL hParent AS DWORD, BYVAL CtrlId AS LONG, _
                         BYVAL sTxt AS STRING, _
                         BYVAL cLeft AS LONG,  BYVAL cTop AS LONG, _
                         BYVAL cWidth AS LONG, BYVAL cHeight AS LONG, _
                         BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG, _
                         BYVAL isDDT AS LONG) AS DWORD
    '--------------------------------------------------------------------
      LOCAL hCtrl AS DWORD, wc AS WNDCLASSEX, szName AS ASCIIZ * 20
    
      szName = "PBPianoCtrl"
    
      wc.cbSize        = LEN(wc)
      wc.Style         = %CS_DBLCLKS
      wc.lpfnWndProc   = CODEPTR(PBPianoProc)
      wc.cbClsExtra    = 0
      wc.cbWndExtra    = 4  ' 4 extra bytes
      wc.hInstance     = GetWindowLong(hParent, %GWL_HINSTANCE)
      wc.hIcon         = 0
      wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_HAND)
      wc.hbrBackground = %NULL
      wc.lpszMenuName  = %NULL
      wc.lpszClassName = VARPTR(szName)
      wc.hIconSm       = 0
    
      RegisterClassEx wc
    
    '--------------------------------------------------------------------
      IF isDDT THEN ' create control using DDT dialog way
         CONTROL ADD szName, hParent, CtrlId, sTxt, _
                     cLeft, cTop, cWidth, cHeight, wStyle, wStyleEx
         CONTROL HANDLE hParent, CtrlId TO hCtrl
    
      ELSE          ' create control using SDK/API way
         hCtrl = CreateWindowEx(wStyleEx, szName, BYVAL STRPTR(sTxt), wStyle, _
                                cLeft, cTop, cWidth, cHeight, _
                                hParent, CtrlId, wc.hInstance, BYVAL 0)
      END IF
    '--------------------------------------------------------------------
    
      FUNCTION = hCtrl
    END FUNCTION
    
    
    '====================================================================
    ' Piano Control Procedure
    '--------------------------------------------------------------------
    FUNCTION PBPianoProc (BYVAL hWnd AS DWORD,   BYVAL wMsg AS DWORD, _
                          BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
    
      LOCAL ps AS PAINTSTRUCT, pt AS POINTAPI, rc AS RECT
      LOCAL c, d AS LONG, hDC AS DWORD
    
      STATIC chPitch, CurKey, OldKey AS LONG
      DIM hRgn(127) AS STATIC DWORD ' static key region array
      DIM pk(127) AS STATIC pKey    ' static key data array
      STATIC kbd AS kbData          ' static keyboard data
    
      SELECT CASE wMsg
      CASE %WM_CREATE
          IF midiOutOpen(kbd.hMidi, -1, 0, 0, 0) <> %MMSYSERR_NOERROR THEN
              MessageBox (GetParent(hWnd), "midiOutOpen failed!", "Error message!", _
                          %MB_OK OR %MB_ICONERROR)
              EXIT FUNCTION
          END IF
    
          initKbd(hWnd, kbd)
          DrawKeyBoard(hWnd, kbd, pk(), hRgn())
          '--------------------------------------------------------------
          chPitch = 64        ' pitch bend start value (64 is no bend)
          CurKey  = -1
    
      CASE %WM_DESTROY       ' exit, time to clean up memory, etc
          IF kbd.hMidi  THEN midiOutClose(kbd.hMidi) ' Close the midi device
          IF kbd.memDC THEN  ' restore and delete what we have created
              IF kbd.hBitOld THEN SelectObject kbd.memDC, kbd.hBitOld
              IF kbd.hBitmap THEN DeleteObject kbd.hBitmap
              DeleteDC kbd.memDC
          END IF
          IF kbd.hFont THEN DeleteObject kbd.hFont
          FOR c = LBOUND(hRgn) TO UBOUND(hRgn)
              IF hRgn(c) THEN DeleteObject(hRgn(c))
          NEXT
          EXIT FUNCTION
    
      CASE %WM_GETDLGCODE ' Ensure the control processes all keys by itself
          FUNCTION = %DLGC_WANTALLKEYS
          EXIT FUNCTION
    
      CASE %WM_PAINT  ' on repaint, simply copy kbd.memDC to control DC
          BeginPaint hWnd, ps
            GetClientRect hWnd, rc
            BitBlt ps.hDC, 0, 0, rc.nRight, rc.nBottom, kbd.memDC, 0, 0, %SRCCOPY
          EndPaint hWnd, ps
          EXIT FUNCTION
    
      CASE %WM_KEYDOWN
          SELECT CASE AS LONG wParam
          CASE %VK_ESCAPE ' enable Exit on Esc key
               SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, %IDCANCEL, %BN_CLICKED), 0)
    
          CASE %VK_UP  ' Arrow up ^  - Pitch bend up
              IF chPitch = 64 THEN  ' send notification on each change to parent's/control id's %WM_COMMAND
                  FOR chPitch = 64 TO 128
                      Midi_PitchBend(kbd.hMidi, kbd.chBend, chPitch)
                      SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PITCHBEND), -(chPitch - 64))
                      IF (GetAsyncKeyState(%VK_UP) AND &H8000) = 0 THEN EXIT FOR ' if key is released
                      SLEEP 8
                  NEXT
              END IF
    
          CASE %VK_DOWN  ' Arrow down v  - Pitch bend down
              IF chPitch = 64 THEN
                  FOR chPitch = 64 TO 0 STEP -1
                      Midi_PitchBend(kbd.hMidi, kbd.chBend, chPitch)
                      SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PITCHBEND), -(chPitch - 64))
                      IF (GetAsyncKeyState(%VK_DOWN) AND &H8000) = 0 THEN EXIT FOR
                      SLEEP 8
                  NEXT
              END IF
    
          CASE %VK_LEFT  ' Arrow left < - octave change down
              kbd.octave = MAX&(0, kbd.octave - 1)
              SendMessage(hWnd, %PM_SETOCTAVE, kbd.octave, 1)
              SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_OCTAVE), kbd.octave)
    
          CASE %VK_RIGHT  ' Arrow right > - octave change up
              kbd.octave = MIN&(10 - kbd.KeyCount \ 12, kbd.octave + 1)
              SendMessage(hWnd, %PM_SETOCTAVE, kbd.octave, 1)
              SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_OCTAVE), kbd.octave)
    
          CASE %VK_0 TO %VK_Z                 ' See if a note key has been pressed
              c = INSTR($KEY1, CHR$(wParam))  ' $KEY1 is used for pk array compare
              IF c THEN
                  DECR c
                  IF pk(c).dn = 0 THEN        ' if not pressed before
                      kbd.note = kbd.octave * 12 + pk(c).nt   ' actual note
                      pk(c).dn = 2                            ' 2 = keyboard key pressed it
                      SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PLAYNOTE), kbd.note)
                      Midi_PlayNote(kbd.hMidi, kbd.chPlay, kbd.note, kbd.volume)
    
                      SELECT CASE c MOD 12
                      CASE 1, 3, 6, 8, 10  ' black keys
                          PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %YELLOW, %BLACK), %BLACK)
                      CASE ELSE    ' white keys
                          PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %BLUE, %WHITE), %WHITE)
                      END SELECT
                      InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
                  END IF
              END IF
          END SELECT
          EXIT FUNCTION
    
      CASE %WM_KEYUP
          SELECT CASE AS LONG wParam
          CASE %VK_UP    ' Arrow up - Pitch has been bended up
              IF chPitch > 64 THEN
                  chPitch = 64
                  Midi_PitchBend(kbd.hMidi, kbd.chBend, chPitch)
                  SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PITCHBEND), 0)
              END IF
    
          CASE %VK_DOWN  ' Arrow down - Pitch has been bended down
              IF chPitch < 64 THEN
                  chPitch = 64
                  Midi_PitchBend(kbd.hMidi, kbd.chBend, chPitch)
                  SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PITCHBEND), 0)
              END IF
    
          CASE %VK_0 TO %VK_Z  ' same as on key down, but here we stop playing note and reset key text instead.
              c = INSTR($KEY1, CHR$(wParam))  ' see if it's a defined key
              IF c THEN
                  DECR c
                  IF pk(c).dn = 2 THEN            ' if it was pressed by a keyboard key
                      SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_STOPNOTE), kbd.note)
                      Midi_StopNote(kbd.hMidi, kbd.chStop, kbd.octave * 12 + pk(c).nt)
                      pk(c).dn = 0
    
                      SELECT CASE c MOD 12 ' reset key text
                      CASE 1, 3, 6, 8, 10  ' black keys
                          PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %LTGRAY, %BLACK), %BLACK)
                      CASE ELSE : INCR d   ' white keys
                          PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
                      END SELECT
                      InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
                      EXIT FUNCTION
                  END IF
              END IF
          END SELECT
    
    
      CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK
          SetCapture(hWnd)
          pt.x = LO(WORD, lParam)
          pt.y = HI(WORD, lParam)
          FOR c = LBOUND(hRgn) TO UBOUND(hRgn)
              IF  c <> CurKey AND PtInRegion(hRgn(c), pt.x, pt.y) THEN
                  pk(c).dn = 1 ' 1 = mouse key pressed it
                  CurKey   = c
                  kbd.note = kbd.octave * 12 + CurKey
                  SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_PLAYNOTE), kbd.note)
                  Midi_PlayNote(kbd.hMidi, kbd.chPlay, kbd.note, kbd.volume)
                  OldKey = CurKey
    
                  SELECT CASE CurKey MOD 12
                  CASE 1, 3, 6, 8, 10  ' black keys
                      PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %YELLOW, %BLACK), %BLACK)
                  CASE ELSE : INCR d   ' white keys
                      PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %RED, %WHITE), %WHITE)
                  END SELECT
                  InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
                  EXIT FOR
              END IF
          NEXT
    
      CASE %WM_MOUSEMOVE
          IF (GetAsyncKeyState(%VK_LBUTTON) AND &H8000) THEN
              IF GetCapture() <> hWnd THEN SetCapture(hWnd)  ' ensure mouse capture
    
              pt.x = LO(WORD, lParam)
              pt.y = HI(WORD, lParam)
              FOR c = LBOUND(hRgn) TO UBOUND(hRgn)
                  IF PtInRegion(hRgn(c), pt.x, pt.y) AND c <> CurKey THEN
                      CurKey = c
                      EXIT FOR
                  END IF
              NEXT
              IF CurKey <> OldKey THEN
                  pk(OldKey).dn = 0 ' 1 = mouse key pressed it
                  kbd.note = kbd.octave * 12 + OldKey
                  Midi_StopNote(kbd.hMidi, kbd.chStop, kbd.note) ' stop playing this note
                  SELECT CASE OldKey MOD 12 ' reset key text
                  CASE 1, 3, 6, 8, 10  ' black keys
                      PrintKeyText(kbd, pk(OldKey), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %LTGRAY, %BLACK), %BLACK)
                  CASE ELSE : INCR d   ' white keys
                      PrintKeyText(kbd, pk(OldKey), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
                  END SELECT
    
                  pk(CurKey).dn = 1 ' 1 = mouse key pressed it
                  kbd.note = kbd.octave * 12 + CurKey
                  Midi_PlayNote(kbd.hMidi, kbd.chPlay, kbd.note, kbd.volume)
                  SELECT CASE CurKey MOD 12
                  CASE 1, 3, 6, 8, 10  ' black keys
                      PrintKeyText(kbd, pk(CurKey), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %YELLOW, %BLACK), %BLACK)
                  CASE ELSE : INCR d   ' white keys
                      PrintKeyText(kbd, pk(CurKey), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %RED, %WHITE), %WHITE)
                  END SELECT
                  InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
    
                  OldKey = CurKey
              END IF
          END IF
    
      CASE %WM_LBUTTONUP
          pk(CurKey).dn = 0
          kbd.note = kbd.octave * 12 + CurKey
          SendMessage(kbd.hParent, %WM_COMMAND, MAK(DWORD, kbd.CtlId, %PN_STOPNOTE), kbd.note)
          Midi_StopNote(kbd.hMidi, kbd.chStop, kbd.note) ' and stop playing this note
    
          SELECT CASE CurKey MOD 12 ' reset key text
          CASE 1, 3, 6, 8, 10  ' black keys
              PrintKeyText(kbd, pk(CurKey), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %LTGRAY, %BLACK), %BLACK)
          CASE ELSE : INCR d   ' white keys
              PrintKeyText(kbd, pk(CurKey), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
          END SELECT
    
          InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
          CurKey = -1
          OldKey = -1
          ReleaseCapture()
    
      '------------------------------------------------------------------
      ' a bunch of useful %PM_ Piano Messages
      '------------------------------------------------------------------
      CASE %PM_SETDEVICE
          ' can't test this one, because like most, I only have one midi device. Hope it works..
          IF kbd.hMidi THEN midiOutClose(kbd.hMidi) ' Close current midi device
          IF midiOutOpen(kbd.hMidi, wParam, 0, 0, 0) <> %MMSYSERR_NOERROR THEN
              MSGBOX "midiOutOpen failed - trying default device instead!", _
                     %MB_ICONERROR, "Error message!"
              midiOutOpen(kbd.hMidi, -1, 0, 0, 0)
          END IF
          Midi_SetInstrument(kbd.hMidi, kbd.chInstr, kbd.instrument)  ' reset selected instrument
          Midi_SetVolume(kbd.hMidi, kbd.chControl, kbd.volume)        ' reset volume
          Midi_SetBalance(kbd.hMidi, kbd.chControl, kbd.balance)      ' reset balance
          Midi_SetSustain(kbd.hMidi, kbd.chControl, kbd.sustain)      ' reset sustain
          SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETCHANNEL
          Midi_StopAllNotes(kbd.hMidi, kbd.chControl)  ' stop all notes
          Midi_SetSustain(kbd.hMidi, kbd.chControl, 0) ' reset sustain
    
          kbd.chControl = &HB0 + wParam
          kbd.chInstr   = &HC0 + wParam
          kbd.chStop    = &H80 + wParam
          kbd.chPlay    = &H90 + wParam
          kbd.chBend    = &HE0 + wParam
    
          Midi_SetInstrument(kbd.hMidi, kbd.chInstr, kbd.instrument)  ' reset selected instrument
          Midi_SetVolume(kbd.hMidi, kbd.chControl, kbd.volume)        ' reset volume
          Midi_SetBalance(kbd.hMidi, kbd.chControl, kbd.balance)      ' reset balance
          Midi_SetSustain(kbd.hMidi, kbd.chControl, kbd.sustain)      ' reset sustain
          SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_LISTDEVICES     ' wParam is list id
          Midi_ListDevices(kbd.hParent, wParam)
          EXIT FUNCTION
    
      CASE %PM_LISTCHANNELS    ' wParam is list id
          Midi_ListChannels(kbd.hParent, wParam)
    
      CASE %PM_LISTPATCHES     ' wParam is list id
          Midi_ListPatches(kbd.hParent, wParam)
          EXIT FUNCTION
    
      CASE %PM_LISTINSTRUMENTS ' wParam is list id, lParam is patches number
          Midi_ListInstruments(kbd.hParent, wParam, lParam)
          EXIT FUNCTION
    
      CASE %PM_GETOCTAVE  'returns currently selected base octave
          FUNCTION = kbd.octave
          EXIT FUNCTION
    
      CASE %PM_SETOCTAVE  ' sets 0 to 9 octaves
          Midi_StopAllNotes(kbd.hMidi, kbd.chControl)   ' stop all notes
          kbd.octave = wParam
          FOR c = LBOUND(pk) TO UBOUND(pk)
              IF pk(c).dn THEN
                  kbd.note = kbd.octave * 12 + pk(c).nt ' refresh note
                  Midi_PlayNote(kbd.hMidi, kbd.chPlay, kbd.note, kbd.volume)
              END IF
          NEXT
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETINSTRUMENT  ' 0 to 127 instruments
          FOR c = LBOUND(pk) TO UBOUND(pk) ' On change, stop all notes
              Midi_StopNote(kbd.hMidi, kbd.chStop, kbd.octave * 12 + pk(c).nt)
              pk(c).dn = 0
          NEXT
          kbd.instrument = wParam
          Midi_SetInstrument(kbd.hMidi, kbd.chInstr, kbd.instrument)  'set selected instrument
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETPITCH   ' -64 to 64, where 0 is normal pitch
          Midi_PitchBend(kbd.hMidi, kbd.chBend, wParam)
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETVOLUME  ' 0 to 127, where 127 is max sound volume
          kbd.volume = wParam
          Midi_SetVolume(kbd.hMidi, kbd.chControl, kbd.volume)
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETBALANCE  ' -64 to 64, where 0 is centered
          kbd.balance = wParam
          Midi_SetBalance(kbd.hMidi, kbd.chControl, kbd.balance)
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETVIBRATO  ' 0 to 127, where 0 is no vibrato
          kbd.vibrato = wParam
          Midi_SetModulation(kbd.hMidi, kbd.chControl, kbd.vibrato)
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETSUSTAIN  ' on/off, where anything below 64 is off (0/127 = off/on)
          kbd.sustain = wParam
          Midi_SetSustain(kbd.hMidi, kbd.chControl, kbd.sustain)
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_GETKEYCOUNT
          FUNCTION = kbd.KeyCount + 1
          EXIT FUNCTION
    
      CASE %PM_SETKEYCOUNT  ' set total number of keys to draw/play
          kbd.KeyCount = MIN&(127, wParam - 1)
          DrawKeyBoard(hWnd, kbd, pk(), hRgn())
          InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETKEYTEXT  ' if to print keyboard key letter
          kbd.KeyText = wParam
          DrawKeyBoard(hWnd, kbd, pk(), hRgn())
          InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_SETNOTETEXT  ' if to print key note
          kbd.NoteText = wParam
          DrawKeyBoard(hWnd, kbd, pk(), hRgn())
          InvalidateRect hWnd, BYVAL 0, 0 : UpdateWindow hWnd
          IF lParam THEN SetFocus hWnd
          EXIT FUNCTION
    
      CASE %PM_PLAYNOTE  ' to enable playing notes via this message
          kbd.note   = MIN&(127, wParam) ' play this note
          kbd.volume = MIN&(127, lParam) ' 127 is max volume
          Midi_PlayNote(kbd.hMidi, kbd.chPlay, kbd.note, kbd.volume)
    
      CASE %PM_STOPNOTE  ' to enable stop playing notes via this message
          kbd.note = MIN&(127, wParam)
          Midi_StopNote(kbd.hMidi, kbd.chStop, kbd.note) ' stop playing this note
    
      END SELECT
    
      FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
    END FUNCTION
    
    
    '==============================================================================
    ' Initialize keyboard variables
    '------------------------------------------------------------------------------
    SUB initKbd (hWnd AS DWORD, kbd AS kbData)
      kbd.hParent    = GetParent(hWnd)
      kbd.CtlId      = GetDlgCtrlID(hWnd)
      kbd.hFont      = MakeFontEx(0, "Arial", 9, 0, %FW_BOLD, 0, 0) 'GetStockObject(%ANSI_VAR_FONT)
      kbd.KeyText    = 1
      kbd.NoteText   = 1
      kbd.octave     = 4         ' start with octave 3 and 5
      kbd.KeyCount   = 28        ' zerobased number of keys to draw (28 = 29 keys)
      kbd.volume     = 127       ' max sound volume
      kbd.instrument = 0         ' start off with piano
      kbd.sustain    = 0         ' start off with no sustain
      kbd.vibrato    = 0         ' start off with no vibrato
      kbd.balance    = 64        ' set balance to centered
      kbd.chStop     = &H80      ' Note off for channel 1 to 16 / &H80 to &H8F
      kbd.chPlay     = &H90      ' Note oon for channel 1 to 16 / &H90 to &H9F
      kbd.chControl  = &HB0      ' Control mode change for channel 1 to 16 / &HB0 to &HBF
      kbd.chInstr    = &HC0      ' Program change (instrument) for channel 1 to 16 / &HC0 to &HCF
      kbd.chBend     = &HE0      ' Pitch wheel range (0 TO 127, +/- two notes) for channel 1 to 16 / &HE0 to &HEF
      Midi_SetInstrument(kbd.hMidi, kbd.chInstr, kbd.instrument)  ' init instrument
      Midi_SetVolume(kbd.hMidi, kbd.chControl, kbd.volume)        ' init volume
      Midi_SetBalance(kbd.hMidi, kbd.chControl, kbd.balance)      ' init balance
    END SUB
    
    
    '==============================================================================
    ' Initialize keyboard memDC. Look worse than it is...  or maybe not. :)
    '------------------------------------------------------------------------------
    SUB DrawKeyBoard (hWnd AS DWORD, kbd AS kbData, pk() AS pKey, hRgn() AS DWORD)
      LOCAL b, c, d, h, hb, w, wb AS LONG
      LOCAL dwRes, hDC, hBrush, hOldPen, hPen, tmpFont AS DWORD
      LOCAL rc AS RECT
      DIM pts(1 TO 8) AS POINTAPI
    
      IF kbd.memDC THEN  ' restore and delete what we have created
          IF kbd.hBitOld THEN SelectObject kbd.memDC, kbd.hBitOld
          IF kbd.hBitmap THEN DeleteObject kbd.hBitmap
          DeleteDC kbd.memDC
      END IF
    
      hDC = GetDc(hWnd)
        GetClientRect hWnd, rc
        kbd.memDC   = CreateCompatibleDC(hDC)
        kbd.hBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
        kbd.hBitOld = SelectObject(kbd.memDC, kbd.hBitmap)
      ReleaseDC hWnd, hDC
    
      FillRect(kbd.memDC, rc, GetSysColorBrush(%COLOR_3DFACE))
      tmpFont = SelectObject(kbd.memDC, kbd.hFont)
    
      IF hRgn(LBOUND(hRgn)) THEN
          FOR c = LBOUND(hRgn) TO UBOUND(hRgn)
              IF hRgn(c) THEN DeleteObject(hRgn(c))
          NEXT
      END IF
    
      d = 0
      FOR c = 0 TO kbd.KeyCount
          SELECT CASE c MOD 12
          CASE 1, 3, 6, 8, 10  ' black keys
          CASE ELSE : INCR d   ' count white keys
          END SELECT
          pk(c).nt = c
      NEXT
    
      w  = rc.nRight / d                ' white key width
      IF d * w > rc.nRight THEN DECR w  ' ensure last key is fully inside control
      IF w MOD 2 THEN DECR w            ' need to ensure clean divide by 2
    
      IF d * w < rc.nRight THEN         ' shrink piano control to visible keys width
          SetWindowPos(hWnd, 0, 0, 0, d * w, rc.nBottom, %SWP_NOMOVE OR %SWP_NOZORDER)
      END IF
    
      wb = w * 0.7              ' black key width
      IF wb MOD 2 THEN DECR wb  ' need to ensure clean divide by 2
      h  = rc.nBottom           ' white key height
      hb = h * 0.7              ' black key height
    
      '--------------------------------------------------------------
      ' draw left white key. We use regions for mouse detection.
      '--------------------------------------------------------------
      hBrush  = SelectObject(kbd.memDC, GetStockObject(%WHITE_BRUSH))
      hPen    = CreatePen(%PS_SOLID, 1, RGB(96,96,96))
      hOldPen = SelectObject(kbd.memDC, hPen)
    
      pts(1).x =  0          : pts(1).y = 0   ' Region coordinates for Left white key
      pts(2).x =  w - wb / 2 : pts(2).y = 0
      pts(3).x =  pts(2).x   : pts(3).y = hb
      pts(4).x =  w          : pts(4).y = pts(3).y
      pts(5).x =  w          : pts(5).y = h
      pts(6).x =  0          : pts(6).y = h
    
      b = 0 : d = 0
      FOR c = 0 TO kbd.KeyCount
          IF (c > 0) AND (c MOD 12 = 0) THEN
              b = b + 7 * w
          END IF
          SELECT CASE c MOD 12
          CASE 0, 5
              SELECT CASE c MOD 12
              CASE 0 : d = 0
              CASE 5 : d = 3
              END SELECT
              hRgn(c) = CreatePolygonRgn(pts(1), 6, %ALTERNATE)  ' create region
              OffsetRgn hRgn(c), b + d * w, 0   ' move region into place
              GetRgnBox hRgn(c), rc             ' get region rect
              pk(c).rc = rc                     ' and use rect for RoundRect draw
              RoundRect(kbd.memDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 5, 5)
              PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
          END SELECT
      NEXT
    
      '--------------------------------------------------------------
      ' Draw middle white key
      '--------------------------------------------------------------
      pts(1).x =  wb / 2         : pts(1).y = 0
      pts(2).x =  w - wb / 2     : pts(2).y = 0
      pts(3).x =  pts(2).x       : pts(3).y = hb
      pts(4).x =  w              : pts(4).y = pts(3).y
      pts(5).x =  w              : pts(5).y = h
      pts(6).x =  0              : pts(6).y = h
      pts(7).x =  0              : pts(7).y = hb
      pts(8).x = pts(1).x        : pts(8).y = hb
    
      b = 0 : d = 0
      FOR c = 1 TO kbd.KeyCount
          SELECT CASE c MOD 12
          CASE 2, 7, 9
              SELECT CASE c MOD 12
              CASE 2 : d = 1
              CASE 7 : d = 4
              CASE 9 : d = 5
              END SELECT
              hRgn(c) = CreatePolygonRgn(pts(1), 8, %ALTERNATE)
              OffsetRgn hRgn(c), b + d * w, 0
              GetRgnBox hRgn(c), rc
              pk(c).rc = rc
              RoundRect(kbd.memDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 5, 5)
              PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
          END SELECT
          IF c MOD 12 = 0 THEN b = b + 7 * w
      NEXT
    
      '------------------------------------------------------------------
      ' draw Right white key
      '------------------------------------------------------------------
      pts(1).x =  wb / 2   : pts(1).y = 0
      pts(2).x =  w        : pts(2).y = 0
      pts(3).x =  w        : pts(3).y = h
      pts(4).x =  0        : pts(4).y = h
      pts(5).x =  0        : pts(5).y = hb
      pts(6).x =  wb / 2   : pts(6).y = hb
    
      b = 0 : d = 0
      FOR c = 1 TO kbd.KeyCount
          SELECT CASE c MOD 12
          CASE 4, 11
              SELECT CASE c MOD 12
              CASE  4 : d = 2
              CASE 11 : d = 6
              END SELECT
              hRgn(c) = CreatePolygonRgn(pts(1), 6, %ALTERNATE)
              OffsetRgn hRgn(c), b + d * w, 0
              GetRgnBox hRgn(c), rc
              pk(c).rc = rc
              RoundRect(kbd.memDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 5, 5)
              PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %LTGRAY, %WHITE), %WHITE, IIF(kbd.NoteText, %GRAY, %WHITE), %WHITE)
          END SELECT
          IF c MOD 12 = 0 THEN b = b + 7 * w
      NEXT
    
      hOldPen = SelectObject(kbd.memDC, hOldPen)
      dwRes   = DeleteObject(hPen)
      SelectObject kbd.memDC, hBrush
    
      '--------------------------------------------------------------
      ' draw black keys
      '--------------------------------------------------------------
      pts(1).x = 0        : pts(1).y = 0
      pts(2).x = wb       : pts(2).y = 0
      pts(3).x = pts(2).x : pts(3).y = hb
      pts(4).x = 0        : pts(4).y = hb
    
      hBrush  = SelectObject(kbd.memDC, GetStockObject(%BLACK_BRUSH))
      hPen    = CreatePen(%PS_SOLID, 1, RGB(0,0,0))
      hOldPen = SelectObject(kbd.memDC, hPen)
    
      b = 0 : d = 0
      FOR c = 1 TO kbd.KeyCount  ' 0 is white key, C
          IF c MOD 12 = 0 THEN b = b + 7 * w
          SELECT CASE c MOD 12
          CASE 1, 3, 6, 8, 10
              SELECT CASE c MOD 12
              CASE  1 : d = 1
              CASE  3 : d = 2
              CASE  6 : d = 4
              CASE  8 : d = 5
              CASE 10 : d = 6
              END SELECT
              hRgn(c) = CreatePolygonRgn(pts(1), 4, %ALTERNATE)
              OffsetRgn hRgn(c), b + d * w - wb / 2, 0
              GetRgnBox hRgn(c), rc
              pk(c).rc = rc
              RoundRect(kbd.memDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 3, 3)
          END SELECT
      NEXT
    
      hOldPen = SelectObject(kbd.memDC, hOldPen)
      dwRes   = DeleteObject(hPen)
      SelectObject kbd.memDC, hBrush
    
      '--------------------------------------------------------------
      ' draw thin white rectangle inside black keys
      '--------------------------------------------------------------
      hBrush  = SelectObject(kbd.memDC, GetStockObject(%NULL_BRUSH))
      hPen    = CreatePen(%PS_SOLID, 1, RGB(255,255,255))
      hOldPen = SelectObject(kbd.memDC, hPen)
    
      FOR c = 1 TO kbd.KeyCount  ' 0 is white key, C
          SELECT CASE c MOD 12
          CASE 1, 3, 6, 8, 10
              GetRgnBox hRgn(c), rc
              InflateRect(rc, -2, -2)
              Rectangle(kbd.memDC, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom)
              PrintKeyText(kbd, pk(c), IIF(kbd.KeyText, %GRAY, %BLACK), %BLACK, IIF(kbd.NoteText, %LTGRAY, %BLACK), %BLACK)
          END SELECT
      NEXT
    
      hOldPen = SelectObject(kbd.memDC, hOldPen)
      dwRes   = DeleteObject(hPen)
      SelectObject kbd.memDC, hBrush
      IF tmpFont THEN SelectObject kbd.memDC, tmpFont
    
     END SUB
     
    
    '==============================================================================
    ' Create a desirable font and return its handle.
    '------------------------------------------------------------------------------
    FUNCTION MakeFontEx (BYVAL hDC AS DWORD,  BYVAL FontName AS STRING, _
                         BYVAL PointSize AS LONG, BYVAL Angle AS LONG, BYVAL fBold AS LONG, _
                         BYVAL fItalic AS LONG, BYVAL fUnderline AS LONG) AS DWORD
    
      LOCAL CharSet AS LONG, CyPixels AS LONG
    
      IF hDC = 0 THEN
          hDC = GetDC(%HWND_DESKTOP)
          CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
          EnumFontFamilies hDC, BYVAL STRPTR(FontName), CODEPTR(EnumCharSet), BYVAL VARPTR(CharSet)
          ReleaseDC %HWND_DESKTOP, hDC
      ELSE
          CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
          EnumFontFamilies hDC, BYVAL STRPTR(FontName), CODEPTR(EnumCharSet), BYVAL VARPTR(CharSet)
      END IF
      PointSize = 0 - (PointSize * CyPixels) \ 72
    
      FUNCTION = CreateFont(PointSize, 0, _  'height, width (default=0)
                 Angle, Angle, _             'escapement(angle), orientation
                 fBold, _                    'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700)
                 fItalic, _                  'Italic
                 fUnderline, _               'Underline
                 %FALSE, _                   'StrikeThru
                 CharSet, %OUT_TT_PRECIS, _
                 %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
                 %FF_DONTCARE , BYCOPY FontName)
    
    END FUNCTION
    '==============================================================================
    ' Get type of character set - ansi, symbol.. a must for some fonts.
    '------------------------------------------------------------------------------
    FUNCTION EnumCharSet (elf AS ENUMLOGFONT, ntm AS NEWTEXTMETRIC, _
                          BYVAL FontType AS LONG, CharSet AS LONG) AS LONG
      CharSet = elf.elfLogFont.lfCharSet
    END FUNCTION
    
    
    '==============================================================================
    ' Custom ptInRect function to enable compile with older compiler/Win32API.inc
    '------------------------------------------------------------------------------
    FUNCTION fnPtInRect(rc AS RECT, pt AS POINTAPI) AS LONG
      #IF %PB_REVISION >= &H1000         ' if compiler PBWIN10 or later
          FUNCTION = ptInRect(rc, pt)
      #ELSE                              ' else
          FUNCTION = ptInRect(rc, pt.x, pt.y)
      #ENDIF
    END FUNCTION
    
    
    '==============================================================================
    ' Get note description for 7+5=12 keys in any octave
    '------------------------------------------------------------------------------
    FUNCTION GetNoteText(BYVAL iNote AS BYTE) AS STRING
      SELECT CASE iNote MOD 12
      CASE  0 : FUNCTION = "C"
      CASE  1 : FUNCTION = "C#"
      CASE  2 : FUNCTION = "D"
      CASE  3 : FUNCTION = "D#"
      CASE  4 : FUNCTION = "E"
      CASE  5 : FUNCTION = "F"
      CASE  6 : FUNCTION = "F#"
      CASE  7 : FUNCTION = "G"
      CASE  8 : FUNCTION = "G#"
      CASE  9 : FUNCTION = "A"
      CASE 10 : FUNCTION = "A#"
      CASE 11 : FUNCTION = "B"
      END SELECT
    END FUNCTION
    
    
    '==============================================================================
    ' Print note + key text on key, using desired colors.
    '------------------------------------------------------------------------------
    SUB PrintKeyText(kbd AS kbData, pk AS pKey, _
                     iForeColor1 AS LONG, iBackColor1 AS LONG, _
                     iForeColor2 AS LONG, iBackColor2 AS LONG)
    
      LOCAL tmpFont AS DWORD, sText AS STRING, rc AS RECT, sz AS SIZEL
    
      tmpFont = SelectObject(kbd.memDC, kbd.hFont)
      GetTextExtentPoint32 kbd.memDC, "W", 1, sz  ' need font height
      rc = pk.rc
    
      sText = MID$($KEY1, pk.nt + 1, 1)  ' draw keyboard key text
      SetBkColor kbd.memDC, iBackColor1
      SetTextColor kbd.memDC, iForeColor1
      rc.nBottom = pk.rc.nBottom - 1.7 * sz.cy
      DrawText kbd.memDC, BYVAL STRPTR(sText), LEN(sText), rc, %DT_BOTTOM OR %DT_CENTER OR %DT_SINGLELINE
    
      sText = GetNoteText(pk.nt)         ' draw note text
      SetBkColor kbd.memDC, iBackColor2
      SetTextColor kbd.memDC, iForeColor2
      rc.nBottom = pk.rc.nBottom - 0.5 * sz.cy
      DrawText kbd.memDC, BYVAL STRPTR(sText), LEN(sText), rc, %DT_BOTTOM OR %DT_CENTER OR %DT_SINGLELINE
    
      IF tmpFont THEN SelectObject kbd.memDC, tmpFont  ' restore font
    
    END SUB
    
    
    '==============================================================================
    ' Enumerate midi devices - cannot test if it works 100%, but think it's ok..
    '----------------------------------------------------------------------------------
    SUB Midi_ListDevices (hDlg AS LONG, ctlId AS LONG)
      LOCAL c AS LONG, hCtrl, dwMsg1, dwMsg2 AS DWORD
      LOCAL MidiCaps AS MIDIOUTCAPS, zTxt AS ASCIIZ * 32
    
      hCtrl = GetDlgItem(hDlg, CtlId)
      GetClassName hCtrl, zTxt, SIZEOF(zTxt) ' see what kind of control to fill
    
      IF UCASE$(zTxt) = "COMBOBOX" THEN      ' if to add results to a ComboBox
          SendMessage(hCtrl, %CB_RESETCONTENT, 0, 0)
          dwMsg1 = %CB_ADDSTRING
          dwMsg2 = %CB_SETCURSEL
      ELSE                                   ' elseif to add results to a ListBox
          SendMessage(hCtrl, %LB_RESETCONTENT, 0, 0)
          dwMsg1 = %LB_ADDSTRING
          dwMsg2 = %LB_SETCURSEL
      END IF
      '------------------------------------------------------------------
      FOR c = 1 TO midiOutGetNumDevs  ' there's usually only one...
          midiOutGetDevCaps c - 1, BYVAL VARPTR(MidiCaps), LEN(MidiCaps)
          SendMessage(hCtrl, dwMsg1, 0, BYVAL VARPTR(MidiCaps.szPname))
      NEXT
      SendMessage(hCtrl, dwMsg2, 0, 0)
    END SUB
    
    
    '==============================================================================
    ' Fill a ComboBox or ListBox with midi channels
    '------------------------------------------------------------------------------
    SUB Midi_ListChannels(BYVAL hDlg AS DWORD, BYVAL CtlId AS DWORD)
    
      LOCAL c AS LONG, hCtrl, dwMsg1, dwMsg2 AS DWORD, zTxt AS ASCIIZ * 64
    
      hCtrl = GetDlgItem(hDlg, CtlId)
      GetClassName hCtrl, zTxt, SIZEOF(zTxt) ' see what kind of control to fill
    
      IF UCASE$(zTxt) = "COMBOBOX" THEN      ' if to add channels to a ComboBox
          SendMessage(hCtrl, %CB_RESETCONTENT, 0, 0)
          dwMsg1 = %CB_ADDSTRING
          dwMsg2 = %CB_SETCURSEL
      ELSEIF UCASE$(zTxt) = "LISTBOX" THEN   ' elseif to add channels to a ListBox
          SendMessage(hCtrl, %LB_RESETCONTENT, 0, 0)
          dwMsg1 = %LB_ADDSTRING
          dwMsg2 = %LB_SETCURSEL
      END IF
    
      FOR c = 1 TO 16
          IF c = 10 THEN
              zTxt = " Channel" + STR$(c) + "  (Percussion set)"
          ELSE
              zTxt = " Channel" + STR$(c)
          END IF
          SendMessage(hCtrl, dwMsg1, 0, BYVAL VARPTR(zTxt))
      NEXT
      SendMessage(hCtrl, dwMsg2, 0, 0)
    
    END SUB
    
    
    '==============================================================================
    ' Fill a ComboBox or ListBox with midi patches (instrument categories)
    '------------------------------------------------------------------------------
    SUB Midi_ListPatches(BYVAL hDlg AS DWORD, BYVAL CtlId AS DWORD)
    
      LOCAL c AS LONG, hCtrl, dwMsg AS DWORD, zTxt AS ASCIIZ * 64
    
      hCtrl = GetDlgItem(hDlg, CtlId)
      GetClassName hCtrl, zTxt, SIZEOF(zTxt) ' see what kind of control to fill
    
      IF UCASE$(zTxt) = "COMBOBOX" THEN      ' if to add data to a ComboBox
          SendMessage(hCtrl, %CB_RESETCONTENT, 0, 0)
          dwMsg = %CB_ADDSTRING
      ELSEIF UCASE$(zTxt) = "LISTBOX" THEN   ' elseif to add data to a ListBox
          SendMessage(hCtrl, %LB_RESETCONTENT, 0, 0)
          dwMsg = %LB_ADDSTRING
      END IF
    
      FOR c = 1 TO DATACOUNT
         zTxt = READ$(c)
         SendMessage(hCtrl, dwMsg, 0, BYVAL VARPTR(zTxt))
      NEXT
    
    DATA "Piano", "Chromatic Percussion", "Organ", "Guitar"
    DATA "Bass", "Strings", "Ensamble", "Brass"
    DATA "Reed", "Pipe", "Synth Lead", "Synth Pad"
    DATA "Synth Effects", "Ethnic", "Percussive", "Sound effects"
    
    END SUB
    
    
    '==============================================================================
    ' Fill a ListBox or ComboBox with midi instruments
    '------------------------------------------------------------------------------
    SUB Midi_ListInstruments (BYVAL hDlg AS DWORD, BYVAL CtlId AS DWORD, BYVAL iPatches AS LONG)
      LOCAL c, iStart, iStop AS LONG
      LOCAL hCtrl, dwMsg1, dwMsg2 AS DWORD, zTxt AS ASCIIZ * 64
    
      SELECT CASE iPatches  ' divide into iPatch categories
      CASE  0 : iStart =   1 : iStop =   8  ' Piano
      CASE  1 : iStart =   9 : iStop =  16  ' Chromatic Percussion
      CASE  2 : iStart =  17 : iStop =  24  ' Organ
      CASE  3 : iStart =  25 : iStop =  32  ' Guitar
      CASE  4 : iStart =  33 : iStop =  40  ' Bass
      CASE  5 : iStart =  41 : iStop =  48  ' Strings
      CASE  6 : iStart =  49 : iStop =  56  ' Ensamble
      CASE  7 : iStart =  57 : iStop =  64  ' Brass
      CASE  8 : iStart =  65 : iStop =  72  ' Reed
      CASE  9 : iStart =  73 : iStop =  80  ' Pipe
      CASE 10 : iStart =  81 : iStop =  88  ' Synth Lead
      CASE 11 : iStart =  89 : iStop =  96  ' Synth Pad
      CASE 12 : iStart =  97 : iStop = 104  ' Synth Effects
      CASE 13 : iStart = 105 : iStop = 112  ' Ethnic
      CASE 14 : iStart = 113 : iStop = 119  ' Percussive
      CASE 15 : iStart = 120 : iStop = 128  ' Sound effects
      END SELECT
     
      hCtrl = GetDlgItem(hDlg, CtlId)
      GetClassName hCtrl, zTxt, SIZEOF(zTxt) ' see what kind of control to fill
    
      IF UCASE$(zTxt) = "LISTBOX" THEN       ' if to add data to a ListBox
          SendMessage(hCtrl, %LB_RESETCONTENT, 0, 0)
          dwMsg1 = %LB_ADDSTRING
          dwMsg2 = %LB_SETITEMDATA
      ELSEIF UCASE$(zTxt) = "COMBOBOX" THEN  ' elseif to add data to a ComboBox
          SendMessage(hCtrl, %CB_RESETCONTENT, 0, 0)
          dwMsg1 = %CB_ADDSTRING
          dwMsg2 = %CB_SETITEMDATA
      END IF
    
      FOR c = iStart TO iStop
         zTxt = FORMAT$(c, "* #") + "  " + READ$(c)
         SendMessage(hCtrl, dwMsg1, 0, BYVAL VARPTR(zTxt))
         SendMessage(hCtrl, dwMsg2, c - iStart, c - 1)
      NEXT
    
    '------------------------------------------------------------------------------
    DATA "Acoustic Grand Piano", "Bright Acoustic Piano", "Electric Grand Piano"
    DATA "Honky-tonk Piano", "Rhodes Piano", "Chorused Piano", "Harpsichord"
    DATA "Clavinet", "Celesta", "Glockenspiel", "Music Box", "Vibraphone"
    DATA "Marimba", "Xylophone", "Tubular Bells", "Dulcimer", "Hammond Organ"
    DATA "Percussive Organ", "Rock Organ", "Church Organ", "Reed Organ"
    DATA "Accordion", "Harmonica", "Tango Accordion", "Acoustic Guitar (nylon)"
    DATA "Acoustic Guitar (steel)", "Electric Guitar (jazz)", "Electric Guitar (clean)"
    DATA "Electric Guitar (muted)", "Overdriven Guitar", "Distortion Guitar"
    DATA "Guitar Harmonics", "Acoustic Bass", "Electric Bass (finger)", "Electric Bass (pick)"
    DATA "Fretless Bass", "Slap Bass 1", "Slap Bass 2", "Synth Bass 1", "Synth Bass 2"
    DATA "Violin", "Viola", "Cello", "Contrabass", "Tremolo Strings", "Pizzicato Strings"
    DATA "Orchestral Harp", "Timpani", "String Ensemble 1", "String Ensemble 2"
    DATA "SynthStrings 1", "SynthStrings 2", "Choir Aahs", "Voice Oohs", "Synth Voice"
    DATA "Orchestra Hit", "Trumpet", "Trombone", "Tuba", "Muted Trumpet", "French Horn"
    DATA "Brass Section", "Synth Brass 1", "Synth Brass 2", "Soprano Sax", "Alto Sax"
    DATA "Tenor Sax", "Baritone Sax", "Oboe", "English Horn", "Bassoon", "Clarinet"
    DATA "Piccolo", "Flute", "Recorder", "Pan Flute", "Bottle Blow", "Shakuhachi"
    DATA "Whistle", "Ocarina", "Lead 1 (square)", "Lead 2 (sawtooth)", "Lead 3 (calliope lead)"
    DATA "Lead 4 (chiff lead)", "Lead 5 (charang)", "Lead 6 (voice)", "Lead 7 (fifths)"
    DATA "Lead 8 (bass + lead)", "Pad 1 (new age)", "Pad 2 (warm)", "Pad 3 (polysynth)"
    DATA "Pad 4 (choir)", "Pad 5 (bowed)", "Pad 6 (metallic)", "Pad 7 (halo)", "Pad 8 (sweep)"
    DATA "FX 1 (rain)", "FX 2 (soundtrack)", "FX 3 (crystal)", "FX 4 (atmosphere)"
    DATA "FX 5 (brightness)", "FX 6 (goblins)", "FX 7 (echoes)", "FX 8 (sci-fi)"
    DATA "Sitar", "Banjo", "Shamisen", "Koto", "Kalimba", "Bagpipe", "Fiddle"
    DATA "Shanai", "Tinkle Bell", "Agogo", "Steel Drums", "Woodblock", "Taiko Drum"
    DATA "Melodic Tom", "Synth Drum", "Reverse Cymbal", "Guitar Fret Noise"
    DATA "Breath Noise", "Seashore", "Bird Tweet", "Telephone Ring", "Helicopter"
    DATA "Applause", "Gunshot"
    
    END SUB
    
    
    '==============================================================================
    ' Set desired instrument, event/channel &HB0 to &HBF.
    '------------------------------------------------------------------------------
    FUNCTION Midi_SetInstrument(BYVAL hMidi AS DWORD, _
                                BYVAL bEvent AS BYTE, _            ' event/channel
                                BYVAL bInstrument AS BYTE) AS LONG ' instrument
      LOCAL dwData AS DWORD
      dwData = bEvent + bInstrument * &H100     ' setup dwData
      FUNCTION = midiOutShortMsg(hMidi, dwData) ' set instrument
    END FUNCTION
    
    
    '==============================================================================
    ' Set sound volume for selected channel, event/channel &HC0 to &HCF.
    '------------------------------------------------------------------------------
    FUNCTION Midi_SetVolume(BYVAL hMidi    AS DWORD, _
                            BYVAL iEvent   AS LONG, _       'channel &HB0 to &HBF
                            BYVAL iVolume AS LONG) AS LONG  'volume, 0 to 127
      LOCAL dwData AS DWORD
      dwData   = iEvent + &H7 * &H100 + iVolume * &H10000   ' &H7 = 7
      FUNCTION = midiOutShortMsg(hMidi, dwData)
    END FUNCTION
    
    
    '==============================================================================
    ' Set balance for selected channel.  0 = Left, 64 = Center, 127 = Right
    '------------------------------------------------------------------------------
    FUNCTION Midi_SetBalance(BYVAL hMidi    AS DWORD, _
                             BYVAL iEvent   AS LONG, _       'channel &HB0 to &HBF
                             BYVAL iBalance AS LONG) AS LONG 'balance
      LOCAL dwData AS DWORD
      dwData   = iEvent + &HA * &H100 + iBalance * &H10000   ' &HA = 10
      FUNCTION = midiOutShortMsg(hMidi, dwData)
    END FUNCTION
    
    
    '==============================================================================
    ' Set Modulation/Vibrato for selected channel. iModulation = 1 to 127
    '------------------------------------------------------------------------------
    FUNCTION Midi_SetModulation(BYVAL hMidi       AS DWORD, _
                                BYVAL iEvent      AS LONG, _       'channel &HB0 to &HBF
                                BYVAL iModulation AS LONG) AS LONG 'balance, 127 = on, 0 = off
      LOCAL dwData AS DWORD
      dwData   = iEvent + &H1 * &H100 + iModulation * &H10000  ' &H1 = 1
      FUNCTION = midiOutShortMsg(hMidi, dwData)
    END FUNCTION
    
    
    '==============================================================================
    ' Pitch Bend +/- 2 notes, 0 = Max down, 64=Normal note, 127 = Max up
    '------------------------------------------------------------------------------
    FUNCTION Midi_PitchBend (BYVAL hMidi AS DWORD, _
                             BYVAL bEvent AS BYTE, _       ' event/channel &HE0 to &HEF
                             BYVAL bPitch AS BYTE) AS LONG ' Pitch bend 0 to 127
      LOCAL dwData AS DWORD
      dwData = bEvent + bPitch * &H10000        ' setup dwData
      FUNCTION = midiOutShortMsg(hMidi, dwData) ' set instrument
    END FUNCTION
    
    
    '==============================================================================
    ' Set Sustain for selected channel
    '------------------------------------------------------------------------------
    FUNCTION Midi_SetSustain(BYVAL hMidi AS DWORD, _
                             BYVAL bEvent AS LONG, _        'channel &HB0 to &HBF
                             BYVAL sustain AS LONG) AS LONG 'sustain, 127 = on, 0 = off
      LOCAL dwData AS DWORD
      dwData = bEvent + &H40 * &H100 + sustain * &H10000    ' &H40 = 64
      FUNCTION = midiOutShortMsg(hMidi, dwData)
    END FUNCTION
    
    
    '==============================================================================
    ' Play a note using midiOutShortMsg, channel &H90 to &H9F (ch &H99 = percussion)
    '------------------------------------------------------------------------------
    FUNCTION Midi_PlayNote (BYVAL hMidi AS DWORD, _           '
                            BYVAL bEvent AS BYTE, _           ' event/channel
                            BYVAL bNote AS BYTE, _            ' play this note
                            BYVAL bVolume AS BYTE) AS DWORD   ' sound volume, 0 to 127
      LOCAL dwData AS DWORD
      dwData = bEvent + bNote * &H100 + bVolume * &H10000     ' setup for playing
      FUNCTION = midiOutShortMsg(hMidi, dwData)               ' play note
    END FUNCTION
    
    
    '==============================================================================
    ' Turn off all notes in selected channel, &HB0 to &HBF.
    '------------------------------------------------------------------------------
    FUNCTION Midi_StopAllNotes(BYVAL hMidi AS DWORD, _
                               BYVAL bEvent AS LONG) AS LONG  'event/channel
      LOCAL dwData AS DWORD
      dwData = bEvent + &H7B * &H100  ' &H7B = 123
      FUNCTION = midiOutShortMsg(hMidi, dwData)
    END FUNCTION
    
    
    '==============================================================================
    ' Stop playing a note using midiOutShortMsg, channel &H80 to &H8F.
    '------------------------------------------------------------------------------
    FUNCTION Midi_StopNote (BYVAL hMidi AS DWORD, _
                            BYVAL bEvent AS BYTE, _       ' event/channel
                            BYVAL bNote AS BYTE) AS LONG  ' note
      LOCAL dwData AS DWORD
      dwData = bEvent + (bNote * &H100)          ' setup dwData
      FUNCTION = midiOutShortMsg(hMidi, dwData)  ' stop playing
    END FUNCTION
    Attached Files
    Last edited by Borje Hagsten; 5 Jun 2016, 07:19 AM.

  • #2
    BTW, eventual discussions here: http://forum.powerbasic.com/forum/us...custom-control

    Comment


    • #3
      Here are SDK versions of the above codes. Else no difference in appearence or features. For Include file code, see posting #1 above. Attached zip-file contains both thease codes, include file and compiled exes. For eventual discussion or questions and a little more info, see link in post #2 above.

      Code:
      ' PBPianoDemoSDK.bas - Public Domain by Borje Hagsten, June, 2016.
      ' An SDK version of PBPiano.bas, using SDK calls instead of DDT.
      ' A clean and simple basic demo of how easy PBPiano.inc makes it to
      ' build a fullblown midi piano with both mouse and keyboard control
      ' in PBWin. Up/down arrow keys controls pitch bend and Left/Right
      ' arrow keys changes base octave.
      ' See also PBPianoSDK.bas, where all features are shown in use
      ' and PBPiano.inc, where features and messages are explained.
      
      
      '======================================================================
      ' Declares
      '----------------------------------------------------------------------
      #COMPILE EXE
      '----------------------------------------------------------------------
      #INCLUDE "WIN32API.INC"
      #INCLUDE "PBPiano.inc"
      '------------------------------------------------
      %IDC_PIANO     = 200  ' PBPiano custom control id
      
      
      '======================================================================
      FUNCTION WINMAIN (BYVAL hInst AS DWORD, BYVAL hPrevInstance AS DWORD, _
                        BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
      '----------------------------------------------------------------------
      ' Program entrance
      '----------------------------------------------------------------------
        LOCAL hDlg, hFont, hPiano AS DWORD, w, h AS LONG, _
              rc, rc2 AS RECT, wc AS WndClassEx, szClassName AS ASCIIZ * 80
      
        hFont = GetStockObject(%DEFAULT_GUI_FONT)
      
        szClassName      = "PBPianoDemoSDK"
        wc.cbSize        = SIZEOF(wc)
        wc.style         = %CS_HREDRAW OR %CS_VREDRAW
        wc.lpfnWndProc   = CODEPTR(WndProc)
        wc.cbClsExtra    = 0
        wc.cbWndExtra    = 0
        wc.hInstance     = hInst
        wc.hIcon         = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)
        wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
        wc.hbrBackground = %COLOR_3DFACE + 1
        wc.lpszMenuName  = %NULL
        wc.lpszClassName = VARPTR(szClassName)
        wc.hIconSm       = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)
        CALL RegisterClassEx (wc)
      
        hDlg = CreateWindowEx(%WS_EX_CONTROLPARENT OR %WS_EX_WINDOWEDGE, szClassName, "PBPiano Demo SDK", _
                    %WS_CLIPSIBLINGS OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
                    %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %DS_CENTER, _
                    (GetSystemMetrics(%SM_CXSCREEN) - 1000) / 2, _
                    (GetSystemMetrics(%SM_CYSCREEN) - 245) / 2, _
                     1000, 245, 0, 0, hInst, BYVAL %NULL)
      
        '------------------------------------------------------------------
        hPiano = CreatePiano(hDlg, %IDC_PIANO, "", 10, 10, 1000, 200, _
                             %WS_CHILD OR %WS_TABSTOP OR %WS_VISIBLE, 0, 0)
      
        '------------------------------------------------------------------
        SendMessage(hPiano, %PM_SETKEYCOUNT, 48, 0) ' for 4 full octaves
        SendMessage(hPiano, %PM_SETOCTAVE, 3, 0)    ' base octave 3
      
        '------------------------------------------------------------------
         ' setting keycount may change piano control width
         ' so let's adjust parent window to piano control width
        '------------------------------------------------------------------
        GetWindowRect(hDlg, rc)
        rc.nBottom = rc.nBottom - rc.nTop
        GetWindowRect(hPiano, rc2)
        rc.nRight  = rc2.nRight - rc2.nLeft
        SetWindowPos(hDlg, 0, 0, 0, rc.nRight + 25, rc.nBottom, %SWP_NOMOVE OR %SWP_NOZORDER)
      
        '------------------------------------------------------------------
        ' If main window is created without %WS_VISIBLE style, it won't
        ' show until ShowWindow is called after all controls and settings
        ' to this point are done. Can help giving a more distinctive start.
        '------------------------------------------------------------------
        ShowWindow hDlg, nCmdShow
        UpdateWindow hDlg
      
        LOCAL Msg AS tagMsg
        WHILE GetMessage(Msg, %NULL, 0, 0)
            TranslateMessage Msg
            DispatchMessage Msg
        WEND
      
        FUNCTION = msg.wParam
      END FUNCTION
      
      
      '======================================================================
      FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                        BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
      '----------------------------------------------------------------------
      ' Main Window procedure
      '----------------------------------------------------------------------
        STATIC hPiano AS DWORD
      
        SELECT CASE wMsg
        CASE %WM_CREATE
            'A good place to initiate things, declare variables,
            'create controls and read/set settings from a file, etc.
            '-------------------------------------------------------
      
        CASE %WM_GETDLGCODE ' Ensure the control processes all keys by itself
            FUNCTION = %DLGC_WANTALLKEYS
            EXIT FUNCTION
      
        CASE %WM_KEYDOWN, %WM_KEYUP  ' keyboard keys
            IF hPiano = 0 THEN hPiano = GetDlgItem(hWnd, %IDC_PIANO)
            SendMessage hPiano, wMsg, wParam, lParam
            EXIT FUNCTION
      
        CASE %WM_COMMAND
            'Messages from controls and menu items are handled here.
            '-------------------------------------------------------
            SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
                IF HIWRD(wParam) = %BN_CLICKED THEN
                    SendMessage hWnd, %WM_DESTROY, wParam, lParam
                    FUNCTION = 0 : EXIT FUNCTION
                END IF
      
            CASE %IDC_PIANO
      
            END SELECT
      
      
        CASE %WM_DESTROY
            ' is sent when program ends - a good place to delete any created objects and
            ' store settings in file for next run, etc. Must send PostQuitMessage to end
            ' properly in SDK-style dialogs. The PostQuitMessage function sends a WM_QUIT
            ' message to the program's (thread's) message queue, and then WM_QUIT causes
            ' the GetMessage function to return zero in WINMAIN's message loop.
            '----------------------------------------------------------------------------
            PostQuitMessage 0
            FUNCTION = 0 : EXIT FUNCTION
      
        END SELECT
      
        FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
      END FUNCTION
      And the more complete proggie:

      Code:
      ' PBPianoSDK.bas - Public Domain by Borje Hagsten, June, 2016.
      ' An SDK version of PBPiano.bas, using SDK calls instead of DDT.
      ' A complete demo of how to use PBPiano.inc to build a virtual
      ' midi keyboard with both mouse and computer keyboard control.
      ' See also PBPianoDemo.bas, a basic example showing how easy it is
      ' to use and PBPiano.inc, where features and messages are explained.
      
      '======================================================================
      ' Declares
      '----------------------------------------------------------------------
      #COMPILE EXE
      #DIM ALL
      '----------------------------------------------------------------------
      #INCLUDE "WIN32API.INC"
      #INCLUDE "COMMCTRL.INC"
      #INCLUDE "PBPiano.inc"
      '----------------------------------------------------------------------
      %IDC_LABEL1    = 101  ' octave info
      %IDC_LABEL2    = 103  ' < "button"
      %IDC_LABEL3    = 104  ' > "button"
      %IDC_LABEL4    = 105  ' F1 - help text
      %IDC_FRAME1    = 111  ' Options
      %IDC_FRAME2    = 112  ' Patch/Instrument
      %IDC_FRAME3    = 113  ' Effects
      %IDC_FRAME4    = 114  ' Pitch bend
      %IDC_CHECKBOX1 = 133  ' Always on top
      %IDC_CHECKBOX2 = 131  ' Show Key text
      %IDC_CHECKBOX3 = 132  ' Show Note text
      %IDC_CHECKBOX4 = 134  ' Sustain
      %IDC_LISTBOX1  = 141  ' Instrument listbox
      %IDC_COMBOBOX1 = 151  ' Channels ComboBox
      %IDC_COMBOBOX2 = 152  ' Midi devices ComboBox
      %IDC_COMBOBOX3 = 153  ' Instrument categories ComboBox
      %IDC_KEYBOARD  = 160  ' Graphic control - piano keys
      %IDC_TRACKBAR1 = 181  ' Volume
      %IDC_TRACKBAR2 = 182  ' Balance
      %IDC_TRACKBAR3 = 183  ' Vibrato
      %IDC_TRACKBAR4 = 184  ' Pitch bend
      %IDC_PIANO     = 200  ' PBPiano custom control
      
      
      '======================================================================
      FUNCTION WINMAIN (BYVAL hInst AS DWORD, BYVAL hPrevInstance AS DWORD, _
                        BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
      '----------------------------------------------------------------------
      ' Program entrance
      '----------------------------------------------------------------------
        LOCAL hDlg, hCtl, hFont, hPiano AS DWORD, _
              wc AS WndClassEx, szClassName AS ASCIIZ * 80
      
        hFont = GetStockObject(%DEFAULT_GUI_FONT)
      
        szClassName      = "PBPianoSDK"
        wc.cbSize        = SIZEOF(wc)
        wc.style         = %CS_HREDRAW OR %CS_VREDRAW
        wc.lpfnWndProc   = CODEPTR(WndProc)
        wc.cbClsExtra    = 0
        wc.cbWndExtra    = 0
        wc.hInstance     = hInst
        wc.hIcon         = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)
        wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
        wc.hbrBackground = %COLOR_3DFACE + 1
        wc.lpszMenuName  = %NULL
        wc.lpszClassName = VARPTR(szClassName)
        wc.hIconSm       = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)
        CALL RegisterClassEx (wc)
      
        hDlg = CreateWindowEx(%WS_EX_CONTROLPARENT OR %WS_EX_WINDOWEDGE, szClassName, "PBPiano SDK", _
                    %WS_CLIPSIBLINGS OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
                    %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT OR %DS_CENTER, _
                    (GetSystemMetrics(%SM_CXSCREEN) - 638) / 2, _
                    (GetSystemMetrics(%SM_CYSCREEN) - 407) / 2, _
                     638, 407, 0, 0, hInst, BYVAL %NULL)
      
        InitCommonControls
      
        '------------------------------------------------------------------
        hPiano = CreatePiano(hDlg, %IDC_PIANO, "", 11, 193, 612, 179, _
                             %WS_CHILD OR %WS_TABSTOP OR %WS_VISIBLE, 0, 0)
        IF hFont THEN SendMessage hPiano, %WM_SETFONT, hFont, 0
      
        '------------------------------------------------------------------
        hCtl = CreateWindowEx(0, "BUTTON", "Options", _  ' Frame
                    %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
                     8, 3, 195, 176, _
                     hDlg, %IDC_FRAME1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "COMBOBOX", BYVAL %NULL, _  ' Midi devices
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST OR _
                    %CBS_HASSTRINGS, _
                     17, 21, 177, 160, _
                     hDlg, %IDC_COMBOBOX1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hPiano, %PM_LISTDEVICES, %IDC_COMBOBOX1, 0
      
        hCtl = CreateWindowEx(0, "COMBOBOX", BYVAL %NULL, _  ' Channels
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST OR _
                    %CBS_HASSTRINGS, _
                     17, 52, 177, 240, _
                     hDlg, %IDC_COMBOBOX2, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hPiano, %PM_LISTCHANNELS, %IDC_COMBOBOX2, 0
      
        hCtl = CreateWindowEx(0, "BUTTON", "Always on top ", _  ' CheckBox
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
                     17, 85, 97, 16, _
                     hDlg, %IDC_CHECKBOX1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "BUTTON", "Show Key text ", _  ' CheckBox
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
                     17, 104, 97, 16, _
                     hDlg, %IDC_CHECKBOX2, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %BM_SETCHECK, %BST_CHECKED, 0
      
        hCtl = CreateWindowEx(0, "BUTTON", "Show Note text ", _  ' CheckBox
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
                     17, 124, 97, 16, _
                     hDlg, %IDC_CHECKBOX3, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %BM_SETCHECK, %BST_CHECKED, 0
      
        hCtl = CreateWindowEx(0, "STATIC", "Press F1 for help, Esc to " + _
                    "Exit", _
                    %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
                     17, 159, 177, 17, _
                     hDlg, %IDC_LABEL4, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        '------------------------------------------------------------------
        hCtl = CreateWindowEx(0, "BUTTON", "Patches/Instrument", _  ' Frame
                    %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
                     215, 3, 160, 176, _
                     hDlg, %IDC_FRAME2, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "COMBOBOX", BYVAL %NULL, _  ' Patches
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST OR _
                    %CBS_HASSTRINGS, _
                     224, 20, 142, 260, _
                     hDlg, %IDC_COMBOBOX3, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hPiano, %PM_LISTPATCHES, %IDC_COMBOBOX3, 0
        SendMessage hCtl, %CB_SETCURSEL, 0, 0
      
        hCtl = CreateWindowEx(%WS_EX_CLIENTEDGE, "LISTBOX", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LBS_NOTIFY OR _
                    %LBS_NOINTEGRALHEIGHT, _
                     224, 47, 142, 124, _
                     hDlg, %IDC_LISTBOX1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
          SendMessage hPiano, %PM_LISTINSTRUMENTS, %IDC_LISTBOX1, 0
          SendMessage hCtl, %LB_SETCURSEL, 0, 0
      
        '------------------------------------------------------------------
        hCtl = CreateWindowEx(0, "BUTTON", "Effects", _  ' Frame
                    %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
                     387, 3, 156, 176, _
                     hDlg, %IDC_FRAME3, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(%WS_EX_STATICEDGE, "STATIC", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN, _
                     398, 20, 135, 30, _
                     hDlg,  -1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "STATIC", "Octave 4 to 5" + $CRLF + _
                    "(< or > to change)", _
                    %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
                     416, 21, 97, 28, _
                     hDlg, %IDC_LABEL1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_WINDOWEDGE, "STATIC", "<", _
                    %WS_CHILD OR %WS_VISIBLE OR %SS_CENTERIMAGE OR %SS_NOTIFY OR _
                    %SS_CENTER, _
                     399, 21, 18, 28, _
                     hDlg, %IDC_LABEL2, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(%WS_EX_DLGMODALFRAME OR %WS_EX_WINDOWEDGE, "STATIC", ">", _
                    %WS_CHILD OR %WS_VISIBLE OR %SS_CENTERIMAGE OR %SS_NOTIFY OR _
                    %SS_CENTER, _
                     513, 21, 18, 28, _
                     hDlg, %IDC_LABEL3, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "STATIC", "Volume:", _
                    %WS_CHILD OR %WS_VISIBLE, _
                     395, 60, 45, 16, _
                     hDlg,  -1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "msctls_trackbar32", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %TBS_AUTOTICKS OR %TBS_BOTTOM OR _
                    %TBS_TOOLTIPS, _
                     443, 57, 96, 32, _
                     hDlg, %IDC_TRACKBAR1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %TBM_SETRANGE , %TRUE, MAK(LONG, 0, 10)
        SendMessage hCtl, %TBM_SETTICFREQ, 1, 1  ' interval frequency
        SendMessage hCtl, %TBM_SETPOS, %TRUE, 10 ' position
      
        hCtl = CreateWindowEx(0, "STATIC", "Balance:", _
                    %WS_CHILD OR %WS_VISIBLE, _
                     395, 93, 45, 16, _
                     hDlg,  -1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "msctls_trackbar32", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %TBS_AUTOTICKS OR %TBS_BOTTOM OR _
                    %TBS_TOOLTIPS, _
                     443, 89, 96, 33, _
                     hDlg, %IDC_TRACKBAR2, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %TBM_SETRANGE , %TRUE, MAK(LONG, -10, 10)
        SendMessage hCtl, %TBM_SETTICFREQ, 5, 1  '
        SendMessage hCtl, %TBM_SETPOS, %TRUE, 0  ' balance center
      
        hCtl = CreateWindowEx(0, "STATIC", "Vibrato:", _
                    %WS_CHILD OR %WS_VISIBLE, _
                     395, 125, 45, 16, _
                     hDlg,  -1, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "msctls_trackbar32", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %TBS_AUTOTICKS OR %TBS_BOTTOM OR _
                    %TBS_TOOLTIPS, _
                     443, 122, 96, 32, _
                     hDlg, %IDC_TRACKBAR3, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %TBM_SETRANGE , %TRUE, MAK(LONG, 0, 10)
        SendMessage hCtl, %TBM_SETTICFREQ, 1, 1  ' interval frequency
        SendMessage hCtl, %TBM_SETPOS, %TRUE, 0  ' position
      
        hCtl = CreateWindowEx(0, "BUTTON", "Sustain ", _  ' CheckBox
                    %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_AUTOCHECKBOX, _
                     396, 156, 60, 16, _
                     hDlg, %IDC_CHECKBOX4, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        '------------------------------------------------------------------
        hCtl = CreateWindowEx(0, "BUTTON", "Pitch bend", _  ' Frame
                    %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, _
                     555, 3, 68, 176, _
                     hDlg, %IDC_FRAME4, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
      
        hCtl = CreateWindowEx(0, "msctls_trackbar32", BYVAL %NULL, _
                    %WS_CHILD OR %WS_VISIBLE OR %TBS_AUTOTICKS OR %TBS_VERT OR _
                    %TBS_RIGHT OR %TBS_BOTH, _
                     569, 20, 45, 152, _
                     hDlg, %IDC_TRACKBAR4, hInst, BYVAL %NULL)
        IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
        SendMessage hCtl, %TBM_SETRANGE , %TRUE, MAK(LONG, -64, 64)
        SendMessage hCtl, %TBM_SETTICFREQ, 10, 1  ' interval frequency
      
        '------------------------------------------------------------------
        ' If main window is created without %WS_VISIBLE style, it won't
        ' show until ShowWindow is called after all controls and settings
        ' to this point are done. Can help giving a more distinctive start.
        '------------------------------------------------------------------
        ShowWindow hDlg, nCmdShow
        UpdateWindow hDlg
      
        LOCAL Msg AS tagMsg
        WHILE GetMessage(Msg, %NULL, 0, 0)
            TranslateMessage Msg
            DispatchMessage Msg
        WEND
      
        FUNCTION = msg.wParam
      END FUNCTION
      
      
      '======================================================================
      FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, _
                        BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
      '----------------------------------------------------------------------
      ' Main Window procedure
      '----------------------------------------------------------------------
        LOCAL c, d AS LONG, sText AS STRING
        STATIC F1Help AS BYTE
        STATIC hPiano AS DWORD
        IF hPiano = 0 THEN hPiano = GetDlgItem(hWnd, %IDC_PIANO)
      
        SELECT CASE wMsg
        CASE %WM_GETDLGCODE ' Ensure the control processes all keys by itself
            FUNCTION = %DLGC_WANTALLKEYS
            EXIT FUNCTION
      
        CASE %WM_KEYDOWN, %WM_KEYUP  ' keyboard keys
            SendMessage hPiano, wMsg, wParam, lParam
            EXIT FUNCTION
      
        CASE %WM_COMMAND
            'Messages from controls and menu items are handled here.
            '-------------------------------------------------------
            SELECT CASE LOWRD(wParam)
            CASE %IDCANCEL
                IF HI(WORD, wParam) = %BN_CLICKED THEN
                    SendMessage hWnd, %WM_DESTROY, wParam, lParam
                    FUNCTION = 0 : EXIT FUNCTION
                END IF
      
            CASE %IDC_LABEL2  ' Arrow left < - octave change down
                IF HI(WORD, wParam) = %STN_CLICKED OR HI(WORD, wParam) = %STN_DBLCLK THEN
                    c = SendMessage(hPiano, %PM_GETOCTAVE, 0, 0)
                    d = SendMessage(hPiano, %PM_GETKEYCOUNT, 0, 0)
                    c = MAX&(0, c - 1)
                    SendMessage(hPiano, %PM_SETOCTAVE, c, 1)
                    sText = "Octave" + STR$(c) + " to" + _
                            STR$(c + d \ 12 - 1) + $CRLF + "(< or > to change)"
                    SetWindowText(GetDlgItem(hWnd, %IDC_LABEL1), BYVAL STRPTR(sText))
      
                END IF
      
            CASE %IDC_LABEL3
                IF HI(WORD, wParam) = %STN_CLICKED OR HI(WORD, wParam) = %STN_DBLCLK THEN
                    c = SendMessage(hPiano, %PM_GETOCTAVE, 0, 0)
                    d = SendMessage(hPiano, %PM_GETKEYCOUNT, 0, 0)
                    c = MIN&(11 - d \ 12, c + 1)
                    SendMessage(hPiano, %PM_SETOCTAVE, c, 1)
                    sText = "Octave" + STR$(c) + " to" + _
                            STR$(c + d \ 12 - 1) + $CRLF + "(< or > to change)"
                    SetWindowText(GetDlgItem(hWnd, %IDC_LABEL1), BYVAL STRPTR(sText))
                END IF
      
            CASE %IDC_CHECKBOX1  ' Topmost or not on screen
                IF HI(WORD, wParam) = %BN_CLICKED THEN
                    c = SendMessage(lParam, %BM_GETCHECK, 0, 0)
                    IF c THEN c = %HWND_TOPMOST ELSE c = %HWND_NOTOPMOST
                    SetWindowPos hWnd, c, 0, 0, 0, 0, %SWP_NOMOVE OR %SWP_NOSIZE
                    SetFocus hPiano
                END IF
      
            CASE %IDC_CHECKBOX2 ' Show key text?
                IF HI(WORD, wParam) = %BN_CLICKED THEN
                    c = SendMessage(lParam, %BM_GETCHECK, 0, 0)
                    SendMessage(hPiano, %PM_SETKEYTEXT, c, 1)
                END IF
      
            CASE %IDC_CHECKBOX3  ' Show note text?
                IF HI(WORD, wParam) = %BN_CLICKED THEN
                    c = SendMessage(lParam, %BM_GETCHECK, 0, 0)
                    SendMessage(hPiano, %PM_SETNOTETEXT, c, 1)
                END IF
      
            CASE %IDC_CHECKBOX4  ' Sustain on/off
                IF HI(WORD, wParam) = %BN_CLICKED THEN
                    c = SendMessage(lParam, %BM_GETCHECK, 0, 0)
                    SendMessage(hPiano, %PM_SETSUSTAIN, c, 1)
                END IF
      
            CASE %IDC_COMBOBOX1  ' device
                IF HI(WORD, wParam) = %CBN_SELCHANGE THEN
                    c = SendMessage(lParam, %CB_GETCURSEL, 0, 0)
                    SendMessage(hPiano, %PM_SETDEVICE, c, 0)
                ELSEIF HI(WORD, wParam) = %CBN_CLOSEUP THEN
                    SetFocus hPiano
                END IF
      
            CASE %IDC_COMBOBOX2  ' Channel
                IF HI(WORD, wParam) = %CBN_SELCHANGE THEN
                    c = SendMessage(lParam, %CB_GETCURSEL, 0, 0)
                    SendMessage(hPiano, %PM_SETCHANNEL, c, 0)
                ELSEIF HI(WORD, wParam) = %CBN_CLOSEUP THEN
                    SetFocus hPiano
                END IF
      
            CASE %IDC_COMBOBOX3  ' Patches
                IF HI(WORD, wParam) = %CBN_SELCHANGE THEN
                    c = SendMessage(lParam, %CB_GETCURSEL, 0, 0)
                    SendMessage(hPiano, %PM_LISTINSTRUMENTS, %IDC_LISTBOX1, c)
                    SendMessage(GetDlgItem(hWnd, %IDC_LISTBOX1), %LB_SETCURSEL, 0, 0)
                    c = SendMessage(GetDlgItem(hWnd, %IDC_LISTBOX1), %LB_GETITEMDATA, 0, 0)
                    SendMessage(hPiano, %PM_SETINSTRUMENT, c, 1)
                ELSEIF HI(WORD, wParam) = %CBN_CLOSEUP THEN
                    SetFocus hPiano
                END IF
      
      
            CASE %IDC_LISTBOX1  ' Instruments
               IF HI(WORD, wParam) = %LBN_SELCHANGE THEN
                   c = SendMessage(lParam, %LB_GETCURSEL, 0, 0)
                   c = SendMessage(lParam, %LB_GETITEMDATA, c, 0)
                   SendMessage(hPiano, %PM_SETINSTRUMENT, c, 1)
               END IF
      
            CASE %IDC_PIANO
                SELECT CASE HI(WORD, wParam)
                CASE %PN_PLAYNOTE   ' when a note is played, notification is sent here
      
                CASE %PN_STOPNOTE   ' when a note is stopped, notification is sent here
      
                CASE %PN_PITCHBEND  ' on up/down arrow key, pitch bend notification is sent here
                    SendMessage(GetDlgItem(hWnd, %IDC_TRACKBAR4), %TBM_SETPOS, %TRUE, lParam)
      
                CASE %PN_OCTAVE     ' on left/right arrow key, octave change notification is sent here
                    d = SendMessage(hPiano, %PM_GETKEYCOUNT, 0, 0)
                    sText = "Octave" + STR$(lParam) + " to" + _
                            STR$(lParam + d \ 12 - 1) + $CRLF + "(< or > to change)"
                    SetWindowText(GetDlgItem(hWnd, %IDC_LABEL1), BYVAL STRPTR(sText))
                END SELECT
      
            END SELECT
      
        CASE %WM_CTLCOLOREDIT, %WM_CTLCOLORLISTBOX
            SetBkColor wParam, GetSysColor(%COLOR_INFOBK)
            SetTextColor wParam, GetSysColor(%COLOR_INFOTEXT)
            FUNCTION = GetSysColorBrush(%COLOR_INFOBK)
            EXIT FUNCTION
      
        CASE %WM_CTLCOLORSTATIC  ' Simple stunt to avoid focus rect flashing in TrackBars
            SELECT CASE GetDlgCtrlID(lParam)
            CASE %IDC_TRACKBAR1 TO %IDC_TRACKBAR4
                SetFocus hPiano
            END SELECT
      
        CASE %WM_DESTROY
            ' is sent when program ends - a good place to delete any created objects and
            ' store settings in file for next run, etc. Must send PostQuitMessage to end
            ' properly in SDK-style dialogs. The PostQuitMessage function sends a WM_QUIT
            ' message to the program's (thread's) message queue, and then WM_QUIT causes
            ' the GetMessage function to return zero in WINMAIN's message loop.
            '----------------------------------------------------------------------------
            PostQuitMessage 0
            FUNCTION = 0 : EXIT FUNCTION
      
      
        CASE %WM_HSCROLL ' Horizontal trackbar scrollpos change
            IF lParam = GetDlgItem(hWnd, %IDC_TRACKBAR1) THEN  ' Volume
                IF LO(WORD, wParam) = %TB_THUMBTRACK THEN      ' get trackbar pos
                    c = SendMessage(lParam, %TBM_GETPOS, c, 0)
                    SendMessage(hPiano, %PM_SETVOLUME, MIN&(127, c * 13), 1)
                END IF
      
            ELSEIF lParam = GetDlgItem(hWnd, %IDC_TRACKBAR2) THEN ' Balance
                IF LO(WORD, wParam) = %TB_THUMBTRACK THEN         ' get trackbar pos
                    c = SendMessage(lParam, %TBM_GETPOS, c, 0)
                    SendMessage(hPiano, %PM_SETBALANCE, MIN&(127, c * 6.4 + 64), 1)
                END IF
      
            ELSEIF lParam = GetDlgItem(hWnd, %IDC_TRACKBAR3) THEN ' Modulation (Vibrato)
                IF LO(WORD, wParam) = %TB_THUMBTRACK THEN         ' get trackbar pos
                    c = SendMessage(lParam, %TBM_GETPOS, c, 0)
                    SendMessage(hPiano, %PM_SETVIBRATO, MIN&(127, c * 13), 1)
                END IF
            END IF
      
        CASE %WM_VSCROLL 'Pitch bend - Vertical trackbar scrollpos change
            IF lParam = GetDlgItem(hWnd, %IDC_TRACKBAR4) THEN ' Pitch Bend
                SELECT CASE LO(WORD, wParam)
                CASE %TB_THUMBTRACK ' get trackbar pos and set pitch
                    c = SendMessage(lParam, %TBM_GETPOS, c, 0)
                    SendMessage(hPiano, %PM_SETPITCH, 64 - c, 1)
      
                CASE %TB_ENDTRACK   ' reset trackbar (middle) pos and pitch
                    c = SendMessage(lParam, %TBM_SETPOS, %TRUE, 0)
                    SendMessage(hPiano, %PM_SETPITCH, 64, 1)
                END SELECT
            END IF
      
        CASE %WM_HELP
            IF F1Help = 0 THEN  ' need a static prevention flag there, else
                F1Help = 1      ' pressing F1 again produces a new messagebox
                sText = "PBPiano accepts both computer keyboard and/or mouse play." + $CRLF + $CRLF + _
                        " Options:" + $CRLF + _
                        "   ComboBox 1 shows available midi devices (usually 1)."  + $CRLF + _
                        "   ComboBox 2 shows a collection of 16 midi channels,"    + $CRLF + _
                        "   but we usually only use channel 1 for normal play."    + $CRLF + _
                        "   Note: Channel 10 is reserved for percussion sets,"     + $CRLF + _
                        "   turning each key from D2# to D7# into an instrument."  + $CRLF + $CRLF + _
                        "   Always on top - program stays topmost on screen."  + $CRLF + _
                        "   Show Key text - show/hide computer keyboard key text."  + $CRLF + _
                        "   Show Note text - show/hide piano key notes."  + $CRLF + $CRLF + _
                        " Effects:" + $CRLF + _
                        "   Arrow left - decrease octave"  + $CRLF + _
                        "   Arrow right - increase octave" + $CRLF + _
                        "   Arrow up - pitch bend up"      + $CRLF + _
                        "   Arrow down - pitch bend down"  + $CRLF + $CRLF + _
                        "   Sustain on/off, for sustain (reverb) on played keys."      + $CRLF + _
                        "   Sustain can cause eternal notes to for example string and" + $CRLF + _
                        "   brass instruments and should therefore be used with care." + $CRLF + _
                        "   If eternal notes occur, just uncheck this checkbox."       + $CRLF + _
                        "   On octave change, pressed notes are repeated for a"        + $CRLF + _
                        "   nice replay effect." + $CRLF + _
                        "   Mouse controls Volume, Balance, Vibrato and Pitch bend."
                MessageBox (hWnd, BYVAL STRPTR(sText), "Information", %MB_OK OR %MB_ICONINFORMATION)
                F1Help = 0
            END IF
      
        END SELECT
      
        FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
      END FUNCTION
      Attached Files

      Comment

      Working...
      X