VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form Form1 
   Caption         =   "Melissas Musikkiste v1.0 by F.K. 1999"
   ClientHeight    =   8490
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9330
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "midpiano.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8490
   ScaleWidth      =   9330
   StartUpPosition =   1  '所屬視窗中央
   Begin VB.TextBox Text6 
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   36
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3255
      Left            =   2520
      MultiLine       =   -1  'True
      TabIndex        =   48
      Top             =   3120
      Width           =   4335
   End
   Begin VB.CommandButton Command1 
      Caption         =   ",F"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   10
      Left            =   8400
      TabIndex        =   47
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   ",E"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   9
      Left            =   7560
      TabIndex        =   46
      Top             =   240
      Width           =   855
   End
   Begin VB.PictureBox Picture2 
      BackColor       =   &H00FFFFFF&
      Height          =   615
      Index           =   7
      Left            =   6000
      Picture         =   "midpiano.frx":044A
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   45
      Top             =   2160
      Width           =   375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "D "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   8
      Left            =   6720
      TabIndex        =   44
      Top             =   240
      Width           =   855
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   975
      Left            =   0
      Picture         =   "midpiano.frx":0DEC
      ScaleHeight     =   915
      ScaleWidth      =   9195
      TabIndex        =   43
      Top             =   840
      Width           =   9255
      Begin VB.Line Line2 
         BorderColor     =   &H0000FF00&
         BorderWidth     =   4
         Index           =   3
         X1              =   360
         X2              =   360
         Y1              =   840
         Y2              =   120
      End
      Begin VB.Line Line2 
         BorderColor     =   &H0000FF00&
         BorderWidth     =   4
         Index           =   2
         X1              =   120
         X2              =   120
         Y1              =   120
         Y2              =   840
      End
      Begin VB.Line Line2 
         BorderColor     =   &H0000FF00&
         BorderWidth     =   4
         Index           =   1
         X1              =   120
         X2              =   360
         Y1              =   840
         Y2              =   840
      End
      Begin VB.Line Line2 
         BorderColor     =   &H0000FF00&
         BorderWidth     =   4
         Index           =   0
         X1              =   120
         X2              =   360
         Y1              =   120
         Y2              =   120
      End
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   6
      Left            =   5400
      Picture         =   "midpiano.frx":19EEE
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   42
      Top             =   2160
      Width           =   375
   End
   Begin VB.CommandButton Command2 
      Caption         =   "OK"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6960
      TabIndex        =   41
      Top             =   2760
      Width           =   855
   End
   Begin VB.TextBox Text5 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   6960
      TabIndex        =   40
      Top             =   2520
      Width           =   855
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   0
      Left            =   1080
      Picture         =   "midpiano.frx":1AA70
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   28
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   0
      Left            =   960
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   34
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   5
      Left            =   4680
      Picture         =   "midpiano.frx":1B5F2
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   33
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   4
      Left            =   3960
      Picture         =   "midpiano.frx":1C174
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   32
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   3
      Left            =   3240
      Picture         =   "midpiano.frx":1CCF6
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   31
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   2
      Left            =   2520
      Picture         =   "midpiano.frx":1D878
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   30
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Picture2 
      Height          =   615
      Index           =   1
      Left            =   1800
      Picture         =   "midpiano.frx":1E3FA
      ScaleHeight     =   555
      ScaleWidth      =   315
      TabIndex        =   29
      Top             =   2160
      Width           =   375
   End
   Begin VB.ListBox List4 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3180
      Left            =   0
      TabIndex        =   27
      Top             =   3120
      Width           =   2535
   End
   Begin VB.CommandButton Command15 
      Caption         =   "OK"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6960
      TabIndex        =   26
      Top             =   3840
      Width           =   855
   End
   Begin VB.TextBox Text4 
      Height          =   285
      Left            =   7440
      TabIndex        =   25
      Top             =   3570
      Width           =   375
   End
   Begin VB.TextBox Text3 
      Height          =   285
      Left            =   6960
      TabIndex        =   24
      Top             =   3600
      Width           =   375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "C "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   7
      Left            =   5880
      TabIndex        =   19
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "H "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   6
      Left            =   5040
      TabIndex        =   18
      Top             =   240
      Width           =   855
   End
   Begin VB.ListBox List2 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   450
      Left            =   7920
      TabIndex        =   17
      Top             =   2760
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.CommandButton Command7 
      Caption         =   "Lied speichern"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6960
      TabIndex        =   15
      Top             =   5880
      Width           =   2295
   End
   Begin VB.FileListBox File2 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1845
      Left            =   0
      TabIndex        =   14
      Top             =   6720
      Width           =   9255
   End
   Begin VB.CommandButton Command5 
      Caption         =   "轉成Midi檔 (note.mid)"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   975
      Left            =   6960
      TabIndex        =   13
      Top             =   4200
      Width           =   2295
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Noten l飉chen"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   6960
      TabIndex        =   12
      Top             =   5280
      Width           =   2295
   End
   Begin VB.TextBox Text2 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   6960
      TabIndex        =   10
      Top             =   2280
      Width           =   855
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   6960
      TabIndex        =   9
      Top             =   2040
      Width           =   855
   End
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "Courier"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2010
      Left            =   7920
      TabIndex        =   7
      Top             =   2040
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "A "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   5
      Left            =   4200
      TabIndex        =   6
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "G "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   4
      Left            =   3360
      TabIndex        =   5
      Top             =   240
      Width           =   855
   End
   Begin MCI.MMControl MMControl1 
      Height          =   495
      Left            =   2280
      TabIndex        =   4
      Top             =   5520
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   873
      _Version        =   393216
      PlayEnabled     =   -1  'True
      BackEnabled     =   -1  'True
      PrevVisible     =   0   'False
      PauseVisible    =   0   'False
      StepVisible     =   0   'False
      StopVisible     =   0   'False
      RecordVisible   =   0   'False
      EjectVisible    =   0   'False
      Shareable       =   -1  'True
      Enabled         =   0   'False
      DeviceType      =   "Sequencer"
      FileName        =   ""
   End
   Begin VB.CommandButton Command1 
      Caption         =   "F "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   3
      Left            =   2520
      TabIndex        =   3
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "E "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   2
      Left            =   1680
      TabIndex        =   2
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "D'"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   1
      Left            =   840
      TabIndex        =   1
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "C'"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Index           =   0
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   855
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   1
      Left            =   1680
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   35
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   2
      Left            =   2400
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   36
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   3
      Left            =   3120
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   37
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   4
      Left            =   3840
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   38
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.PictureBox Picture3 
      Appearance      =   0  '平面
      BackColor       =   &H0000FF00&
      BorderStyle     =   0  '沒有框線
      FillColor       =   &H0000FF00&
      ForeColor       =   &H80000008&
      Height          =   855
      Index           =   5
      Left            =   4560
      ScaleHeight     =   855
      ScaleWidth      =   615
      TabIndex        =   39
      Top             =   2040
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Label Label10 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "tausche"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   6960
      TabIndex        =   23
      Top             =   3360
      Width           =   855
   End
   Begin VB.Label Label7 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "Pause / Noten l鄚ge"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   0
      TabIndex        =   22
      Top             =   1800
      Width           =   6855
   End
   Begin VB.Label Label5 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "N O T E N"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   0
      TabIndex        =   21
      Top             =   0
      Width           =   9255
   End
   Begin VB.Label Label4 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "Instrument"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   -2640
      TabIndex        =   20
      Top             =   2880
      Width           =   2535
   End
   Begin VB.Label Label3 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "gespeicherte Lieder"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   0
      TabIndex        =   16
      Top             =   6480
      Width           =   9255
   End
   Begin VB.Label Label2 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "Eingeben"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   6960
      TabIndex        =   11
      Top             =   1800
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  '置中對齊
      BackColor       =   &H00FF0000&
      Caption         =   "Notenliste"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   7920
      TabIndex        =   8
      Top             =   1800
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim notenzeit As Integer
Dim iii As Integer
Dim gesch As Integer
Dim note(0 To 2000) As Integer
Dim lang(0 To 2000) As Integer
Dim aufzeich As Boolean


Private Sub Command1_Click(Index As Integer)

Call drawgr(Command1(Index).Caption, 0)

Dim dauer As Long
Dim lan As Integer
a$ = Command1(Index).Caption

filen = App.Path + "\Note.Mid"

lan = notenzeit

Call writenote(List4.ListIndex, Command1(Index).Caption, lan)

MMControl1.Command = "Close"
MMControl1.FileName = "filen"
MMControl1.Command = "Open"
MMControl1.Command = "Stop"
MMControl1.Command = "Seek"
MMControl1.Command = "Play"
w = Command1(Index).Caption
If Len(w) < 2 Then w = w + " "
w = w + "|"

If aufzeich = True Then
  List1.AddItem w
  List1.ListIndex = List1.ListCount - 1
  lan = notenzeit
  le = Mid$(Str$(lan), 2, 1)
  b$ = List1.List(List1.ListIndex)
  c$ = Mid$(Str$(List4.ListIndex), 2, Len(Str$(List4.ListIndex)) - 1)
  If Len(c$) < 2 Then c$ = "0" + c$
  b$ = b$ + le + "|" + c$
  List1.List(List1.ListIndex) = b$
End If



End Sub
Sub warte(i As Double)
b = i / 30
t = Timer
wart:
If t + b > Timer Then GoTo wart
End Sub

Private Sub Command1_KeyPress(Index As Integer, KeyAscii As Integer)

If Chr$(KeyAscii) = "h" Then Call Command1_Click(0)
If Chr$(KeyAscii) = "a" Then Call Command1_Click(1)
If Chr$(KeyAscii) = "c" Then Call Command1_Click(2)
If Chr$(KeyAscii) = "d" Then Call Command1_Click(3)
If Chr$(KeyAscii) = "g" Then Call Command1_Click(4)
If Chr$(KeyAscii) = "e" Then Call Command1_Click(5)
If Chr$(KeyAscii) = "f" Then Call Command1_Click(6)
If Chr$(KeyAscii) = "p" Then Call Command1_Click(7)


End Sub



Private Sub Command15_Click()
For i = 0 To List1.ListCount - 1
If InStr(List1.List(i), UCase$(Text3.Text)) > 0 Then
   c$ = UCase$(List1.List(i))
   u = InStr(c$, UCase$(Text3.Text))
   Mid$(c$, u, 1) = Text4.Text
   List1.List(i) = c$
End If
Next i
End Sub

Private Sub Command2_Click()

If Len(Text1.Text) <> 2 Then
   If Len(Text1.Text) > 2 Then
      Text1.Text = Left$(Text1.Text, 2)
   Else
      If Len(Text1.Text) = 0 Then Text1.Text = "00" + Text1.Text
      If Len(Text1.Text) = 1 Then Text1.Text = "0" + Text1.Text
   End If
End If
If Len(Text2.Text) < 1 Then Text2.Text = "3"
If Len(Text2.Text) > 1 Then Text2.Text = "3"

If Len(Text5.Text) < 1 Then Text5.Text = "00"
If Len(Text5.Text) > 1 Then Text5.Text = "00"

c$ = Text1.Text + "|" + Text2.Text + "|" + Text5.Text
List1.List(List1.ListIndex) = c$


End Sub


Private Sub Command4_Click()
List1.Clear
End Sub

Private Sub Command5_Click()

   Call writemid
   filen = App.Path + "\Note.Mid"
   MMControl1.Command = "Close"
   MMControl1.FileName = "filen"
   MMControl1.Command = "Open"
   MMControl1.Command = "Stop"
   MMControl1.Command = "Seek"
   MMControl1.Command = "Play"

End Sub


Private Sub Command7_Click()

X = InputBox("Bitte den Namen des Liedes eingeben.", Speichern, File2.List(File2.ListIndex))
If X = "" Then Exit Sub
If InStr(X, ".LID") < 1 Then X = X + ".LID"
Open App.Path + "\" + X For Output As 1
  For i = 0 To List1.ListCount - 1
    Print #1, List1.List(i)
  Next i
Close 1
File2.Refresh
End Sub



Private Sub File2_Click()
List1.Clear
Open App.Path + "\" + File2.FileName For Input As 1
  While Not EOF(1)
    Line Input #1, a$
    If Len(a$) < 5 Then a$ = a$ + "|00"
    List1.AddItem a$
  Wend
Close 1
End Sub

Private Sub File2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then
   X = MsgBox("Soll die Datei gel飉cht werden ?", vbYesNo, "Frage")
   If X = 6 Then
      Kill App.Path + "\" + File2.FileName
      File2.Refresh
   End If
 End If
End Sub

Private Sub Form_Load()

List4.AddItem "Acoustic Grand"
List4.AddItem "Bright Arcoustic"
List4.AddItem "Electric Grand"
List4.AddItem "Honky-Tonk"
List4.AddItem "Elektrisches Klavier -1-"
List4.AddItem "Elektrisches Klavier -2-"
List4.AddItem "Harpsichord"
List4.AddItem "Calv"
List4.AddItem "Celesta"
List4.AddItem "Glockenspiel"
List4.AddItem "Music Box"
List4.AddItem "Vibraphone"
List4.AddItem "Marimba"
List4.AddItem "Xylophon"
List4.AddItem "Tubular Bells"
List4.AddItem "Dulcimer"
List4.AddItem "Dreh Orgel"
List4.AddItem "Percussive Orgel"
List4.AddItem "Rock Orgel"
List4.AddItem "Kirchen Orgel"
List4.AddItem "Reed Orgel"
List4.AddItem "Accordeon"
List4.AddItem "Harmionka"
List4.AddItem "Tango Accordeon"
List4.AddItem "Arkustische Gitarre (nylon)"
List4.AddItem "Arkustische Gitarre (stahl)"
List4.AddItem "Elektrische Gitarre (jazz)"
List4.AddItem "Elektrische Gitarre (rein)"
List4.AddItem "Elektrische Gitarre (ged鄝pft)"
List4.AddItem "Overdrive Gitarre"
List4.AddItem "Distortion Gitarre"
List4.AddItem "Harmonische Gitarre"
List4.AddItem "Arkustischer Bass"
List4.AddItem "Elektrischer Bass (finger)"
List4.AddItem "Elektrischer Bass (zupf)"
List4.AddItem "Fretless Bass"
List4.AddItem "Slap Bass -1-"
List4.AddItem "Slap Bass -2-"
List4.AddItem "Synthy Bass -1-"
List4.AddItem "Synthy Bass -2-"
List4.AddItem "Violine"
List4.AddItem "Viola"
List4.AddItem "Cello"
List4.AddItem "Kontrabass"
List4.AddItem "Tremolo Strings"
List4.AddItem "Pizzicato Strings"
List4.AddItem "Orchester Strings"
List4.AddItem "Timpani"
List4.AddItem "String Ensemble -1-"
List4.AddItem "String Ensemble -2-"
List4.AddItem "Synthy Strings -1-"
List4.AddItem "Synthy Strings -2-"
List4.AddItem "Chor Aahs"
List4.AddItem "Chor Oohs"
List4.AddItem "Synthy Ton"
List4.AddItem "Orchester Schlag"
List4.AddItem "Trompete"
List4.AddItem "Trombone"
List4.AddItem "Tuba"
List4.AddItem "Ged鄝pfte Trompete"
List4.AddItem "Franz. Horn"
List4.AddItem "Brass Selection"
List4.AddItem "Synthy Brass -1-"
List4.AddItem "Synthy Brass -2-"

List4.ListIndex = 0

Form1.Show

MMControl1.Notify = True
MMControl1.Wait = True
MMControl1.Shareable = False
MMControl1.DeviceType = "Sequencer"

aufzeich = True

Picture3(3).Visible = True
notenzeit = 3


File2.Pattern = "*.LID"
File2.Path = App.Path

Call Command1_Click(0)
List1.Clear

End Sub

Private Sub List1_DblClick()
  Dim c As Integer
  a = Left$(List1.List(List1.ListIndex), 2)
  b = Mid$(List1.List(List1.ListIndex), 4, 1)
  c = Val(Right$(List1.List(List1.ListIndex), 2))
  Text1.Text = a
  Text2.Text = b
  Text5.Text = c
  
  List4.ListIndex = c
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
If List1.ListIndex > -1 Then
If KeyCode = 46 Then
List1.RemoveItem (List1.ListIndex)
End If
End If
If KeyCode = 45 Then
List2.Clear
  For i = 0 To List1.ListIndex
    List2.AddItem List1.List(i)
  Next i
  List2.AddItem "X|X"
  For i = List1.ListIndex + 1 To List1.ListCount - 1
    List2.AddItem List1.List(i)
  Next i
List1.Clear
For i = 0 To List2.ListCount - 1
  List1.AddItem List2.List(i)
  If List2.List(i) = "X|X" Then List1.ListIndex = i
Next i

End If

End Sub
Sub writenote(instrument As Integer, note As String, lang As Integer)
hexxinstru = Hex(instrument)

Dim hexwert As Byte
  
  If note = "H " Then note = "47"
  If note = "A " Then note = "45"
  If note = "C " Then note = "48"
  If note = "D " Then note = "4A"
  If note = "G " Then note = "43"
  If note = "E " Then note = "40"
  If note = "F " Then note = "41"
  If note = "C'" Then note = "3C"
  If note = "D'" Then note = "3E"
  If note = ",E" Then note = "4B"
  If note = ",F" Then note = "4D"
  If note = "P3" Then note = "AA"
  If note = "P2" Then note = "AB"

If Len(hexxinstru) = 1 Then hexxinstru = "0" + hexxinstru

txt = txt + "4D546864"
txt = txt + "00000006"
txt = txt + "0001000200F0"
txt = txt + "4D54726B"
txt = txt + "00000021"
txt = txt + "00FF7F07050F120303007F"
txt = txt + "00FF0307547261636B2030"
txt = txt + "00FF51030B71B0"
txt = txt + "01FF2F00"
txt = txt + "4D54726B"
txt = txt + "0000003D"
txt = txt + "00C0" + hexxinstru
txt = txt + "00FF7F05050F090008"
txt = txt + "00FF0307547261636B2031"
txt = txt + "00FF200100"
txt = txt + "00FF7F103F0F3F6279204672616E6B204B6C6579"
txt = txt + "0090" + note + "7F" + "817080" + note + "00"
txt = txt + "01FF2F00"

i = 0
Open App.Path + "\note.mid" For Output As #1
Close #1
Open App.Path + "\note.mid" For Binary As #1 Len = 1
For i = 1 To Len(txt) Step 2
dl = dl + 1
c = Mid(txt, i, 2)
hexwert = CDec("&H" + c)
Put #1, dl, hexwert
Next i
Close #1

End Sub
Sub writemid()


Dim hexwert As Byte
Dim note As String
Dim notz As String

txt = txt + "4D546864"
txt = txt + "00000006"
txt = txt + "0001000200F0"
txt = txt + "4D54726B"
txt = txt + "00000021"
txt = txt + "00FF7F07050F120303007F"
txt = txt + "00FF0307547261636B2030"
txt = txt + "00FF51030B71B0"
txt = txt + "01FF2F00"
txt = txt + "4D54726B"
txt = txt + "0000003D"
txt = txt + "00C000"
txt = txt + "00FF7F05050F090008"
txt = txt + "00FF0307547261636B2031"
txt = txt + "00FF200100"
txt = txt + "00FF7F103F0F3F6279204672616E6B204B6C6579"

insta = "00"
For i = 0 To List1.ListCount - 1
  c = List1.List(i)
  notii = Mid(c, 1, 2)
  If notii = "H " Then note = "47"
  If notii = "A " Then note = "45"
  If notii = "C " Then note = "48"
  If notii = "D " Then note = "4A"
  If notii = "G " Then note = "43"
  If notii = "E " Then note = "40"
  If notii = "F " Then note = "41"
  If notii = "C'" Then note = "3C"
  If notii = "D'" Then note = "3E"
  If notii = ",E" Then note = "4B"
  If notii = ",F" Then note = "4D"
  If notii = "P3" Then note = "AA"
  If notii = "P2" Then note = "AB"
 
  instrument = Val(Mid(c, 6, 2))
  hexxinstru = Hex(instrument)
  If Len(hexxinstru) = 1 Then hexxinstru = "0" + hexxinstru
  If insta <> hexxinstru Then
     txt = txt + "00C0" + hexxinstru
     meng = meng + 3
     insta = hexxinstru
  End If
  nz = Val(Mid(c, 4, 1))
  If nz = 0 Then notz = "1E80" + note + "00"
  If nz = 1 Then notz = "3C80" + note + "00"
  If nz = 2 Then notz = "7880" + note + "00"
  If nz = 3 Then notz = "817080" + note + "00"
  If nz = 4 Then notz = "836080" + note + "00"
  If nz = 5 Then notz = "874080" + note + "00"
  w$ = "0090" + note + "7F" + notz
  If note = "AA" Then w$ = "709000408170800000"
  If note = "AB" Then w$ = "009000408100800000"
  
  txt = txt + w$
  meng = meng + (Len(w$) / 2)

Next i

meng = meng - 9
Mes = CDec("&H" + Mid(txt, 119, 8))
m = Mes + meng
hxm = Hex(m)
If Len(hxm) < 8 Then hxm = String$(8 - Len(hxm), "0") + hxm
Mid(txt, 119, 8) = hxm

txt = txt + "01FF2F00"

i = 0
Open App.Path + "\note.mid" For Output As 1
Close 1
Open App.Path + "\note.mid" For Binary As 1 Len = 1

For i = 1 To Len(txt) Step 2
  dl = dl + 1
  c = Mid(txt, i, 2)
  hexwert = CDec("&H" + c)
  Put #1, dl, hexwert
Next i
Close 1
End Sub

Private Sub List4_Click()
If List1.ListIndex > 0 Then
   c$ = Left$(List1.List(List1.ListIndex), 5)
   instru = Mid$(Str$(List4.ListIndex), 2, Len(Str$(List4.ListIndex)) - 1)
   If Len(instru) < 2 Then instru = "0" + instru
   List1.List(List1.ListIndex) = c$ + instru
End If
End Sub

Private Sub List4_DblClick()

instru = Mid$(Str$(List4.ListIndex), 2, Len(Str$(List4.ListIndex)) - 1)
If Len(instru) < 2 Then instru = "0" + instru

For i = 0 To List1.ListCount - 1
  c$ = List1.List(i)
  c$ = Left$(c$, 5) + instru
  List1.List(i) = c$
Next i

End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

fakx = Picture1.Width / 11
Dim wert As Integer
wert = Int(X / fakx)
Call Command1_Click(wert)

End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

fakx = Picture1.Width / 11
Dim wert As Integer
wert = Int(X / fakx)

Call drawgr(Mid$(Str$(wert), 2, Len(Str$(wert)) - 1), 1)

End Sub

Private Sub Picture2_Click(Index As Integer)
If Index = 6 Then List1.AddItem "P3|0|00": Exit Sub
If Index = 7 Then List1.AddItem "P2|0|00": Exit Sub
For i = 0 To 5
Picture3(i).Visible = False
Next i
Picture3(Index).Visible = True
notenzeit = Index
End Sub

Sub drawgr(no As String, mk As Integer)
If mk = 0 = 2 Then
If no = "H " Then X = 7
If no = "A " Then X = 6
If no = "C " Then X = 8
If no = "D " Then X = 9
If no = "G " Then X = 5
If no = "E " Then X = 3
If no = "F " Then X = 4
If no = "C'" Then X = 1
If no = "D'" Then X = 2
If no = ",E" Then X = 10
If no = ",F" Then X = 11
X = X - 1
Else
X = Val(no)
End If

fakx = Picture1.Width / 11
faky = Picture1.Height / 21
Line2(0).X1 = X * fakx
Line2(0).X2 = (X + 1) * fakx
Line2(0).Y1 = faky
Line2(0).Y2 = faky

Line2(1).X1 = X * fakx
Line2(1).X2 = (X + 1) * fakx
Line2(1).Y1 = 19 * faky
Line2(1).Y2 = 19 * faky

Line2(2).X1 = X * fakx
Line2(2).X2 = X * fakx
Line2(2).Y1 = faky
Line2(2).Y2 = 19 * faky

Line2(3).X1 = (X + 1) * fakx
Line2(3).X2 = (X + 1) * fakx
Line2(3).Y1 = faky
Line2(3).Y2 = 19 * faky

End Sub

