home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / piano / form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-10-22  |  15.0 KB  |  517 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H8000000B&
  4.    Caption         =   "Leifens Midi Piano"
  5.    ClientHeight    =   2775
  6.    ClientLeft      =   3210
  7.    ClientTop       =   735
  8.    ClientWidth     =   5175
  9.    KeyPreview      =   -1  'True
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2775
  12.    ScaleWidth      =   5175
  13.    Begin VB.VScrollBar vol 
  14.       Height          =   1815
  15.       Left            =   0
  16.       TabIndex        =   17
  17.       Top             =   360
  18.       Width           =   255
  19.    End
  20.    Begin VB.CheckBox key 
  21.       BackColor       =   &H80000007&
  22.       Caption         =   ";"
  23.       ForeColor       =   &H8000000E&
  24.       Height          =   1335
  25.       Index           =   15
  26.       Left            =   4560
  27.       Style           =   1  'Graphical
  28.       TabIndex        =   16
  29.       Top             =   0
  30.       Width           =   255
  31.    End
  32.    Begin VB.CheckBox key 
  33.       BackColor       =   &H80000007&
  34.       Caption         =   "L"
  35.       ForeColor       =   &H8000000E&
  36.       Height          =   1335
  37.       Index           =   13
  38.       Left            =   4080
  39.       Style           =   1  'Graphical
  40.       TabIndex        =   15
  41.       Top             =   0
  42.       Width           =   255
  43.    End
  44.    Begin VB.CheckBox key 
  45.       BackColor       =   &H80000007&
  46.       Caption         =   "J"
  47.       ForeColor       =   &H8000000E&
  48.       Height          =   1335
  49.       Index           =   10
  50.       Left            =   3120
  51.       Style           =   1  'Graphical
  52.       TabIndex        =   14
  53.       Top             =   0
  54.       Width           =   255
  55.    End
  56.    Begin VB.CheckBox key 
  57.       BackColor       =   &H80000007&
  58.       Caption         =   "H"
  59.       ForeColor       =   &H8000000E&
  60.       Height          =   1335
  61.       Index           =   8
  62.       Left            =   2640
  63.       Style           =   1  'Graphical
  64.       TabIndex        =   13
  65.       Top             =   0
  66.       Width           =   255
  67.    End
  68.    Begin VB.CheckBox key 
  69.       BackColor       =   &H80000007&
  70.       Caption         =   "G"
  71.       ForeColor       =   &H8000000E&
  72.       Height          =   1335
  73.       Index           =   6
  74.       Left            =   2160
  75.       Style           =   1  'Graphical
  76.       TabIndex        =   12
  77.       Top             =   0
  78.       Width           =   255
  79.    End
  80.    Begin VB.CheckBox key 
  81.       BackColor       =   &H80000007&
  82.       Caption         =   "D"
  83.       ForeColor       =   &H8000000E&
  84.       Height          =   1335
  85.       Index           =   3
  86.       Left            =   1200
  87.       Style           =   1  'Graphical
  88.       TabIndex        =   11
  89.       Top             =   0
  90.       Width           =   255
  91.    End
  92.    Begin VB.CheckBox key 
  93.       BackColor       =   &H80000007&
  94.       Caption         =   "S"
  95.       ForeColor       =   &H8000000E&
  96.       Height          =   1335
  97.       Index           =   1
  98.       Left            =   720
  99.       Style           =   1  'Graphical
  100.       TabIndex        =   10
  101.       Top             =   0
  102.       Width           =   255
  103.    End
  104.    Begin VB.CheckBox key 
  105.       BackColor       =   &H80000009&
  106.       Caption         =   "/"
  107.       Height          =   2175
  108.       Index           =   16
  109.       Left            =   4680
  110.       Style           =   1  'Graphical
  111.       TabIndex        =   9
  112.       Top             =   0
  113.       Width           =   495
  114.    End
  115.    Begin VB.CheckBox key 
  116.       BackColor       =   &H80000009&
  117.       Caption         =   "."
  118.       Height          =   2175
  119.       Index           =   14
  120.       Left            =   4200
  121.       Style           =   1  'Graphical
  122.       TabIndex        =   8
  123.       Top             =   0
  124.       Width           =   495
  125.    End
  126.    Begin VB.CheckBox key 
  127.       BackColor       =   &H80000009&
  128.       Caption         =   ","
  129.       Height          =   2175
  130.       Index           =   12
  131.       Left            =   3720
  132.       Style           =   1  'Graphical
  133.       TabIndex        =   7
  134.       Top             =   0
  135.       Width           =   495
  136.    End
  137.    Begin VB.CheckBox key 
  138.       BackColor       =   &H80000009&
  139.       Caption         =   "M"
  140.       Height          =   2175
  141.       Index           =   11
  142.       Left            =   3240
  143.       Style           =   1  'Graphical
  144.       TabIndex        =   6
  145.       Top             =   0
  146.       Width           =   495
  147.    End
  148.    Begin VB.CheckBox key 
  149.       BackColor       =   &H80000009&
  150.       Caption         =   "N"
  151.       Height          =   2175
  152.       Index           =   9
  153.       Left            =   2760
  154.       Style           =   1  'Graphical
  155.       TabIndex        =   5
  156.       Top             =   0
  157.       Width           =   495
  158.    End
  159.    Begin VB.CheckBox key 
  160.       BackColor       =   &H80000009&
  161.       Caption         =   "B"
  162.       Height          =   2175
  163.       Index           =   7
  164.       Left            =   2280
  165.       Style           =   1  'Graphical
  166.       TabIndex        =   4
  167.       Top             =   0
  168.       Width           =   495
  169.    End
  170.    Begin VB.CheckBox key 
  171.       BackColor       =   &H80000009&
  172.       Caption         =   "V"
  173.       Height          =   2175
  174.       Index           =   5
  175.       Left            =   1800
  176.       Style           =   1  'Graphical
  177.       TabIndex        =   3
  178.       Top             =   0
  179.       Width           =   495
  180.    End
  181.    Begin VB.CheckBox key 
  182.       BackColor       =   &H80000009&
  183.       Caption         =   "C"
  184.       Height          =   2175
  185.       Index           =   4
  186.       Left            =   1320
  187.       Style           =   1  'Graphical
  188.       TabIndex        =   2
  189.       Top             =   0
  190.       Width           =   495
  191.    End
  192.    Begin VB.CheckBox key 
  193.       BackColor       =   &H80000009&
  194.       Caption         =   "X"
  195.       Height          =   2175
  196.       Index           =   2
  197.       Left            =   840
  198.       Style           =   1  'Graphical
  199.       TabIndex        =   1
  200.       Top             =   0
  201.       Width           =   495
  202.    End
  203.    Begin VB.CheckBox key 
  204.       BackColor       =   &H80000009&
  205.       Caption         =   "Z"
  206.       Height          =   2175
  207.       Index           =   0
  208.       Left            =   360
  209.       Style           =   1  'Graphical
  210.       TabIndex        =   0
  211.       Top             =   0
  212.       Width           =   495
  213.    End
  214.    Begin VB.Label Label1 
  215.       Caption         =   "vol"
  216.       Height          =   255
  217.       Left            =   0
  218.       TabIndex        =   18
  219.       Top             =   120
  220.       Width           =   255
  221.    End
  222.    Begin VB.Menu midi_devices 
  223.       Caption         =   "Midi Device"
  224.       Begin VB.Menu device 
  225.          Caption         =   ""
  226.          Index           =   0
  227.       End
  228.       Begin VB.Menu device 
  229.          Caption         =   ""
  230.          Enabled         =   0   'False
  231.          Index           =   1
  232.          Visible         =   0   'False
  233.       End
  234.       Begin VB.Menu device 
  235.          Caption         =   ""
  236.          Enabled         =   0   'False
  237.          Index           =   2
  238.          Visible         =   0   'False
  239.       End
  240.       Begin VB.Menu device 
  241.          Caption         =   ""
  242.          Enabled         =   0   'False
  243.          Index           =   3
  244.          Visible         =   0   'False
  245.       End
  246.       Begin VB.Menu device 
  247.          Caption         =   ""
  248.          Enabled         =   0   'False
  249.          Index           =   4
  250.          Visible         =   0   'False
  251.       End
  252.       Begin VB.Menu device 
  253.          Caption         =   ""
  254.          Enabled         =   0   'False
  255.          Index           =   5
  256.          Visible         =   0   'False
  257.       End
  258.       Begin VB.Menu device 
  259.          Caption         =   ""
  260.          Enabled         =   0   'False
  261.          Index           =   6
  262.          Visible         =   0   'False
  263.       End
  264.       Begin VB.Menu device 
  265.          Caption         =   ""
  266.          Enabled         =   0   'False
  267.          Index           =   7
  268.          Visible         =   0   'False
  269.       End
  270.       Begin VB.Menu device 
  271.          Caption         =   ""
  272.          Enabled         =   0   'False
  273.          Index           =   8
  274.          Visible         =   0   'False
  275.       End
  276.       Begin VB.Menu device 
  277.          Caption         =   ""
  278.          Enabled         =   0   'False
  279.          Index           =   9
  280.          Visible         =   0   'False
  281.       End
  282.       Begin VB.Menu device 
  283.          Caption         =   ""
  284.          Enabled         =   0   'False
  285.          Index           =   10
  286.          Visible         =   0   'False
  287.       End
  288.    End
  289.    Begin VB.Menu ChannelOption 
  290.       Caption         =   "Channel"
  291.       Begin VB.Menu chan 
  292.          Caption         =   "1"
  293.          Index           =   0
  294.       End
  295.       Begin VB.Menu chan 
  296.          Caption         =   "2"
  297.          Index           =   1
  298.       End
  299.       Begin VB.Menu chan 
  300.          Caption         =   "3"
  301.          Index           =   2
  302.       End
  303.       Begin VB.Menu chan 
  304.          Caption         =   "4"
  305.          Index           =   3
  306.       End
  307.       Begin VB.Menu chan 
  308.          Caption         =   "5"
  309.          Index           =   4
  310.       End
  311.       Begin VB.Menu chan 
  312.          Caption         =   "6"
  313.          Index           =   5
  314.       End
  315.       Begin VB.Menu chan 
  316.          Caption         =   "7"
  317.          Index           =   6
  318.       End
  319.       Begin VB.Menu chan 
  320.          Caption         =   "8"
  321.          Index           =   7
  322.       End
  323.       Begin VB.Menu chan 
  324.          Caption         =   "9"
  325.          Index           =   8
  326.       End
  327.       Begin VB.Menu chan 
  328.          Caption         =   "10"
  329.          Index           =   9
  330.       End
  331.       Begin VB.Menu chan 
  332.          Caption         =   "11"
  333.          Index           =   10
  334.       End
  335.       Begin VB.Menu chan 
  336.          Caption         =   "12"
  337.          Index           =   11
  338.       End
  339.       Begin VB.Menu chan 
  340.          Caption         =   "13"
  341.          Index           =   12
  342.       End
  343.       Begin VB.Menu chan 
  344.          Caption         =   "14"
  345.          Index           =   13
  346.       End
  347.       Begin VB.Menu chan 
  348.          Caption         =   "15"
  349.          Index           =   14
  350.       End
  351.       Begin VB.Menu chan 
  352.          Caption         =   "16"
  353.          Index           =   15
  354.       End
  355.    End
  356.    Begin VB.Menu base 
  357.       Caption         =   "Base note"
  358.    End
  359. Attribute VB_Name = "Form1"
  360. Attribute VB_GlobalNameSpace = False
  361. Attribute VB_Creatable = False
  362. Attribute VB_PredeclaredId = True
  363. Attribute VB_Exposed = False
  364. Option Explicit
  365. Const INVALID_NOTE = -1     ' Code for keyboard keys that we don't handle
  366. Dim numDevices As Long      ' number of midi output devices
  367. Dim curDevice As Long       ' current midi device
  368. Dim hmidi As Long           ' midi output handle
  369. Dim rc As Long              ' return code
  370. Dim midimsg As Long         ' midi output message buffer
  371. Dim channel As Integer      ' midi output channel
  372. Dim volume As Integer       ' midi volume
  373. Dim baseNote As Integer     ' the first note on our "piano"
  374. ' Set the value for the starting note of the piano
  375. Private Sub base_Click()
  376.    Dim s As String
  377.    Dim i As Integer
  378.    s = InputBox("Enter the new base note for the keyboard (0 - 111)", "Base note", CStr(baseNote))
  379.    If IsNumeric(s) Then
  380.       i = CInt(s)
  381.       If (i >= 0 And i < 112) Then
  382.          baseNote = i
  383.       End If
  384.    End If
  385. End Sub
  386. ' Select the midi output channel
  387. Private Sub chan_Click(Index As Integer)
  388.    chan(channel).Checked = False
  389.    channel = Index
  390.    chan(channel).Checked = True
  391. End Sub
  392. ' Open the midi device selected in the menu. The menu index equals the
  393. ' midi device number + 1.
  394. Private Sub device_Click(Index As Integer)
  395.    device(curDevice + 1).Checked = False
  396.    device(Index).Checked = True
  397.    curDevice = Index - 1
  398.    rc = midiOutClose(hmidi)
  399.    rc = midiOutOpen(hmidi, curDevice, 0, 0, 0)
  400.    If (rc <> 0) Then
  401.       MsgBox "Couldn't open midi out, rc = " & rc
  402.    End If
  403. End Sub
  404. ' If user presses a keyboard key, start the corresponding midi note
  405. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  406.    StartNote NoteFromKey(KeyCode)
  407. End Sub
  408. ' If user lifts a keyboard key, stop the corresponding midi note
  409. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  410.    StopNote NoteFromKey(KeyCode)
  411. End Sub
  412. Private Sub Form_Load()
  413.    Dim i As Long
  414.    Dim caps As MIDIOUTCAPS
  415.    ' Set the first device as midi mapper
  416.    device(0).Caption = "MIDI Mapper"
  417.    device(0).Visible = True
  418.    device(0).Enabled = True
  419.    ' Get the rest of the midi devices
  420.    numDevices = midiOutGetNumDevs()
  421.    For i = 0 To (numDevices - 1)
  422.       midiOutGetDevCaps i, caps, Len(caps)
  423.       device(i + 1).Caption = caps.szPname
  424.       device(i + 1).Visible = True
  425.       device(i + 1).Enabled = True
  426.    Next
  427.    ' Select the MIDI Mapper as the default device
  428.    device_Click (0)
  429.    ' Set the default channel
  430.    channel = 0
  431.    chan(channel).Checked = True
  432.    ' Set the base note
  433.    baseNote = 60
  434.    ' Set volume range
  435.    volume = 127
  436.    vol.Min = 127
  437.    vol.Max = 0
  438.    vol.Value = volume
  439. End Sub
  440. Private Sub Form_Unload(Cancel As Integer)
  441.    ' Close current midi device
  442.    rc = midiOutClose(hmidi)
  443. End Sub
  444. ' Start a note when user click on it
  445. Private Sub key_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  446.    StartNote (Index)
  447. End Sub
  448. ' Stop the note when user lifts the mouse button
  449. Private Sub key_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  450.    StopNote (Index)
  451. End Sub
  452. ' Press the button and send midi start event
  453. Private Sub StartNote(Index As Integer)
  454.    If (Index = INVALID_NOTE) Then
  455.       Exit Sub
  456.    End If
  457.    If (key(Index).Value = 1) Then
  458.       Exit Sub
  459.    End If
  460.    key(Index).Value = 1
  461.    midimsg = &H90 + ((baseNote + Index) * &H100) + (volume * &H10000) + channel
  462.    midiOutShortMsg hmidi, midimsg
  463. End Sub
  464. ' Raise the button and send midi stop event
  465. Private Sub StopNote(Index As Integer)
  466.    If (Index = INVALID_NOTE) Then
  467.       Exit Sub
  468.    End If
  469.    key(Index).Value = 0
  470.    midimsg = &H80 + ((baseNote + Index) * &H100) + channel
  471.    midiOutShortMsg hmidi, midimsg
  472. End Sub
  473. ' Get the note corresponding to a keyboard key
  474. Private Function NoteFromKey(key As Integer)
  475.    NoteFromKey = INVALID_NOTE
  476.    Select Case key
  477.    Case vbKeyZ
  478.       NoteFromKey = 0
  479.    Case vbKeyS
  480.       NoteFromKey = 1
  481.    Case vbKeyX
  482.       NoteFromKey = 2
  483.    Case vbKeyD
  484.       NoteFromKey = 3
  485.    Case vbKeyC
  486.       NoteFromKey = 4
  487.    Case vbKeyV
  488.       NoteFromKey = 5
  489.    Case vbKeyG
  490.       NoteFromKey = 6
  491.    Case vbKeyB
  492.       NoteFromKey = 7
  493.    Case vbKeyH
  494.       NoteFromKey = 8
  495.    Case vbKeyN
  496.       NoteFromKey = 9
  497.    Case vbKeyJ
  498.       NoteFromKey = 10
  499.    Case vbKeyM
  500.       NoteFromKey = 11
  501.    Case 188 ' comma
  502.       NoteFromKey = 12
  503.    Case vbKeyL
  504.       NoteFromKey = 13
  505.    Case 190 ' period
  506.       NoteFromKey = 14
  507.    Case 186 ' semicolon
  508.       NoteFromKey = 15
  509.    Case 191 ' forward slash
  510.       NoteFromKey = 16
  511.    End Select
  512. End Function
  513. ' Set the volume
  514. Private Sub vol_Change()
  515.    volume = vol.Value
  516. End Sub
  517.