Mundo do CD-ROM 16/CDROM16.iso/nando/MUSICA/PIANO2.TMP

Visual Basic Form | 1994-05-30 | 15.5 KB | 434 lines

VERSION 2.00
Begin Form Piano
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Piano"
   ClientHeight    =   2388
   ClientLeft      =   684
   ClientTop       =   1680
   ClientWidth     =   9516
   ClipControls    =   0   'False
   Height          =   3132
   Icon            =   PIANO2.FRX:0000
   Left            =   636
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2388
   ScaleWidth      =   9516
   Top             =   984
   Width           =   9612
   Begin SSPanel Panel3D3
      Alignment       =   6  'Center - TOP
      AutoSize        =   3  'AutoSize Child To Panel
      BackColor       =   &H00C0C0C0&
      BevelWidth      =   3
      BorderWidth     =   0
      Font3D          =   3  'Inset w/light shading
      ForeColor       =   &H00808080&
      Height          =   975
      Left            =   90
      Outline         =   -1  'True
      TabIndex        =   20
      Top             =   1290
      Width           =   9315
   Begin SSFrame SSFrame4
      Alignment       =   2  'Center
      Caption         =   "Piano Settings"
      Font3D          =   3  'Inset w/light shading
      ForeColor       =   &H00000000&
      Height          =   1245
      Left            =   0
      ShadowColor     =   1  'Black
      ShadowStyle     =   1  'Raised
      TabIndex        =   0
      Top             =   0
      Width           =   9585
      Begin SSPanel SSPanel6
         Alignment       =   6  'Center - TOP
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BorderWidth     =   2
         Caption         =   "SSPanel6"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00808080&
         Height          =   375
         Left            =   2070
         TabIndex        =   18
         Top             =   720
         Width           =   1695
         Begin HScrollBar HScrollVolume
            Height          =   276
            LargeChange     =   10
            Left            =   48
            Max             =   127
            TabIndex        =   19
            Top             =   48
            Value           =   50
            Width           =   1596
         End
      End
      Begin SSPanel SSPanel5
         Alignment       =   6  'Center - TOP
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BorderWidth     =   1
         Caption         =   "SSPanel5"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00808080&
         Height          =   375
         Left            =   5520
         TabIndex        =   16
         Top             =   720
         Width           =   2415
         Begin HScrollBar HScrollPatch
            Height          =   300
            LargeChange     =   10
            Left            =   36
            Max             =   127
            TabIndex        =   17
            Top             =   36
            Value           =   1
            Width           =   2340
         End
      End
      Begin SSPanel SSPanel2
         Alignment       =   6  'Center - TOP
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BorderWidth     =   1
         Caption         =   "SSPanel2"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00808080&
         Height          =   375
         Left            =   180
         TabIndex        =   14
         Top             =   720
         Width           =   1680
         Begin HScrollBar HScrollMIDIChannel
            Height          =   300
            LargeChange     =   2
            Left            =   36
            Max             =   15
            TabIndex        =   15
            Top             =   36
            Value           =   1
            Width           =   1608
         End
      End
      Begin SSPanel VolumeLabel
         Alignment       =   4  'Right Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "100"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   228
         Left            =   3348
         TabIndex        =   13
         Top             =   396
         Width           =   372
      End
      Begin SSPanel MidiChannelOutLabel
         Alignment       =   4  'Right Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "1"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   225
         Left            =   1575
         TabIndex        =   12
         Top             =   390
         Width           =   300
      End
      Begin SSPanel SSPanel10
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "L -  Pan  - R"
         FloodShowPct    =   0   'False
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   8100
         TabIndex        =   11
         Top             =   300
         Width           =   1185
      End
      Begin SSPanel SSPanel9
         Alignment       =   1  'Left Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "Volume"
         FloodShowPct    =   0   'False
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   375
         Index           =   0
         Left            =   2070
         TabIndex        =   10
         Top             =   300
         Width           =   1230
      End
      Begin SSPanel PatchLabel
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "Electric Piano 2 "
         Font3D          =   3  'Inset w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Small Fonts"
         FontSize        =   6
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   6150
         TabIndex        =   9
         Top             =   300
         Width           =   1785
      End
      Begin SSPanel SSPanel8
         Alignment       =   1  'Left Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "Patch"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   5535
         TabIndex        =   8
         Top             =   300
         Width           =   615
      End
      Begin SSPanel SSPanel7
         Alignment       =   1  'Left Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "MIDI Channel "
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   180
         TabIndex        =   7
         Top             =   300
         Width           =   1275
      End
      Begin SSPanel Panel3D1
         Alignment       =   6  'Center - TOP
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BorderWidth     =   2
         Caption         =   "SSPanel6"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00808080&
         Height          =   375
         Left            =   8100
         TabIndex        =   5
         Top             =   720
         Width           =   1215
         Begin HScrollBar HScrollPan
            Height          =   276
            LargeChange     =   10
            Left            =   48
            Max             =   127
            TabIndex        =   6
            Top             =   48
            Width           =   1116
         End
      End
      Begin SSPanel Panel3D2
         Alignment       =   6  'Center - TOP
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BorderWidth     =   2
         Caption         =   "SSPanel6"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00808080&
         Height          =   375
         Left            =   4050
         TabIndex        =   3
         Top             =   720
         Width           =   1200
         Begin HScrollBar HScrollOctave
            Height          =   276
            LargeChange     =   10
            Left            =   48
            Max             =   4
            TabIndex        =   4
            Top             =   48
            Value           =   2
            Width           =   1104
         End
      End
      Begin SSPanel SSPanel9
         Alignment       =   1  'Left Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelInner      =   2  'Raised
         BevelOuter      =   1  'Inset
         BorderWidth     =   0
         Caption         =   "Octave"
         FloodShowPct    =   0   'False
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   375
         Index           =   1
         Left            =   4050
         TabIndex        =   2
         Top             =   300
         Width           =   735
      End
      Begin SSPanel LabelOctave
         Alignment       =   4  'Right Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   0  'None
         BorderWidth     =   1
         Caption         =   "1"
         Font3D          =   3  'Inset w/light shading
         ForeColor       =   &H00000000&
         Height          =   225
         Left            =   4950
         TabIndex        =   1
         Top             =   390
         Width           =   300
      End
   End
   Begin Menu File
      Caption         =   "&File"
      Begin Menu Exit
         Caption         =   "E&xit"
      End
   End
   Begin Menu help
      Caption         =   "&Help"
      Begin Menu About
         Caption         =   "&About"
      End
   End
Dim NoteCatchCount As Integer
Dim NoteOnCatcher(1024) As Integer
Sub About_Click ()
    AboutBox1.Show Modal
End Sub
Sub Exit_Click ()
    X% = MidiOutClose(hmidioutcopy)
    End
End Sub
Sub Form_Load ()
    Screen.MousePointer = 11
    Piano.Left = 0
    Piano.Top = 0
    ' Open Midi Driver
    MidiOutOpenPort
    HScrollMIDIChannel.Value = 13
    HScrollPatch.Value = 0
    HScrollVolume.Value = 100
    HScrollPan.Value = 64
    HScrollOctave.Value = 2
    Screen.MousePointer = 0
End Sub
Sub Form_Unload (Cancel As Integer)
    X% = MidiOutClose(hmidioutcopy)
End Sub
Sub HScrollMIDIChannel_Change ()
    ' Change Midi Channel to Vscroll1 value
    MidiChannelOut = HScrollMIDIChannel.Value
    ' Display new channel
    MidiChannelOutLabel.Caption = Str$(MidiChannelOut + 1)
    ' Sets the Patch & Volume for the current Midi Channel Out
    HScrollPatch.Value = MidiPatch(MidiChannelOut)
    HScrollVolume.Value = MidiVolume(MidiChannelOut)
    HScrollPan.Value = MidiPan(MidiChannelOut)
    HScrollOctave.Value = Octave(MidiChannelOut) / 12
End Sub
Sub HScrollOctave_Change ()
    LabelOctave.Caption = Str$(HScrollOctave.Value)
    Octave(MidiChannelOut) = (HScrollOctave.Value * 12)
End Sub
Sub HScrollPan_Change ()
    MidiPan(MidiChannelOut) = HScrollPan.Value
    ' 05-16-92 Pan Midi Out routine
    MidiEventOut = 176 + MidiChannelOut
    MidiNoteOut = 10
    MidiVelOut = MidiPan(MidiChannelOut)
    SendMidiOut
End Sub
Sub HScrollPatch_Change ()
    ' Sets the Patch for the current Midi Channel Out
    MidiPatch(MidiChannelOut) = HScrollPatch.Value
    ReadPatch
    ' 05-15-92 Patch Midi Out routine
    MidiEventOut = &HC0 + MidiChannelOut
    MidiNoteOut = MidiPatch(MidiChannelOut)
    MidiVelOut = 0
    SendMidiOut
End Sub
Sub HScrollVolume_Change ()
    MidiVelocity = HScrollVolume.Value
    MidiVolume(MidiChannelOut) = HScrollVolume.Value
    VolumeLabel.Caption = Str$(MidiVelocity)
End Sub
Sub PanelWhite_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
    For nn = 0 To NoteCatchCount - 1
        MidiEventOut = 144 + MidiChannelOut
        MidiVelOut = 0
        MidiNoteOut = NoteOnCatcher(nn)
        SendMidiOut
        NoteMOD = (NoteOnCatcher(nn) - Octave(MidiChannelOut)) Mod 12
        If NoteMOD = 0 Or NoteMOD = 2 Or NoteMOD = 4 Or NoteMOD = 5 Or NoteMOD = 7 Or NoteMOD = 9 Or NoteMOD = 11 Then
            Piano.PanelWhite(NoteOnCatcher(nn) - Octave(MidiChannelOut)).BevelOuter = 2
        Else
            Piano.PanelWhite(NoteOnCatcher(nn) - Octave(MidiChannelOut)).BevelOuter = 2
        End If
    Next nn
    NoteCatchCount = 0
End Sub
Sub PanelWhite_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, State As Integer)
    'If still on same note, discard
    If NoteCatchCount > 0 Then
       If NoteOnCatcher(NoteCatchCount - 1) = Index + Octave(MidiChannelOut) Then
            Exit Sub
       End If
    End If
    NoteMOD = (Index) Mod 12
    If NoteMOD = 0 Or NoteMOD = 2 Or NoteMOD = 4 Or NoteMOD = 5 Or NoteMOD = 7 Or NoteMOD = 9 Or NoteMOD = 11 Then
        Piano.PanelWhite(Index).BevelOuter = 0
    Else
        Piano.PanelWhite(Index).BevelOuter = 0
    End If
    MidiEventOut = 144 + MidiChannelOut
    MidiVelOut = MidiVelocity
    MidiNoteOut = Index + Octave(MidiChannelOut)
    SendMidiOut
    'Since drag/drop is being used, we must keep track of the note being played.
    NoteOnCatcher(NoteCatchCount) = MidiNoteOut
    If NoteCatchCount < 750 Then 'Don't let array get out of range
        NoteCatchCount = NoteCatchCount + 1
    End If
End Sub