www.pudn.com > midi_drum.zip > FrmMicroKit.frm
VERSION 5.00
Begin VB.Form FrmMicroKit
BorderStyle = 1 'Fixed Single
ClientHeight = 5865
ClientLeft = 1755
ClientTop = 1725
ClientWidth = 7590
Icon = "FrmMicroKit.frx":0000
LockControls = -1 'True
MaxButton = 0 'False
NegotiateMenus = 0 'False
OLEDropMode = 1 'Manual
ScaleHeight = 391
ScaleMode = 3 'Pixel
ScaleWidth = 506
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 15
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 54
TabStop = 0 'False
Top = 4980
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 14
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 53
TabStop = 0 'False
Top = 4680
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 13
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 52
TabStop = 0 'False
Top = 4380
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 12
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 51
TabStop = 0 'False
Top = 4080
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 11
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 50
TabStop = 0 'False
Top = 3780
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 10
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 49
TabStop = 0 'False
Top = 3480
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 9
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 48
TabStop = 0 'False
Top = 3180
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 8
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 47
TabStop = 0 'False
Top = 2880
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 7
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 46
TabStop = 0 'False
Top = 2580
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 6
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 45
TabStop = 0 'False
Top = 2280
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 5
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 44
TabStop = 0 'False
Top = 1980
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 4
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 43
TabStop = 0 'False
Top = 1680
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 3
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 42
TabStop = 0 'False
Top = 1380
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 2
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 41
TabStop = 0 'False
Top = 1080
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 1
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 40
TabStop = 0 'False
Top = 780
Width = 4080
End
Begin VB.PictureBox PicTrack
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ClipControls = 0 'False
Height = 255
Index = 0
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 272
TabIndex = 39
TabStop = 0 'False
Top = 480
Width = 4080
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 15
Left = 3090
Max = 0
Min = 127
TabIndex = 38
TabStop = 0 'False
Top = 5010
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 15
Left = 2430
Max = 35
Min = 81
TabIndex = 37
TabStop = 0 'False
Top = 5010
Value = 56
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 14
Left = 3090
Max = 0
Min = 127
TabIndex = 36
TabStop = 0 'False
Top = 4710
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 14
Left = 2430
Max = 35
Min = 81
TabIndex = 35
TabStop = 0 'False
Top = 4710
Value = 54
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 13
Left = 3090
Max = 0
Min = 127
TabIndex = 34
TabStop = 0 'False
Top = 4410
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 13
Left = 2430
Max = 35
Min = 81
TabIndex = 33
TabStop = 0 'False
Top = 4410
Value = 51
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 12
Left = 3090
Max = 0
Min = 127
TabIndex = 32
TabStop = 0 'False
Top = 4110
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 12
Left = 2430
Max = 35
Min = 81
TabIndex = 31
TabStop = 0 'False
Top = 4110
Value = 49
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 11
Left = 3090
Max = 0
Min = 127
TabIndex = 30
TabStop = 0 'False
Top = 3810
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 11
Left = 2430
Max = 35
Min = 81
TabIndex = 29
TabStop = 0 'False
Top = 3810
Value = 50
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 10
Left = 3090
Max = 0
Min = 127
TabIndex = 28
TabStop = 0 'False
Top = 3510
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 10
Left = 2430
Max = 35
Min = 81
TabIndex = 27
TabStop = 0 'False
Top = 3510
Value = 48
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 9
Left = 3090
Max = 0
Min = 127
TabIndex = 26
TabStop = 0 'False
Top = 3210
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 9
Left = 2430
Max = 35
Min = 81
TabIndex = 25
TabStop = 0 'False
Top = 3210
Value = 47
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 8
Left = 3090
Max = 0
Min = 127
TabIndex = 24
TabStop = 0 'False
Top = 2910
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 8
Left = 2430
Max = 35
Min = 81
TabIndex = 23
TabStop = 0 'False
Top = 2910
Value = 45
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 7
Left = 3090
Max = 0
Min = 127
TabIndex = 22
TabStop = 0 'False
Top = 2610
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 7
Left = 2430
Max = 35
Min = 81
TabIndex = 21
TabStop = 0 'False
Top = 2610
Value = 46
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 6
Left = 3090
Max = 0
Min = 127
TabIndex = 20
TabStop = 0 'False
Top = 2310
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 6
Left = 2430
Max = 35
Min = 81
TabIndex = 19
TabStop = 0 'False
Top = 2310
Value = 44
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 5
Left = 3090
Max = 0
Min = 127
TabIndex = 18
TabStop = 0 'False
Top = 2010
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 5
Left = 2430
Max = 35
Min = 81
TabIndex = 17
TabStop = 0 'False
Top = 2010
Value = 42
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 4
Left = 3090
Max = 0
Min = 127
TabIndex = 16
TabStop = 0 'False
Top = 1710
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 4
Left = 2430
Max = 35
Min = 81
TabIndex = 15
TabStop = 0 'False
Top = 1710
Value = 40
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 3
Left = 3090
Max = 0
Min = 127
TabIndex = 14
TabStop = 0 'False
Top = 1410
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 3
Left = 2430
Max = 35
Min = 81
TabIndex = 13
TabStop = 0 'False
Top = 1410
Value = 39
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 2
Left = 3090
Max = 0
Min = 127
TabIndex = 12
TabStop = 0 'False
Top = 1110
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 2
Left = 2430
Max = 35
Min = 81
TabIndex = 11
TabStop = 0 'False
Top = 1110
Value = 38
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 1
Left = 3090
Max = 0
Min = 127
TabIndex = 10
TabStop = 0 'False
Top = 810
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 1
Left = 2430
Max = 35
Min = 81
TabIndex = 9
TabStop = 0 'False
Top = 810
Value = 37
Width = 240
End
Begin VB.VScrollBar VsbVol
Height = 195
Index = 0
Left = 3090
Max = 0
Min = 127
TabIndex = 8
TabStop = 0 'False
Top = 510
Value = 127
Width = 240
End
Begin VB.VScrollBar VsbInst
Height = 195
Index = 0
Left = 2430
Max = 35
Min = 81
TabIndex = 7
TabStop = 0 'False
Top = 510
Value = 35
Width = 240
End
Begin VB.CommandButton CmdPatternRun
Caption = "&Play"
Height = 375
Left = 6450
OLEDropMode = 1 'Manual
TabIndex = 0
Top = 5370
Width = 1020
End
Begin VB.VScrollBar VsbPtrnNo
Height = 195
Left = 4425
Max = 1
Min = 100
TabIndex = 3
TabStop = 0 'False
Top = 195
Value = 1
Width = 240
End
Begin VB.VScrollBar VsbTempo
Height = 195
Left = 7200
Max = 40
Min = 255
TabIndex = 2
TabStop = 0 'False
Top = 195
Value = 120
Width = 240
End
Begin VB.CommandButton CmdPatternStop
Caption = "&Stop"
Enabled = 0 'False
Height = 375
Left = 5430
OLEDropMode = 1 'Manual
TabIndex = 1
Top = 5370
Width = 1020
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Pattern:"
Height = 195
Index = 21
Left = 3390
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 105
Top = 195
Width = 555
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Vol:"
Height = 195
Index = 20
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 104
Top = 195
Width = 270
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Instrument:"
Height = 195
Index = 19
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 103
Top = 195
Width = 780
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 16:"
Height = 195
Index = 18
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 102
Top = 5010
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 15:"
Height = 195
Index = 17
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 101
Top = 4710
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 14:"
Height = 195
Index = 16
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 100
Top = 4410
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 13:"
Height = 195
Index = 15
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 99
Top = 4110
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 12:"
Height = 195
Index = 14
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 98
Top = 3810
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 11:"
Height = 195
Index = 13
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 97
Top = 3510
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 10:"
Height = 195
Index = 12
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 96
Top = 3210
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 09:"
Height = 195
Index = 11
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 95
Top = 2910
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 08:"
Height = 195
Index = 10
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 94
Top = 2610
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 07:"
Height = 195
Index = 9
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 93
Top = 2310
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 06:"
Height = 195
Index = 8
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 92
Top = 2010
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 05:"
Height = 195
Index = 7
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 91
Top = 1710
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 04:"
Height = 195
Index = 6
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 90
Top = 1410
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 03:"
Height = 195
Index = 5
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 89
Top = 1110
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 02:"
Height = 195
Index = 4
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 88
Top = 810
Width = 690
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Track 01:"
Height = 195
Index = 3
Left = 120
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 87
Top = 510
Width = 690
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 15
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 86
Top = 4980
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Cowbell"
ForeColor = &H00FFFF00&
Height = 255
Index = 15
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 85
Top = 4980
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 14
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 84
Top = 4680
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Tambourine"
ForeColor = &H00FFFF00&
Height = 255
Index = 14
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 83
Top = 4680
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 13
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 82
Top = 4380
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Ride Cymbal 1"
ForeColor = &H00FFFF00&
Height = 255
Index = 13
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 81
Top = 4380
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 12
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 80
Top = 4080
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Crash Cymbal 1"
ForeColor = &H00FFFF00&
Height = 255
Index = 12
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 79
Top = 4080
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 11
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 78
Top = 3780
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "High Tom"
ForeColor = &H00FFFF00&
Height = 255
Index = 11
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 77
Top = 3780
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 10
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 76
Top = 3480
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "High-Mid Tom"
ForeColor = &H00FFFF00&
Height = 255
Index = 10
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 75
Top = 3480
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 9
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 74
Top = 3180
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Low-Mid Tom"
ForeColor = &H00FFFF00&
Height = 255
Index = 9
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 73
Top = 3180
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 8
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 72
Top = 2880
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Low Tom"
ForeColor = &H00FFFF00&
Height = 255
Index = 8
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 71
Top = 2880
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 7
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 70
Top = 2580
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Open High-Hat"
ForeColor = &H00FFFF00&
Height = 255
Index = 7
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 69
Top = 2580
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 6
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 68
Top = 2280
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Pedal High-Hat"
ForeColor = &H00FFFF00&
Height = 255
Index = 6
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 67
Top = 2280
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 5
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 66
Top = 1980
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Closed High-Hat"
ForeColor = &H00FFFF00&
Height = 255
Index = 5
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 65
Top = 1980
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 4
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 64
Top = 1680
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Electric Snare"
ForeColor = &H00FFFF00&
Height = 255
Index = 4
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 63
Top = 1680
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 3
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 62
Top = 1380
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Hand Clap"
ForeColor = &H00FFFF00&
Height = 255
Index = 3
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 61
Top = 1380
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 2
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 60
Top = 1080
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Acoustic Snare"
ForeColor = &H00FFFF00&
Height = 255
Index = 2
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 59
Top = 1080
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 1
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 58
Top = 780
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Side Stick"
ForeColor = &H00FFFF00&
Height = 255
Index = 1
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 57
Top = 780
Width = 1770
End
Begin VB.Label LblVol
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "127"
ForeColor = &H00FFFF00&
Height = 255
Index = 0
Left = 2730
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 56
Top = 480
Width = 630
End
Begin VB.Label LblInst
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Acoustic Bass Drum"
ForeColor = &H00FFFF00&
Height = 255
Index = 0
Left = 930
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 55
Top = 480
Width = 1770
End
Begin VB.Label Lbl
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "Tempo:"
Height = 195
Index = 0
Left = 6180
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 6
Top = 195
Width = 540
End
Begin VB.Label LblPtrnNo
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "001"
ForeColor = &H00FFFF00&
Height = 255
Left = 4065
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 5
Top = 165
Width = 630
End
Begin VB.Label LblTempo
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "120"
ForeColor = &H00FFFF00&
Height = 255
Left = 6840
LinkTimeout = 0
OLEDropMode = 1 'Manual
TabIndex = 4
Top = 165
Width = 630
End
Begin VB.Menu MnuFile
Caption = "&File"
Begin VB.Menu MnuNew
Caption = "&New"
Shortcut = ^N
End
Begin VB.Menu MnuOpen
Caption = "&Open"
Shortcut = ^O
End
Begin VB.Menu MnuSep1
Caption = "-"
End
Begin VB.Menu MnuSave
Caption = "&Save"
Shortcut = ^S
End
Begin VB.Menu MnuSaveAs
Caption = "Save &As"
Shortcut = ^A
End
Begin VB.Menu MnuRecent
Caption = "-"
Index = 0
Visible = 0 'False
End
Begin VB.Menu MnuRecent
Caption = ""
Index = 1
Visible = 0 'False
End
Begin VB.Menu MnuRecent
Caption = ""
Index = 2
Visible = 0 'False
End
Begin VB.Menu MnuRecent
Caption = ""
Index = 3
Visible = 0 'False
End
Begin VB.Menu MnuRecent
Caption = ""
Index = 4
Visible = 0 'False
End
Begin VB.Menu MnuSep2
Caption = "-"
End
Begin VB.Menu MnuExit
Caption = "E&xit"
End
End
Begin VB.Menu MnuEdit
Caption = "&Edit"
Begin VB.Menu MnuCut
Caption = "Cu&t Pattern"
Shortcut = ^X
End
Begin VB.Menu MnuCopy
Caption = "&Copy Pattern"
Shortcut = ^C
End
Begin VB.Menu MnuPaste
Caption = "&Paste Pattern"
Shortcut = ^V
End
Begin VB.Menu MnuDelete
Caption = "&Delete Pattern"
Shortcut = {DEL}
End
Begin VB.Menu MnuSep3
Caption = "-"
End
Begin VB.Menu MnuShiftPatternLeft
Caption = "Shift Pattern &Left"
Shortcut = ^L
End
Begin VB.Menu MnuShiftPatternRight
Caption = "Shift Pattern &Right"
Shortcut = ^R
End
Begin VB.Menu MnuSep4
Caption = "-"
End
Begin VB.Menu MnuRandomizePattern
Caption = "Randomi&ze Pattern"
Shortcut = ^Z
End
Begin VB.Menu MnuRandomizeKit
Caption = "Randomize &Kit"
Shortcut = ^K
End
Begin VB.Menu MnuRandomizeVolumes
Caption = "Randomize &Volumes"
Shortcut = ^U
End
Begin VB.Menu MnuSep5
Caption = "-"
End
Begin VB.Menu MnuOptimizePattern
Caption = "&Optimize Pattern"
Shortcut = ^M
End
End
Begin VB.Menu MnuSongMode
Caption = "Song &Mode"
End
Begin VB.Menu MnuHelp
Caption = "&Help"
Begin VB.Menu MnuAbout
Caption = "&About MicroKit"
Shortcut = {F1}
End
End
End
Attribute VB_Name = "FrmMicroKit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Author: Stuart Pennington.
' Project: Midi Percussion Sequencer (Drum Machine).
' Test Platform: Windows 98SE
' Processor: P2 300MHz.
' Note 1: Sound Quality Determined By Soundcard's Midi Spec.
' Note 2: App Uses "CALLBACKS" So Shut Down From The Main Form, NOT VB IDE.
' Note 3: Unable To Sync To Other Midi Instruments (Sorry, But Have Fun Anyway).
' Midi Msg Example:
'
' Middle C Note-On On Ch9 With A Volume Of 127:-
'
' Midi Msg Format: VOLUME :: Note Number :: Note On :: Channel's (0 To 15)
' &H7F :: &H30 :: &H90 :: &H9 = &H7F3099
'
' Middle C Note-Off On Ch9:-
'
' Midi Msg Format: VOLUME :: Note Number :: Note Off :: Channel's (0 To 15)
' &H0 :: &H30 :: &H80 :: &H9 = &H3089
Private CurFile$ ' Name Of The File We Are Currently Working With.
Private CurTitle$ ' Title Of The File We Are Currently Working With.
Private DblClickFName$ ' Indicates App Launched By Double Clicking A File In Explorer.
Private RecentFile$ ' Indicates File Input From Recent Menu.
Private DroppedFile$ ' Indicates File Input By Drag And Drop From Explorer.
Private bPatternPlaying As Boolean ' Indicates That A Pattern Is Playing.
Private bCanPastePattern As Boolean ' Indicates To The Edit Menu That The Edit Array Contains Data.
Private bExit As Boolean ' Used To Exit Event Proceedures That Execute When I Don't Want Them To.
Private PtrnEd(15, 15) As Kit ' Array Used For Pattern Editing (16 Track, 16 Step).
Private PadNo% ' Indicates Which Coloured Button On A Track Has Been Clicked.
Private PadRct As RECT ' Used For Drawing The Track Buttons.
Private Sub Form_Load()
Randomize ' For Crazy Edits.
GetRecentFileList MnuRecent ' Populate Recent File Menu.
GetLastDir ' Get Last Folder User Was In And Make It Current.
DoGraphics ' Prepare Tracks For Drawing Button's.
MnuNew_Click ' Apply Default Settings.
' Add The "Alt+F4" Accelerator To The Exit Menu.
MnuExit.Caption = "E&xit" & vbTab & "Alt+F4"
' Position The Form On The Screen.
PositionForm Me
' Did Someone Double Click On One Of Our File's To Launch This App?
CheckCommand
End Sub
Private Sub CheckCommand()
Dim Msg$
' Examine The Command String.
If Left(Command, 5) = "/open" And LCase(Right(Command, 4)) = ".mkf" Then
' Get The Name Of The Double Clicked File.
DblClickFName = Mid(Command, 7, Len(Command) - 6)
If ReadDataFromFile(DblClickFName) Then
' It's One Of Our's, Proceed.
CurFile = GetShortPath(DblClickFName)
CurTitle = GetTitle(DblClickFName)
ContinueUpdate
Else
' Ivalid File.
Show
DoEvents
Msg = "Unable to open the file " & GetTitle(DblClickFName)
MsgBox Msg, vbExclamation, "MicroKit - Error"
End If
End If
End Sub
Private Sub DoGraphics()
' Each Tracks Buttons Are In Groups Of Four, Makes Them Easier To Use.
PicTrack(0).Line (0, 0)-(69, 17), &HFF&, BF ' Red Rectangle Four Buttons Long.
PicTrack(0).Line (70, 0)-(137, 17), &H80FF&, BF ' Orange Rectangle Four Buttons Long .
PicTrack(0).Line (138, 0)-(205, 17), &HFFFF&, BF ' Yellow Rectangle Four Buttons Long.
PicTrack(0).Line (206, 0)-(269, 17), &HFFFFFF, BF ' White Rectangle Four Buttons Long.
End Sub
Private Sub Form_Paint()
Dim Rct As RECT
' Draw An Etched Rect Below The Menu.
SetRect Rct, 0, 0, Me.ScaleWidth + 1, 2
DrawEdge Me.hDC, Rct, 2, 15
End Sub
Private Sub MnuEdit_Click()
' Paste Does Not Use Clipboard... Its All Done Internally With The "PtrnEd" Array.
MnuPaste.Enabled = bCanPastePattern
End Sub
Private Sub MnuCut_Click()
Dim R%, C% ' Row And Column Counter's.
StopPlay
' Put All The Current Pattern Data Into Our Edit Array And Reset All Track Buttons.
For R = 0 To 15
For C = 0 To 15
' Copy Current Section Of Pattern Array Into Edit Array.
PtrnEd(R, C).bNoteOn = Ptrns(R, C + StartPos).bNoteOn
PtrnEd(R, C).PercName = Ptrns(R, C + StartPos).PercName
PtrnEd(R, C).PercVol = Ptrns(R, C + StartPos).PercVol
PtrnEd(R, C).MidiMsg = Ptrns(R, C + StartPos).MidiMsg
' Switch Off Note On Indicators For
' This Section Of The Pattern Array.
Ptrns(R, C + StartPos).bNoteOn = False
Next
Next
' Redraw All Coloured Buttons In The "Up" Position.
ResetTracks
' We Now Have A Pattern We Can Paste.
bCanPastePattern = True
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuCopy_Click()
Dim R%, C% ' Row And Column Counter's.
StopPlay
' Put All The Pattern Data Into Our Edit Array But Don't Reset Track Buttons.
For R = 0 To 15
For C = 0 To 15
' Copy Current Section Of Pattern Array Into Edit Array.
PtrnEd(R, C).bNoteOn = Ptrns(R, C + StartPos).bNoteOn
PtrnEd(R, C).PercName = Ptrns(R, C + StartPos).PercName
PtrnEd(R, C).PercVol = Ptrns(R, C + StartPos).PercVol
PtrnEd(R, C).MidiMsg = Ptrns(R, C + StartPos).MidiMsg
Next
Next
' We Now Have A Pattern We Can Paste.
bCanPastePattern = True
End Sub
Private Sub MnuOptimizePattern_Click()
Dim VolArray%(15, 1)
Dim R%, C%
Dim N%, T1%, T2%, Inc%
Dim bFound As Boolean
' Increase The Volume's Of The Track's
' Of The Current Pattern, If We Can,
' Without Loosing The Mix.
StopPlay
' Scan For Track's Containing Sequencing Info.
For R = 0 To 15
For C = 0 To 15
If Ptrns(R, C + StartPos).bNoteOn Then
' Found A Track In This Section Of The Pattern Array
' That Contains Note On Info.
bFound = True
Exit For
End If
Next
If bFound Then
bFound = False
' Check The Output Level For The Note On.
If Ptrns(R, StartPos).PercVol = 127 Then
' Found A Track In Use Whose Vol = 127,
' No Optimization Can Be Performed, Abort.
Exit Sub
Else
' Save The Vol And Track Number For Later.
VolArray(N, 0) = Ptrns(R, StartPos).PercVol
VolArray(N, 1) = R
N = N + 1
End If
End If
Next
' Bubble Sort The Data So That Element Zero Of Our "VolArray"
' Will Contain The Track Whose Vol Is Highest.
For C = 0 To 14
If VolArray(C, 0) < VolArray(C + 1, 0) Then
T1 = VolArray(C, 0)
T2 = VolArray(C, 1)
VolArray(C, 0) = VolArray(C + 1, 0)
VolArray(C, 1) = VolArray(C + 1, 1)
VolArray(C + 1, 0) = T1
VolArray(C + 1, 1) = T2
C = -1
End If
Next
' Find The Amount By Which All Track Volumes Can Be Increased.
Inc = 127 - VolArray(0, 0)
' Optimize The OutPut And Rebuild Midi Messages.
For R = 0 To N - 1
For C = StartPos To EndPos
Ptrns(VolArray(R, 1), C).PercVol = Ptrns(VolArray(R, 1), C).PercVol + Inc
Ptrns(VolArray(R, 1), C).MidiMsg = (CLng(Ptrns(VolArray(R, 1), C).PercVol) * &H10000) + (CLng(Ptrns(VolArray(R, 1), C).PercName) * &H100) + &H99
Next
Next
' Update The Volume Labels And Scroll Bars To Reflect The Update.
For R = 0 To 15
VsbVol(R).Value = Ptrns(R, 0).PercVol
Next
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuPaste_Click()
Dim R%, C%, K%, V%
StopPlay
' Update That Section Of The Pattern Array That
' Requires The New Data.
For R = 0 To 15
For C = 0 To 15
' Copy Data From Edit Array To Pattern Array.
Ptrns(R, C + StartPos).bNoteOn = PtrnEd(R, C).bNoteOn
Ptrns(R, C + StartPos).PercName = PtrnEd(R, C).PercName
Ptrns(R, C + StartPos).PercVol = PtrnEd(R, C).PercVol
Ptrns(R, C + StartPos).MidiMsg = PtrnEd(R, C).MidiMsg
Next
Next
' This Update Will Cause The Scroll Bar Change Events To Fire
' And I Don't Want That To Happen.
bExit = True
For K = 0 To 15
' Update Scroll Bars And Labels With The Instruments
' And Volumes For This Pattern.
VsbVol(K).Value = PtrnEd(K, 0).PercVol
VsbInst(K).Value = PtrnEd(K, 0).PercName
Next
bExit = False
' Display The Status Of The Tracks.
ShowTrackData StartPos
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuDelete_Click()
Dim C%, R%
StopPlay
' Scrap the Note-On Data For The Current Pattern.
For R = 0 To 15
For C = 0 To 15
Ptrns(R, C + StartPos).bNoteOn = False
Next
Next
' Show All Track Buttons In The "Up" Position.
ResetTracks
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuNew_Click()
Dim K%
Dim C%, R%, N&
' ===============
' Apply Defaults.
' ===============
StopPlay
If bDirty Then
' See If We Need To Save Any Changes Before Proceeding.
If Not Discard Then Exit Sub
End If
' Reset Variables.
CurFile = "Untitled"
CurTitle = "Untitled"
Caption = "MicroKit - Untitled"
StartPos = 0
EndPos = 15
CurPos = 0
bPatternChanged = False
bFileSaved = False
' Show All Track Buttons In The "Up" Position.
ResetTracks
' Build The Default Pattern Array.
For R = 0 To 15
Select Case R
Case 0: N = 35
Case 1: N = 37
Case 2: N = 38
Case 3: N = 39
Case 4: N = 40
Case 5: N = 42
Case 6: N = 44
Case 7: N = 46
Case 8: N = 45
Case 9: N = 47
Case 10: N = 48
Case 11: N = 50
Case 12: N = 49
Case 13: N = 51
Case 14: N = 54
Case 15: N = 56
End Select
For C = 0 To 1599 ' 100, 16 Step Patterns In One BIG Array.
Ptrns(R, C).bNoteOn = False
Ptrns(R, C).PercVol = 127
Ptrns(R, C).PercName = N
Ptrns(R, C).MidiMsg = &H7F0099 + (N * &H100)
Next
Next
' Update Volume And Instument Controls.
bExit = True
For K = 0 To 15
VsbVol(K).Value = 127
VsbInst(K).Value = Ptrns(K, 0).PercName
Next
bExit = False
' Set Pattern Number To ONE.
VsbPtrnNo.Value = 1
' Set Tempo To 120 BPM.
VsbTempo.Value = 120
' Update Tempo Variables For Timers.
NewTempo = 125 ' Millisecs.
OldTempo = 125
' Switch Off Song Looping
bLoopSong = False
' Tip-O-The-Day.
' I've Always Found It Better To Put This Last Incase It's Been Made True Again Somewhere.
bDirty = False
End Sub
Private Sub StopPlay()
' Stop Pattern Playing.
If bPatternPlaying Then CmdPatternStop_Click
End Sub
Private Sub ResetTracks()
Dim K%
Dim Rct As RECT
' Draw All The Buttons On Track One In The "Up" Position.
For K = 0 To 15
SetRect Rct, K * 17, 0, K * 17 + 17, 17
DrawEdge PicTrack(0).hDC, Rct, 5, 15
Next
PicTrack(0).Refresh
' Then Blit Track One's Button Strip To All The Other Tracks.
For K = 1 To 15
BitBlt PicTrack(K).hDC, 0, 0, 272, 17, PicTrack(0).hDC, 0, 0, vbSrcCopy
PicTrack(K).Refresh
Next
End Sub
Private Sub CmdPatternRun_Click()
CmdPatternRun.Enabled = 0
CmdPatternStop.Enabled = 1
CurPos = StartPos
bPatternPlaying = True
DoEvents
' Create High Res (Multi Media) Timer To Do The Sequencing.
TimerID = timeSetEvent(NewTempo, BestResolution, AddressOf PatternProc, 0, 1)
' We Are Now Sequencing.
End Sub
Private Sub CmdPatternStop_Click()
CmdPatternStop.Enabled = 0
CmdPatternRun.Enabled = 1
DoEvents
' Destroy High Res Timer.
timeKillEvent TimerID
TimerID = 0
' Stop Any Midi Notes That Are Still Playing.
midiOutReset hMidiOut
bPatternPlaying = False
' If User Has Changed Pattern Number
' Update Pattern Playback Start And End Position's.
If bPatternChanged Then
StartPos = NewStartPos
EndPos = NewEndPos
bPatternChanged = False
End If
End Sub
Private Sub MnuOpen_Click()
Dim Msg$
StopPlay
If bDirty Then
' See If We Need To Save Any Changes Before Proceeding.
If Not Discard Then Exit Sub
End If
If OpenFile Then
' We Got A File To Open.
If ReadDataFromFile(NewFileName) Then
' File Was Valid, Proceed.
CurFile = GetShortPath(NewFileName)
CurTitle = NewFileTitle
ContinueUpdate
Else
' Invalid File.
Msg = "Unable to open the file " & NewFileTitle
MsgBox Msg, vbExclamation, "MicroKit - Error"
End If
End If
End Sub
Private Sub ContinueUpdate()
' Prep Settings For A New File.
Dim K%
Caption = "MicroKit - " & CurTitle
StartPos = 0
EndPos = 15
CurPos = 0
' Set Pattern Number To ONE.
VsbPtrnNo.Value = 1
bExit = True
' Update Instrument And Volume Controls.
For K = 0 To 15
VsbInst(K).Value = Ptrns(K, 0).PercName
VsbVol(K).Value = Ptrns(K, 0).PercVol
Next
bExit = False
' Display Track Data For The First Pattern.
ShowTrackData 0
' Add The File Name To The Recent Files Menu.
AddToRecent CurFile, MnuRecent
bPatternChanged = False
bFileSaved = False
bDirty = False
End Sub
Private Sub ShowTrackData(nPos%)
Dim R%, C% ' Counters, Rows And Columns.
Dim Rct As RECT
For R = 0 To 15
For C = 0 To 15
' Calculate The Position Of Each Button To Be Drawn.
SetRect Rct, C * 17, 0, C * 17 + 17, 17
If Ptrns(R, C + nPos).bNoteOn Then
DrawEdge PicTrack(R).hDC, Rct, 10, 15 ' Draw The Button Pressed.
Else
DrawEdge PicTrack(R).hDC, Rct, 5, 15 ' Draw The Button Up.
End If
Next
' Refresh The Current Track So We Can See The Changes.
PicTrack(R).Refresh
Next
End Sub
Private Sub MnuRandomizeKit_Click()
' Purpose: Replaces The Instruments You Chose
' With Instruments Chosen At Random.
Dim K%, N%, Q%, R%, C%
Dim bFound As Boolean
Dim Tmp%(15)
StopPlay
' Set Each Element Of Our Temp Array To -2 (For Reference Later).
For K = 0 To 15
Tmp(K) = -2
Next
' Scan Each Track For Note-On Data.
For R = 0 To 15
For C = 0 To 15
If Ptrns(R, C + StartPos).bNoteOn Then
' Found A Track Thats Being Used.
' Record This Fact By Placing A -1 In Our Temp Array.
Tmp(R) = -1
Exit For
End If
Next
Next
' For Each Track That's In Use, Find It An Instrument At Random.
For K = 0 To 15
If Tmp(K) = -1 Then
Q = Fix(Rnd * 47)
For N = 0 To 15
If Tmp(N) = Q Then
bFound = True
Exit For
End If
Next
If bFound Then
bFound = False
K = K - 1
Else
Tmp(K) = Q
End If
End If
Next
' Update The Instrument Readouts To Reflect The Changes.
For K = 0 To 15
If Tmp(K) <> -2 Then
VsbInst(K).Value = Tmp(K) + 35
End If
Next
' Update The Instruments And Midi Messages
' In That Section Of The Pattern Array That Corresponds
' To This Pattern.
For R = 0 To 15
For C = 0 To 15
Ptrns(R, C + StartPos).PercName = VsbInst(R).Value
Ptrns(R, C + StartPos).MidiMsg = VsbVol(R).Value * &H10000 + VsbInst(R).Value * &H100 + &H99
Next
Next
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuRandomizeVolumes_Click()
' Purpose: Randomizes The Volumes Of The Instruments In The Current Pattern.
Dim K%, N%, Q%, R%, C%
Dim bFound As Boolean
Dim Tmp%(15)
StopPlay
' Set Each Element Of Our Temp Array To -2 (For Reference Later).
For K = 0 To 15
Tmp(K) = -2
Next
' Scan Each Track For Note-On Data.
For R = 0 To 15
For C = 0 To 15
If Ptrns(R, C + StartPos).bNoteOn Then
' Found A Track Thats Being Used.
' Record This Fact By Placing A -1 In Our Temp Array.
Tmp(R) = -1
Exit For
End If
Next
Next
' For Each Track That's In Use, Give It A Random Volume Setting.
For K = 0 To 15
If Tmp(K) = -1 Then
Q = Int((127 - 63 + 1) * Rnd + 63) ' Get A Random Volume From 63 To 127.
For N = 0 To 15
If Tmp(N) = Q Then
bFound = True
Exit For
End If
Next
If bFound Then
bFound = False
K = K - 1
Else
Tmp(K) = Q
End If
End If
Next
' Update The Volume Readouts To Reflect The Changes.
For K = 0 To 15
If Tmp(K) <> -2 Then VsbVol(K).Value = Tmp(K)
Next
' Update The Instruments And Midi Messages
' In That Section Of The Pattern Array That Corresponds
' To This Pattern.
For R = 0 To 15
For C = 0 To 15
Ptrns(R, C + StartPos).PercVol = VsbVol(R).Value
Ptrns(R, C + StartPos).MidiMsg = VsbVol(R).Value * &H10000 + VsbInst(R).Value * &H100 + &H99
Next
Next
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuRandomizePattern_Click()
' Purpose: Scrambles Note-On Data.
Dim Tmp(15) As Boolean
Dim R%, C%, K%, N%, Q%, V%
Dim Sum%
StopPlay
For R = 0 To 15
Sum = 0
For C = 0 To 15
If Ptrns(R, C + StartPos).bNoteOn = True Then
' Total Up The Note-On Info For Each Track
Sum = Sum + 1
' Switch Note Off.
Ptrns(R, C + StartPos).bNoteOn = False
End If
Next
For N = 1 To Sum
' Replace The Exact Number Of Notes, In Different Position's.
Q = Fix(Rnd * 16)
' Note: These Positions Must Be Unique.
If N = 1 Then
Tmp(Q) = True
Else
If Tmp(Q) = True Then
N = N - 1
Else
Tmp(Q) = True
End If
End If
Next
' Create The Randomized Track.
For N = 0 To 15
Ptrns(R, N + StartPos).bNoteOn = Tmp(N)
Tmp(N) = False
Next
Next
' Display The New Track Data.
ShowTrackData StartPos
' Data Has changed.
bDirty = True
End Sub
Private Sub MnuRecent_Click(Idx%)
StopPlay
If bDirty Then
' See If We Need To Save Any Changes Before Proceeding.
If Not Discard Then Exit Sub
End If
' Get The Full Path From The Menu Tag.
RecentFile = MnuRecent(Idx).Tag
If Dir(RecentFile, 39) = "" Then
' File Not Found.
' Inform User And Remove The File From The Recent Menu.
DoMessageAndRemoveItem Idx
Else
' Got A File, Check If It's Valid.
If ReadDataFromFile(RecentFile) Then
' File Was Valid, Proceed.
CurFile = RecentFile
CurTitle = Mid(MnuRecent(Idx).Caption, 4)
ContinueUpdate
Else
' Inform User And Remove The File From The Recent Menu.
DoMessageAndRemoveItem Idx
End If
End If
End Sub
Private Sub DoMessageAndRemoveItem(Idx%)
' Purpose: Outputs Message And Removes A File From The Recent Menu.
Dim Msg$
Msg = "Unable to locate the file: " & Mid(MnuRecent(Idx).Caption, 4)
Msg = Msg & vbCrLf & vbCrLf
Msg = Msg & "It will be removed from the menu."
MsgBox Msg, vbExclamation, Ttl & " - Error"
' Set Tag To Null First.
MnuRecent(Idx).Tag = ""
' Now Make The Update.
UpdateRecent MnuRecent
End Sub
Private Sub MnuSave_Click()
Dim Msg$
If CurFile = "Untitled" Then
' File Has Not Been Saved Before.
MnuSaveAs_Click
Exit Sub
End If
StopPlay
If WriteDataToFile(CurFile, VsbTempo.Value) Then
' Data Is Now Clean.
bDirty = False
Else
' Save File Failed.
Msg = "Unable to save the file " & CurTitle
MsgBox Msg, vbExclamation, "MicroKit - Error"
End If
End Sub
Private Sub MnuSaveAs_Click()
Dim Msg$
StopPlay
If SaveFile Then
' Got A Name By Which To Save The File.
If WriteDataToFile(NewFileName, VsbTempo.Value) Then
' Data Is Now Clean.
bDirty = False
' Update Variables.
CurFile = GetShortPath(NewFileName)
CurTitle = NewFileTitle
Caption = "MicroKit - " & CurTitle
' Add The New Name To The Recent Menu.
AddToRecent CurFile, MnuRecent
Else
' Save File Failed.
Msg = "Unable to save the file " & NewFileTitle
MsgBox Msg, vbExclamation, "MicroKit - Error"
End If
End If
End Sub
Private Sub MnuShiftPatternLeft_Click()
Dim K%, R%, C%
Dim Tmp1(15) As Boolean
Dim Tmp2(15, 15) As Kit
StopPlay
' Save The Note-On Data For The First Note Of Each Track.
For K = 0 To 15
Tmp1(K) = Ptrns(K, StartPos).bNoteOn
Next
' Copy The Remaining Note-On Data For Each Track
' In Another Temp Array But Move It All To The Left
' By One Beat (One Element Number).
For R = 0 To 15
For C = 1 To 15
Tmp2(R, C - 1).bNoteOn = Ptrns(R, C + StartPos).bNoteOn
Ptrns(R, C + StartPos).bNoteOn = False
Next
Next
' Copy The First Notes Of Each Track To
' The Last Position In Each Track
For K = 0 To 15
Tmp2(K, 15).bNoteOn = Tmp1(K)
Next
' Update The Pattern Array With The New Note-On Positions.
For R = 0 To 15
For C = 0 To 15
Ptrns(R, C + StartPos).bNoteOn = Tmp2(R, C).bNoteOn
Next
Next
' Show The Status Of The Tracks.
ShowTrackData StartPos
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuShiftPatternRight_Click()
Dim K%, R%, C%, V%
Dim Tmp1(46) As Boolean
Dim Tmp2(46, 15) As Kit
StopPlay
' Save The Note-On Data For The Last Note Of Each Track.
For K = 0 To 15
Tmp1(K) = Ptrns(K, StartPos + 15).bNoteOn
Next
' Copy The Remaining Note On Data For Each Track
' In Another Temp Array But Move It All To The Right
' By One Beat (One Element Number).
For R = 0 To 15
For C = 0 To 14
Tmp2(R, C + 1).bNoteOn = Ptrns(R, C + StartPos).bNoteOn
Ptrns(R, C + StartPos).bNoteOn = False
Next
Next
' Copy The Last Notes Of Each Track To
' The First Position In Each Track
For K = 0 To 15
Tmp2(K, 0).bNoteOn = Tmp1(K)
Next
' Update The Pattern Array With The New Note-On Positions.
For R = 0 To 15
For C = 0 To 15
Ptrns(R, C + StartPos).bNoteOn = Tmp2(R, C).bNoteOn
Next
Next
' Show The Status Of The Tracks.
ShowTrackData StartPos
' Data Has Changed.
bDirty = True
End Sub
Private Sub MnuSongMode_Click()
StopPlay
' Show The Song Creation Form.
FrmSong.Show 1
End Sub
Private Sub PicTrack_MouseDown(Idx%, Button%, Shift%, X!, Y!)
' Home Made Button Stuff.
If Button = 1 Then
PadNo = X \ 17
SetRect PadRct, PadNo * 17, 0, PadNo * 17 + 17, 17
If Ptrns(Idx, StartPos + PadNo).bNoteOn = False Then
DrawEdge PicTrack(Idx).hDC, PadRct, 10, 15
PicTrack(Idx).Refresh
End If
End If
End Sub
Private Sub PicTrack_MouseMove(Idx%, Button%, Shift%, X!, Y!)
' Home Made Button Stuff.
If Button = 1 Then
If PtInRect(PadRct, X, Y) Then
If Ptrns(Idx, StartPos + PadNo).bNoteOn = False Then
DrawEdge PicTrack(Idx).hDC, PadRct, 10, 15
End If
Else
If Ptrns(Idx, StartPos + PadNo).bNoteOn = False Then
DrawEdge PicTrack(Idx).hDC, PadRct, 5, 15
End If
End If
PicTrack(Idx).Refresh
End If
End Sub
Private Sub PicTrack_MouseUp(Idx%, Button%, Shift%, X!, Y!)
' Home Made Button Stuff.
If Button = 1 Then
If PtInRect(PadRct, X, Y) Then
If Ptrns(Idx, StartPos + PadNo).bNoteOn Then
DrawEdge PicTrack(Idx).hDC, PadRct, 5, 15
Ptrns(Idx, StartPos + PadNo).bNoteOn = False
Else
DrawEdge PicTrack(Idx).hDC, PadRct, 10, 15
Ptrns(Idx, StartPos + PadNo).bNoteOn = True
bDirty = True
End If
Else
If Ptrns(Idx, StartPos + PadNo).bNoteOn Then
DrawEdge PicTrack(Idx).hDC, PadRct, 10, 15
Else
DrawEdge PicTrack(Idx).hDC, PadRct, 5, 15
End If
End If
PicTrack(Idx).Refresh
End If
End Sub
Private Sub VsbInst_Change(Idx%)
Dim K%, N&, V&
V = VsbVol(Idx).Value
N = VsbInst(Idx).Value
' Instrument Names Are In A "StringTable" In The Resource File.
LblInst(Idx).Caption = LoadResString(N)
If bExit Then Exit Sub
For K = 0 To 15
' Update That Section Of The Pattern Array That Corresponds
' To The Pattern The User Is Editing With The New Instrument.
Ptrns(Idx, StartPos + K).PercName = N
' Update The Midi Message To Match.
Ptrns(Idx, StartPos + K).MidiMsg = V * &H10000 + N * &H100 + &H99
Next
' Data Has Changed.
bDirty = True
End Sub
Private Sub VsbVol_Change(Idx%)
Dim K%, N&, V&
V = VsbVol(Idx).Value
N = VsbInst(Idx).Value
' Display The New Volume.
LblVol(Idx).Caption = Format(V, "000")
If bExit Then Exit Sub
For K = 0 To 15
' Update That Section Of The Pattern Array That Corresponds
' To The Pattern The User Is Editing With The New Volume Setting.
Ptrns(Idx, StartPos + K).PercVol = V
' Update The Midi Message To Match.
Ptrns(Idx, StartPos + K).MidiMsg = V * &H10000 + N * &H100 + &H99
Next
' Data Has Changed.
bDirty = True
End Sub
Private Sub VsbTempo_Change()
' Calculate Firing Interval For Multimedia Timer.
NewTempo = (60000 / VsbTempo.Value) / 4 ' Divide By 4 (Beats Per Quarter Note).
' Update Tempo Caption.
LblTempo.Caption = Format(VsbTempo.Value, "000")
' Data Has Changed.
bDirty = True
End Sub
Private Sub VsbPtrnNo_Change()
Dim K%, Pn%
Pn = VsbPtrnNo.Value
LblPtrnNo.Caption = Format(Pn, "000")
If bPatternPlaying Then
' Let The Timer Thats Doing The Sequencing Know
' That The Pattern Number Has Changed.
bPatternChanged = True
' Calc New Start Pos To Work From In Pattern Array.
NewStartPos = (Pn - 1) * 16
' Calc New End Pos To Work From In Pattern Array.
NewEndPos = NewStartPos + 15
bExit = True
' Update Interface To Reflect The Status Of The New Pattern.
For K = 0 To 15
VsbInst(K).Value = Ptrns(K, NewStartPos).PercName
VsbVol(K).Value = Ptrns(K, NewStartPos).PercVol
Next
bExit = False
ShowTrackData NewStartPos
Else
' Set Pattern Changed To False (Pattern Isn't Playing).
bPatternChanged = False
' Calc New Start Pos To Work From In Pattern Array.
StartPos = (Pn - 1) * 16
' Calc New End Pos To Work From In Pattern Array.
EndPos = StartPos + 15
' Update Interface To Reflect The Status Of The New Pattern.
bExit = True
For K = 0 To 15
VsbInst(K).Value = Ptrns(K, StartPos).PercName
VsbVol(K).Value = Ptrns(K, StartPos).PercVol
Next
bExit = False
ShowTrackData StartPos
End If
End Sub
Private Function Discard() As Boolean
Dim Msg$
' Prep Message.
Msg = "Save changes to " & CurTitle & "?"
Select Case MsgBox(Msg, vbQuestion + vbYesNoCancel, "MicroKit - Save Changes?")
Case vbYes
' User Wishes To Save.
' Determine Type Of Save.
If CurTitle = "Untitled" Then
MnuSaveAs_Click
Else
MnuSave_Click
End If
' If The Form Is About To Unload,
' Need To Know If Save Was Successful (For An Abort).
Discard = bFileSaved
Case vbNo
' User Doesn't Want To Save.
bDirty = False
Discard = True
Case vbCancel
' User Cancelled.
Discard = False
End Select
End Function
Private Sub MnuExit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel%)
StopPlay
If bDirty Then
' Prompt User To Save...
If Not Discard Then
' User Cancelled Or A Save Failed.
Cancel = 1
Exit Sub
End If
End If
' If Still Sequencing, Kill The Timer
If TimerID <> 0 Then timeKillEvent TimerID
' Inform Windows We No Longer Require Access
' To It's Multi Media Timer Services.
timeEndPeriod BestResolution
' Stop Any Midi Notes That May Be Sounding.
midiOutReset hMidiOut
' Close The Midi Device.
midiOutClose hMidiOut
' Save Recent File's.
SaveRecentFileList MnuRecent
' Save Last Working Directory.
SaveLastDir
End Sub
Private Sub LblInst_OLEDragDrop(Idx%, Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub LblVol_OLEDragDrop(Idx%, Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub PicTrack_OLEDragDrop(Idx%, Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub Form_OLEDragDrop(Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub LblTempo_OLEDragDrop(Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub LblPtrnNo_OLEDragDrop(Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub CmdPatternRun_OLEDragDrop(Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub CmdPatternStop_OLEDragDrop(Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub Lbl_OLEDragDrop(Idx%, Data As DataObject, Effect&, Button%, Shift%, X!, Y!)
' Call Sub To Handle DragDrop.
HandleDrop Data
End Sub
Private Sub HandleDrop(InData As DataObject)
Dim Msg$
StopPlay
' See If We Need To Save Any Changes Before Proceeding.
If bDirty Then
If Not Discard Then Exit Sub
End If
' Get The Name Of The Dropped File.
DroppedFile = InData.Files.Item(1)
If ReadDataFromFile(DroppedFile) Then
' File Is Valid, Proceed.
CurFile = GetShortPath(DroppedFile)
CurTitle = GetTitle(DroppedFile)
ContinueUpdate
Else
' Invalid File.
Msg = "Unable to open the file " & GetTitle(DroppedFile)
MsgBox Msg, vbExclamation, "MicroKit - Error"
End If
End Sub
Private Sub MnuAbout_Click()
FrmAbout.Show 1, Me
End Sub