📄 piano2.frm
字号:
BevelInner = 1
Font3D = 3
Alignment = 6
Autosize = 3
Begin VB.HScrollBar HScrollMIDIChannel
Height = 285
Left = 45
Max = 15
TabIndex = 15
Top = 45
Value = 1
Width = 1590
End
End
Begin Threed.SSPanel VolumeLabel
Height = 225
Left = 3345
TabIndex = 13
Top = 390
Width = 375
_Version = 65536
_ExtentX = 661
_ExtentY = 397
_StockProps = 15
Caption = "100"
ForeColor = 0
BorderWidth = 1
BevelOuter = 0
Font3D = 3
Alignment = 4
Autosize = 3
End
Begin Threed.SSPanel MidiChannelOutLabel
Height = 225
Left = 1575
TabIndex = 12
Top = 390
Width = 300
_Version = 65536
_ExtentX = 529
_ExtentY = 397
_StockProps = 15
Caption = "1"
ForeColor = 0
BorderWidth = 1
BevelOuter = 0
Font3D = 3
Alignment = 4
Autosize = 3
End
Begin Threed.SSPanel SSPanel10
Height = 375
Left = 8100
TabIndex = 11
Top = 300
Width = 1185
_Version = 65536
_ExtentX = 2090
_ExtentY = 661
_StockProps = 15
Caption = "L - Pan - R"
ForeColor = 0
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
FloodShowPct = 0 'False
Font3D = 3
Autosize = 3
End
Begin Threed.SSPanel SSPanel9
Height = 375
Index = 0
Left = 2070
TabIndex = 10
Top = 300
Width = 1230
_Version = 65536
_ExtentX = 2170
_ExtentY = 661
_StockProps = 15
Caption = "Volume"
ForeColor = 0
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
FloodShowPct = 0 'False
Font3D = 3
Alignment = 1
Autosize = 3
End
Begin Threed.SSPanel PatchLabel
Height = 375
Left = 6150
TabIndex = 9
Top = 300
Width = 1785
_Version = 65536
_ExtentX = 3149
_ExtentY = 661
_StockProps = 15
Caption = "Electric Piano 2 "
ForeColor = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
name = "Small Fonts"
charset = 0
weight = 700
size = 6
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
Font3D = 3
Autosize = 3
End
Begin Threed.SSPanel SSPanel8
Height = 375
Left = 5535
TabIndex = 8
Top = 300
Width = 615
_Version = 65536
_ExtentX = 1085
_ExtentY = 661
_StockProps = 15
Caption = "Patch"
ForeColor = 0
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
Font3D = 3
Alignment = 1
Autosize = 3
End
Begin Threed.SSPanel SSPanel7
Height = 375
Left = 180
TabIndex = 7
Top = 300
Width = 1275
_Version = 65536
_ExtentX = 2249
_ExtentY = 661
_StockProps = 15
Caption = "MIDI Channel "
ForeColor = 0
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
Font3D = 3
Alignment = 1
Autosize = 3
End
Begin Threed.SSPanel Panel3D1
Height = 375
Left = 8100
TabIndex = 5
Top = 720
Width = 1215
_Version = 65536
_ExtentX = 2143
_ExtentY = 661
_StockProps = 15
Caption = "SSPanel6"
ForeColor = 8421504
BorderWidth = 2
BevelInner = 1
Font3D = 3
Alignment = 6
Autosize = 3
Begin VB.HScrollBar HScrollPan
Height = 255
LargeChange = 10
Left = 60
Max = 127
TabIndex = 6
Top = 60
Width = 1095
End
End
Begin Threed.SSPanel Panel3D2
Height = 375
Left = 4050
TabIndex = 3
Top = 720
Width = 1200
_Version = 65536
_ExtentX = 2117
_ExtentY = 661
_StockProps = 15
Caption = "SSPanel6"
ForeColor = 8421504
BorderWidth = 2
BevelInner = 1
Font3D = 3
Alignment = 6
Autosize = 3
Begin VB.HScrollBar HScrollOctave
Height = 255
Left = 60
Max = 4
TabIndex = 4
Top = 60
Value = 2
Width = 1080
End
End
Begin Threed.SSPanel SSPanel9
Height = 375
Index = 1
Left = 4050
TabIndex = 2
Top = 300
Width = 735
_Version = 65536
_ExtentX = 1296
_ExtentY = 661
_StockProps = 15
Caption = "Octave"
ForeColor = 0
BorderWidth = 0
BevelOuter = 1
BevelInner = 2
FloodShowPct = 0 'False
Font3D = 3
Alignment = 1
Autosize = 3
End
Begin Threed.SSPanel LabelOctave
Height = 225
Left = 4950
TabIndex = 1
Top = 390
Width = 300
_Version = 65536
_ExtentX = 529
_ExtentY = 397
_StockProps = 15
Caption = "1"
ForeColor = 0
BorderWidth = 1
BevelOuter = 0
Font3D = 3
Alignment = 4
Autosize = 3
End
End
Begin VB.Menu File
Caption = "&File"
Begin VB.Menu Exit
Caption = "E&xit"
End
End
Begin VB.Menu help
Caption = "&Help"
Begin VB.Menu About
Caption = "&About"
End
End
End
Attribute VB_Name = "Piano"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim NoteCatchCount As Integer
Dim NoteOnCatcher(1024) As Integer
Private Sub About_Click()
AboutBox1.Show MODAL
End Sub
Private Sub Exit_Click()
X% = midiOutClose(hMidiOutCopy)
End
End Sub
Private 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
Private Sub Form_Unload(Cancel As Integer)
X% = midiOutClose(hMidiOutCopy)
End
End Sub
Private 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
Private Sub HScrollOctave_Change()
LabelOctave.Caption = Str$(HScrollOctave.Value)
Octave(MidiChannelOut) = (HScrollOctave.Value * 12)
End Sub
Private 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
Private 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
Private Sub HScrollVolume_Change()
MidiVelocity = HScrollVolume.Value
MidiVolume(MidiChannelOut) = HScrollVolume.Value
VolumeLabel.Caption = Str$(MidiVelocity)
End Sub
Private 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
Piano.PanelWhite(NoteOnCatcher(nn) - Octave(MidiChannelOut)).BevelOuter = 2
Next nn
NoteCatchCount = 0
End Sub
Private 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
Piano.PanelWhite(Index).BevelOuter = 0
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -