VERSION 5.00 Begin VB.Form main BackColor = &H00C5D8EB& BorderStyle = 1 'Fest Einfach ClientHeight = 9645 ClientLeft = 315 ClientTop = 660 ClientWidth = 12135 ForeColor = &H80000008& Icon = "VglMidi.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False PaletteMode = 1 'ZReihenfolge ScaleHeight = 9645 ScaleWidth = 12135 Begin VB.CommandButton Command13 BackColor = &H0080FFFF& Caption = "D --> C" Height = 225 Left = 8925 Style = 1 'Grafisch TabIndex = 59 TabStop = 0 'False ToolTipText = "KOMPOSI.rpp parken (--> Clipboard HHHHH.rpp)" Top = 510 Visible = 0 'False Width = 960 End Begin VB.CommandButton Command12 BackColor = &H009BC4FF& Caption = "D <-- C" Height = 225 Left = 11010 Style = 1 'Grafisch TabIndex = 58 TabStop = 0 'False ToolTipText = $"VglMidi.frx":08CA Top = 510 Visible = 0 'False Width = 960 End Begin VB.CommandButton Command11 BackColor = &H0080FFFF& Caption = "D --> C" Height = 225 Left = 9975 Style = 1 'Grafisch TabIndex = 57 TabStop = 0 'False ToolTipText = " aktuelles KOMPOSI-HCR.rpp parken (--> Clipboard HHHHH.rpp)" Top = 510 Visible = 0 'False Width = 960 End Begin VB.CommandButton Samplemix BackColor = &H00C0C0C0& Caption = "SM" Height = 555 Left = 3075 Style = 1 'Grafisch TabIndex = 56 TabStop = 0 'False ToolTipText = "Samplemix: Mischen von Sample-Sammlungen, die bereits in verschiedenen Reaperdateien aufgenommen wurden" Top = 1020 Width = 345 End Begin VB.CommandButton Command10 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Dateien" Height = 225 Left = 11010 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 55 TabStop = 0 'False ToolTipText = "Gespeicherte Dateien anzeigen (Komposi-Doku.txt aufrufen)" Top = 1020 Width = 960 End Begin VB.CommandButton Load BackColor = &H00E0E0E0& Caption = "Load" Height = 555 Left = 2460 Style = 1 'Grafisch TabIndex = 54 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0959 Top = 1020 Width = 555 End Begin VB.CommandButton Speichern BackColor = &H009BC4FF& Caption = "Store" Height = 555 Left = 1845 Style = 1 'Grafisch TabIndex = 53 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0A3F Top = 1020 Width = 555 End Begin VB.CommandButton Reaperstart2 Appearance = 0 '2D BackColor = &H00E0E0E0& Caption = "Samples" Height = 405 Left = 11010 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 52 TabStop = 0 'False ToolTipText = "Reaper mit Komposi-HCR.rpp starten. Hier kann man das KLANGMATERIAL anhören und erweitern!" Top = 540 Width = 960 End Begin VB.CommandButton Command9 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Samples" Height = 225 Left = 7890 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 51 TabStop = 0 'False ToolTipText = "Detaillierte Infos zu den Samples anzeigen (Komposi-HCR.txt aufrufen)" Top = 1020 Width = 960 End Begin VB.CommandButton NeueRegelInfo BackColor = &H009BC4FF& Height = 570 Left = 11310 Style = 1 'Grafisch TabIndex = 50 TabStop = 0 'False ToolTipText = "Die Anleitung zum Einbau neuer Regeln wird angezeigt" Top = 8955 Width = 225 End Begin VB.CommandButton erklaplus BackColor = &H00FFFFFF& Caption = "-->" Height = 555 Left = 11295 Style = 1 'Grafisch TabIndex = 49 TabStop = 0 'False Top = 7995 Width = 360 End Begin VB.CommandButton erklaminus BackColor = &H00FFFFFF& Caption = "<--" Height = 555 Left = 5085 Style = 1 'Grafisch TabIndex = 48 TabStop = 0 'False Top = 7995 Width = 360 End Begin VB.TextBox Text1 BackColor = &H00FFFFFF& BorderStyle = 0 'Kein BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 270 Left = 4455 TabIndex = 46 Top = 3345 Visible = 0 'False Width = 1515 End Begin VB.CommandButton Ubersicht_Notenschreiben BackColor = &H0095E2B5& Caption = "E-NK" Height = 555 Left = 4260 Style = 1 'Grafisch TabIndex = 45 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0B04 Top = 8985 Width = 570 End Begin VB.CommandButton Kurzubersicht Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "INI" Height = 555 Left = 4095 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 44 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0BC8 Top = 1020 Width = 555 End Begin VB.CommandButton Ubersicht Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Regel" Height = 555 Left = 3480 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 43 TabStop = 0 'False ToolTipText = "Erläuterung der aktuell verwendeten Regel. Mit den Pfeiltasten kann man die anderen Regeln ansehen" Top = 1020 Width = 555 End Begin VB.CommandButton Command4 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Bedienung" Height = 225 Left = 4740 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 38 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0C76 Top = 1020 Width = 975 End Begin VB.CommandButton Command8 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Tondauern" Height = 225 Left = 6840 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 42 TabStop = 0 'False ToolTipText = "Tondauern-Container anzeigen (Komposi-DTC.txt aufrufen)" Top = 1020 Width = 960 End Begin VB.CommandButton Command7 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Patternmix" Height = 225 Left = 9975 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 41 TabStop = 0 'False ToolTipText = "Ergebnisse nach Ausführung von Regel 06 anzeigen (Komposi-Test2.txt aufrufen)" Top = 1020 Width = 960 End Begin VB.CommandButton Command6 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Statistik" Height = 225 Left = 8925 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 40 TabStop = 0 'False ToolTipText = "Hier wird angezeigt, wie oft sich die Töne oder Samples wiederholen ( Komposi-Test.txt aufrufen)" Top = 1020 Width = 960 End Begin VB.CommandButton Command5 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Samples 1" Height = 225 Left = 6825 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 39 TabStop = 0 'False ToolTipText = "Komposi-HC.txt aufrufen" Top = 735 Visible = 0 'False Width = 960 End Begin VB.CommandButton Command3 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Melodie" Height = 225 Left = 5790 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 37 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0D12 Top = 1020 Width = 975 End Begin VB.CommandButton Command2 Appearance = 0 '2D BackColor = &H0095E2B5& Caption = "Einstellung" Height = 225 Left = 5295 MaskColor = &H00FFFFFF& Style = 1 'Grafisch TabIndex = 36 TabStop = 0 'False ToolTipText = "Komposi.ini aufrufen" Top = 750 Visible = 0 'False Width = 975 End Begin VB.CommandButton KomposiCap BackColor = &H00FFC0C0& Caption = "NK" Height = 555 Left = 3615 Style = 1 'Grafisch TabIndex = 35 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0DC4 Top = 8985 Width = 555 End Begin VB.CommandButton KeineFrage BackColor = &H000080FF& Height = 570 Left = 2235 Style = 1 'Grafisch TabIndex = 34 TabStop = 0 'False ToolTipText = "Wenn gedrückt, keine Abfrage, ob etwas nicht überschrieben werden soll" Top = 8985 Width = 225 End Begin VB.CommandButton Patti02 BackColor = &H0095E2B5& Caption = "TXT 2" Height = 255 Left = 2535 Style = 1 'Grafisch TabIndex = 33 TabStop = 0 'False ToolTipText = "Patterndatei Komposi-Cap-02.txt öffnen, z.B. um Lautstärkewerte einzutragen" Top = 9285 Width = 975 End Begin VB.CommandButton CapellaStart02 BackColor = &H0095E2B5& Caption = "CAP 02" Height = 255 Left = 135 Style = 1 'Grafisch TabIndex = 32 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0E64 Top = 9285 Width = 975 End Begin VB.CommandButton Capellanotenwandeln2 BackColor = &H0095E2B5& Caption = "XML 02" Height = 255 Left = 1185 Style = 1 'Grafisch TabIndex = 31 TabStop = 0 'False ToolTipText = "Komposi-02.xml (von Capella) wird in ein Pattern mit Namen Komposi-Cap-02.txt gewandelt." Top = 9285 Width = 975 End Begin VB.CommandButton Patti BackColor = &H0095E2B5& Caption = "TXT 1" Height = 255 Left = 2535 Style = 1 'Grafisch TabIndex = 30 TabStop = 0 'False ToolTipText = "Patterndatei Komposi-Cap-PT.txt öffnen, z.B. um Lautstärkewerte einzutragen" Top = 8985 Width = 975 End Begin VB.CommandButton Capellanotenwandeln BackColor = &H0095E2B5& Caption = "XML 01" Height = 255 Left = 1185 Style = 1 'Grafisch TabIndex = 29 TabStop = 0 'False ToolTipText = "Komposi-01.xml (von Capella) wird in ein Pattern mit Namen Komposi-Cap-PT.txt gewandelt." Top = 8985 Width = 975 End Begin VB.CommandButton CapellaStart BackColor = &H0095E2B5& Caption = "CAP 01" Height = 255 Left = 135 Style = 1 'Grafisch TabIndex = 28 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0F04 Top = 8985 Width = 975 End Begin VB.CommandButton Command1 BackColor = &H00FFC0C0& Caption = "P" Height = 405 Left = 8925 Style = 1 'Grafisch TabIndex = 26 TabStop = 0 'False ToolTipText = "Powertaste: Töne berechnen, dann startet Reaper automatisch" Top = 540 Width = 960 End Begin VB.ListBox Zuordnung BackColor = &H00E0FFFF& BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00B70000& Height = 6390 IntegralHeight = 0 'False Left = 8115 TabIndex = 25 Top = 2445 Width = 3885 End Begin VB.CommandButton Reaperstart Appearance = 0 '2D BackColor = &H00E0E0E0& Caption = "Reaper" Height = 405 Left = 9975 Style = 1 'Grafisch TabIndex = 24 TabStop = 0 'False ToolTipText = $"VglMidi.frx":0FA4 Top = 540 Width = 960 End Begin VB.CommandButton Infos BackColor = &H00A0BFDE& Height = 195 Left = 360 Style = 1 'Grafisch TabIndex = 23 TabStop = 0 'False ToolTipText = "Programmübersicht (handgezeichneten Ablaufplan) zeigen" Top = 8745 Visible = 0 'False Width = 180 End Begin VB.ListBox inidat BackColor = &H00E0FFFF& BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 990 IntegralHeight = 0 'False Left = 4710 TabIndex = 22 TabStop = 0 'False Top = 1290 Width = 7275 End Begin VB.CommandButton Inidateischau BackColor = &H0080FF80& Caption = "Einstellung" Height = 345 Left = 1830 Style = 1 'Grafisch TabIndex = 21 TabStop = 0 'False ToolTipText = "INI-Datei öffnen und Einstellungen verändern" Top = 8865 Visible = 0 'False Width = 930 End Begin VB.CommandButton Dateiherstellung BackColor = &H00C0FFFF& Caption = "Neu" Height = 405 Left = 8925 Style = 1 'Grafisch TabIndex = 20 TabStop = 0 'False ToolTipText = $"VglMidi.frx":105A Top = 75 Width = 960 End Begin VB.ListBox List2 BackColor = &H00FFFFFF& BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 6375 IntegralHeight = 0 'False Left = 465 TabIndex = 15 Top = 2445 Width = 3525 End Begin VB.ListBox Daten BackColor = &H00E0FFFF& BeginProperty Font Name = "Courier New" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00005B00& Height = 6375 IntegralHeight = 0 'False Left = 4095 TabIndex = 14 Top = 2460 Width = 3915 End Begin VB.CommandButton Dateischau BackColor = &H0080FF80& Caption = "Melodie" Height = 345 Left = 2820 Style = 1 'Grafisch TabIndex = 3 TabStop = 0 'False ToolTipText = "Melodiedatei öffnen und Parameter manuell verändern" Top = 8850 Visible = 0 'False Width = 930 End Begin VB.VScrollBar VScroll1 Height = 5955 LargeChange = 10 Left = 105 Max = 3500 Min = 12883 SmallChange = 10 TabIndex = 13 Top = 2445 Value = 8200 Width = 240 End Begin VB.TextBox Lautbox BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 480 Left = 6225 TabIndex = 5 Text = "80" ToolTipText = "Lautstärkefaktor (1 ... 100)" Top = 1830 Visible = 0 'False Width = 1455 End Begin VB.TextBox Tempobox BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 480 Index = 0 Left = 6255 TabIndex = 4 Text = "1" ToolTipText = "Tempofaktor (0.1 ... 20)" Top = 1275 Visible = 0 'False Width = 1425 End Begin VB.CommandButton Stopp BackColor = &H00C0FFFF& Caption = "Stopp" Height = 405 Left = 11010 Style = 1 'Grafisch TabIndex = 1 Top = 75 Width = 960 End Begin VB.Timer Timer1 Left = 6750 Top = 8700 End Begin VB.CommandButton Ende BackColor = &H00E0E0E0& Caption = "E" Height = 570 Left = 11610 Style = 1 'Grafisch TabIndex = 2 TabStop = 0 'False ToolTipText = "Ende" Top = 8955 Width = 360 End Begin VB.CommandButton neutral BackColor = &H0095E2B5& Height = 330 Left = 135 Style = 1 'Grafisch TabIndex = 12 TabStop = 0 'False ToolTipText = "Finetune Reset" Top = 8505 Width = 180 End Begin VB.TextBox Text5 Alignment = 2 'Zentriert Appearance = 0 '2D BackColor = &H00C5D8EB& BorderStyle = 0 'Kein BeginProperty Font Name = "Arial" Size = 36 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 1050 Left = 6795 TabIndex = 11 TabStop = 0 'False Top = 60 Width = 1485 End Begin VB.TextBox txtNot Alignment = 2 'Zentriert Appearance = 0 '2D BackColor = &H00C5D8EB& BorderStyle = 0 'Kein BeginProperty Font Name = "Arial" Size = 36 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 1035 Left = 1815 TabIndex = 8 TabStop = 0 'False Top = 90 Width = 4980 End Begin VB.CommandButton Startknopf Appearance = 0 '2D BackColor = &H00C0FFFF& Caption = "Play" Default = -1 'True Height = 405 Left = 9975 Style = 1 'Grafisch TabIndex = 0 ToolTipText = "Melodiedatei Komposi.txt abspielen" Top = 75 Width = 960 End Begin VB.PictureBox Bender BackColor = &H00FFFFFF& DrawMode = 6 'Stift und inverse Anzeige maskieren BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2895 Left = 8970 ScaleHeight = 16211.45 ScaleMode = 0 'Benutzerdefiniert ScaleWidth = 0.349 TabIndex = 7 TabStop = 0 'False Top = 60 Visible = 0 'False Width = 390 End Begin VB.ListBox lst_sound_list BackColor = &H00E0FFFF& BeginProperty Font Name = "Microsoft Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 2220 IntegralHeight = 0 'False Left = 105 TabIndex = 9 TabStop = 0 'False Top = 90 Width = 1620 End Begin VB.ListBox List1 BackColor = &H00E0FFFF& ForeColor = &H00C0C0C0& Height = 660 IntegralHeight = 0 'False Left = 1815 TabIndex = 6 TabStop = 0 'False Top = 1650 Width = 2820 End Begin VB.Label Label5 BackColor = &H0095E2B5& Caption = "Label5" ForeColor = &H00000000& Height = 420 Left = 5010 TabIndex = 47 Top = 9030 Width = 6420 End Begin VB.Label Label4 Caption = "Label4" Height = 810 Left = 1965 TabIndex = 27 Top = 300 Width = 6315 End Begin VB.Line Leuchtfarbe6 BorderColor = &H000000FF& Index = 1 X1 = 4605 X2 = 4605 Y1 = 1290 Y2 = 2315 End Begin VB.Line Leuchtfarbe5 BorderColor = &H000000FF& Index = 0 X1 = 1815 X2 = 1815 Y1 = 1275 Y2 = 2300 End Begin VB.Line Leuchtfarbe4 BorderColor = &H000000FF& Index = 1 X1 = 1740 X2 = 1740 Y1 = 150 Y2 = 2300 End Begin VB.Line Leuchtfarbe3 BorderColor = &H000000FF& Index = 0 X1 = 90 X2 = 90 Y1 = 165 Y2 = 2315 End Begin VB.Line Leuchtfarbe2 BorderColor = &H000000FF& X1 = 345 X2 = 345 Y1 = 2620 Y2 = 8580 End Begin VB.Line Leuchtfarbe BorderColor = &H000000FF& X1 = 90 X2 = 90 Y1 = 2620 Y2 = 8580 End Begin VB.Label Label3 Alignment = 2 'Zentriert BackColor = &H00FFE0E0& Caption = "DT" Height = 255 Index = 2 Left = 6315 TabIndex = 19 Top = 8550 Visible = 0 'False Width = 270 End Begin VB.Label Label3 Alignment = 2 'Zentriert BackColor = &H00FFE0E0& Caption = "LT" Height = 255 Index = 1 Left = 5790 TabIndex = 18 Top = 8550 Visible = 0 'False Width = 360 End Begin VB.Label Label3 Alignment = 2 'Zentriert BackColor = &H00FFE0E0& Caption = "HT" Height = 255 Index = 0 Left = 5280 TabIndex = 17 Top = 8550 Visible = 0 'False Width = 450 End Begin VB.Label Label2 Alignment = 2 'Zentriert BackColor = &H00C5D8EB& Caption = "D e r M e l o d i e n s p i e l e r" BeginProperty Font Name = "Arial" Size = 18 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00000000& Height = 555 Left = 4785 TabIndex = 16 Top = 9030 Width = 6480 End Begin VB.Label Label1 Appearance = 0 '2D AutoSize = -1 'True BackColor = &H00FFE0E0& Caption = "<--- zuerst hier etwas auswählen !" BeginProperty Font Name = "Microsoft Sans Serif" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 240 Left = 2775 TabIndex = 10 Top = 240 Width = 3405 End End Attribute VB_Name = "main" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' Komposi 05.12.2013 - 04.08.2014 - aus VglMidi vom 13.08.2004 ' version = <------ go to ' ' Dieses Programm verwendet folgende Dateien: ' -------------------------------------------------------------------------------------------------- ' C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt ' C:\Arbeit\Komposi.ini Programmeinstellungsdatei, wird gelesen ' C:\Arbeit\Komposi-HC.txt Samplecontainer, wird gelesen - wurde abgelöst von Komposi-HCR.rpp ' C:\Arbeit\Komposi-HCR.rpp Reaperdatei, die als Samplecontainer dient - sie wird gelesen ' C:\Arbeit\Komposi-HCR.txt diese Datei entsteht aus Komposi-HCR.rpp und wird geschrieben - ' sie dient nur der Kontrolle ' C:\Arbeit\Komposi-DTC.txt Dauerncontainer, wird gelesen ' C:\Arbeit\Komposi-Cap-PT.txt Patterndatei 1, wird gelesen ' C:\Arbeit\Komposi-Cap-02.txt Patterndatei 2, wird gelesen ' C:\Arbeit\Komposi.txt Tönedatei, auch Melodiedatei genannt, wird geschrieben und gelesen ' C:\Arbeit\Komposi-RPP-01 Teil einer Reaperdatei, wird geschrieben ' C:\Arbeit\Komposi-RPP-02 Teil einer Reaperdatei, wird geschrieben ' C:\Arbeit\Komposi.rpp Reaperdatei, wird geschrieben ' C:\Arbeit\Komposi-Test.txt Textdatei (wird geschrieben) zur Kontrolle der Statistikfunktionen ' C:\Arbeit\Komposi-Test2.txt Textdatei (wird geschrieben) zur Kontrolle des ' Abspielverhaltens der Patterns ' C:\Arbeit\Komposi-Doku.txt Textdatei (wird geschrieben). Enthält die Namen der Sicherungsdateien ' -------------------------------------------------------------------------------------------------- ' Zusätzliche Datei: ' C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Müll.txt ' -------------------------------------------------------------------------------------------------- ' ' Dieses Programm verwendet folgende Programme: ' -------------------------------------------------------------------------------------------------- ' C:\Arbeit\Editor-K\NoteTab.exe ' C:\Programme\REAPER\reaper.exe ' C:\Programme\capella2008\capella.exe ' C:\Arbeit\IrfanView\i_view32.exe ' -------------------------------------------------------------------------------------------------- ' ' Ganz neu: Private Sub KomposiCap_Click (fertig am 26.03.2014) <----- schreibt Capellanoten! ' ' ' ' In Arbeit am 11.02.2014: Private Sub Regel04() ' Neue Regeln erstellen! ' Jetzt kommt Regel05()! - 18.02.2014 ' ' Druck auf einen Knopf bewirkt Umwandlung der MusicXML-Datei zu Komposi-PT.txt! ' Wo soll dieser Knopf hin? Da bleiben, wo er ist? ' ' NEU am 18.02.2014: ' Wir brauchen Komposi-PT nicht mehr. An dessen Stelle tritt Komposi-CAP-PT.txt, ' das eine Capelladatei zum Ursprung hat und mit Komposi konvertiert wurde. ' Komposi-Cap-PT.txt kann aber auch von Hand geschrieben oder editiert werden. ' ' Bei Knopfdruck auf START wird diese neue Patterndatei geladen (wenn die Einstellungen ' in Komposi.ini entsprechend sind). ' ' 12.02.2014 ' Wir sind gerade bei ' Private Sub Capellanotenwandeln_Click() ' Private Sub SucheWort(Suchwort) habe ich aus SucheSpurnamen() in Hukumu entwickelt ' ' 26.02.2014 ' Ideen für Regel03: ' Oktaven verbieten; bestimmte Intervalle verbieten (eine Liste 'verbotener Intervalle' erstellen). ' Sprungweite begrenzen: Patternverschiebungsintervall einschränken. ' Pattern gelegentlich rückwärts spielen ' Patterntöne in neuen Reihenfolgen spielen ' Rhythmen erzeugen! ' Patternlänge gelegentlich begrenzen - so können auch neue Rhythmen entstehen! ' Lautstärken erzeugen! ' Globale Entwicklung. Z.B. mit der Zeit wird es immer höher, oder langsamer, ' oder es tauchen immer mehr 'fremde' Töne auf. ' ' Noch ein Feature einbauen: ' Komposi-Melodiedatei (also Komposi.txt) in MusicXML umwandeln, sodass ' es von Capella gelesen werden kann! ' ' Dies ist ein Autosampler! ' Automatische Tonfolgen für MIDI und SAMPLE ' Einstellungen zu den Samples: Private Sub Reaperdateischreiben_3() ' und Private Sub TrackItem() ' ' Eingebaut am 15.03.2014: Samplestartpoint! ' ' ' Option Explicit Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function GetWindowText Lib "user32" Alias _ "GetWindowTextA" (ByVal hWnd As Long, _ ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Const WM_CLOSE = 16 Dim Divisions As Integer Dim Pitch As String ' Notenname, z.B. C, D, E Dim Alter As Integer Dim Oktave As Integer Dim HTxml As Integer Dim DTxml As Long ' war Integer <----------- Überlauf!! - 28.02.2014 Dim Dauer As Integer Dim DTvv As Integer Dim Anzahl As Integer Dim Anz As Integer Dim Vsl As Double Dim Tdd As Integer ' Tondauer direkt Dim Tda As Long ' maximale Tondauer Dim Lva As Long ' Lautstärkevariation - 19.12.2013 Dim Sto As Integer ' Startton Dim Ttn As Long ' tiefster Ton Dim Htn As Long ' höchster Ton Dim Kgl As Integer ' Intervall kleiner, größer oder gleich Dim Iva As Integer ' maximales Interval Dim Zwv As Double ' Zwischenraum zwischen den Samples: eingestellter Wert Dim Zwi As Double ' Zwischenraum zwischen den Samples: berechneter Wert Dim Snn As Integer ' Samplenummer statt Samplename Dim ZwiFaktor As Double ' Faktor für Zwi Dim Oga As Integer ' ORIGINALSAMPLEABSTAND, neu am 11.01.2014 Dim Ogs As Integer ' ORIGINALSAMPLEDAUER Dim THf As Double ' TONHÖHENÄNDERUNGSFAKTOR Dim Trs As Integer ' TRANSPONI, neu am 27.01.2014 Dim LOP As Integer ' WIEVIELELOOPS, neu am 28.01.2014 Dim SPL As Integer ' SAMPLELOOPS, neu am 13.05.2014 Dim Whd As Integer ' WIEDERHOLUNGSDISTANZ bei Regel03 (26.02.2014) Dim UGr As Integer ' UNTERGRENZE bei Regel03 (26.02.2014) Dim OGr As Integer ' OBERGRENZE bei Regel03 (26.02.2014) Dim KTR As Integer ' KLEINSTETRANS (kleinstmögliche Transposition) bei Regel03 (03.06.2014) - doch nicht verwendet Dim KTn As Integer ' KURZTON - kürzester Ton bei Regel05 (09.03.2014) Dim LTn As Integer ' LANGTON - längster Ton bei Regel05 (09.03.2014) Dim VR1 As Boolean ' VORRUCK01 - 1: Rückwärtsspielen Pattern 01 erlauben Dim VR2 As Boolean ' VORRUCK02 - 1: Rückwärtsspielen Pattern 02 erlauben Dim TKT As String ' Takt Dim VBS As Integer ' Schlüssel Dim TRN As Integer ' Transposition Dim NPZ As Integer ' Noten pro Zeile Dim KZW As Integer ' kürzester Notenwert Dim Sfi As Double ' Fade in für die Samples Dim Sfo As Double ' Fade out für die Samples Dim Pbr As Double ' Panoramabreite für die Samples Dim SAU As Double ' tiefstmögliche Sampletransposition in Regel 02 Dim SAO As Double ' höchstmögliche Sampletransposition in Regel 02 Dim SOT As Double ' SAMPLEOFFSETSTART - neu am 25.05.2014 Dim breit, ibreit As Boolean Dim ntn, Key, Keyz, KeyOk, KeyOkr, Neuwert Dim farb, mi, Stopvalu As Boolean Dim rund, korri, Laut, bildzaehler, Nmm, zeileni, Vornote As Integer Dim Tonzahl As Integer Dim version, Notnam As String Dim KT As String ' soll den Namen der Melodiedatei enthalten Dim Rt As String ' soll den Namen der Reaperdatei enthalten Dim inidatei As String ' soll den Namen der INI-Datei enthalten Dim Ini(300) As String ' in dieses Array soll die INI-Datei eingelesen werden Dim HT(100000) As Integer ' HT Dim LT(100000) As Integer ' LT Dim DT(100000) As Double ' DT ... war erst Long Dim DS(100000) As Double ' Sampledauer <-------- neu am 11.01.2014 Dim KL(100000) As String ' Klangteilchenfeld Dim DC(100000) As Double ' Dauerncontainer Dim HC(100000) As Integer ' Tonhöhencontainer <---------- neu am 05.01.2014 Dim SH(100000) As Integer ' Tonhöhencontainer <---------- neu am 05.01.2014 Dim XL(100000) As String ' MidiXML-Datei-Container <---- neu am 13.02.2014 Dim HCZl(100000) As Integer ' Container für zufällig ermittelte Samplezeilen (Zeilen in Komposi-HC.txt) ' Dim HCm(127) As Integer ' Tonvorkommenshäufigkeitscontainer - neu am 05.01.2014 ' Dim SHm(100) As Integer ' ???? <------- 06.01.2014 Dim m, m2, m3, m4, m5, m41, B As String Dim Sample, Soundfile As String Dim iHC As Integer ' Anzahl der Eintragungen / höchste Zeile in Komposi-HC.txt Dim Snd As String ' MIDI-Modus oder SAMPLE-Modus Dim TFm As String ' Tonfindungsmethode Dim Keinton As Boolean Dim Vzg As Double Dim lauti, tempi As Single Dim ivb, iVB1, iVB2 As Integer Dim zz2 As Integer Dim Atp As Long ' Autopan Dim Trz As Long ' Trackzahl Dim Ply As Double ' Sample-Tonhöhe entsprechend der Tonhöhenverschiebung (Keytranspose KTP) Dim Kyt As Double ' Sample-Tonhöhe entsprechend der Tonhöhenangabe in Komposi.txt Dim Stn As Integer ' Sampletuning Dim Stp As Integer ' Samplestartpunkt-Modus Dim SSP As Double ' der aus Komposi-HC.txt ausgelesene Samplestartpunkt Dim SSS As Double ' variabler Samplestartpunkt (SSP + SSS = tatsächliche Samplestartpunktverschiebung) Dim Stf As Double ' Sampleverschiebungsfaktor Dim KTP As Integer ' KEYTRANSPOSE - neu am 01.04.2014 Dim HTo As Double ' Sample-Gesamt-Tonhöhenverschiebung Dim Ubl As Double ' Überlappung Dim SHmm(100000) As Integer 'Dim mddu As Integer Dim Schleifenzahl As Integer Dim datum As String Dim HTpv(10000) As Integer ' HT bei Pattern (Hilfsfelder) Dim LTpv(10000) As Integer ' LT bei Pattern (Hilfsfelder) Dim DTpv(10000) As Double ' DT bei Pattern (Hilfsfelder) Dim HTp01(10000) As Integer ' HT bei Pattern (Pattern-01-Felder) Dim LTp01(10000) As Integer ' LT bei Pattern (Pattern-01-Felder) Dim DTp01(10000) As Double ' DT bei Pattern (Pattern-01-Felder) Dim HTp02(10000) As Integer ' HT bei Pattern (Pattern-02-Felder) Dim LTp02(10000) As Integer ' LT bei Pattern (Pattern-02-Felder) Dim DTp02(10000) As Double ' DT bei Pattern (Pattern-02-Felder) Dim i, ii, j, Zz, Zza, Pzz, Pzz1, Pzz2, Pzzv, n, nv, nx, ny As Integer Dim jj As Integer ' Nichtaufhängzähler Dim CAPDatei As String Dim CAPPattern As Boolean Dim Patterndatei As String Dim Patterndatei2 As String Dim Regelwort As String Dim Kefra As Boolean Dim SFf As String Dim TWert As Integer ' Tonhöhenwert (c, d, e, ..) Dim NWert As Double ' Notenwert (Viertel, Achtel usw.) Dim VK As Integer ' Vorzeichen Kreuz Dim ubs As Boolean ' Knopf 'Übersicht' geklickt Dim erkla As Single ' Erklärung Nr. Dim NurZeileEins As Boolean ' Nur das erste Sample in Komposi-HC.txt soll berücksichtigt werden Dim Zuz As Integer ' Zufallszahl Dim idahe As Integer ' inidat.height Dim Fund, Fund2 As String Dim Zeilie As String Dim yy As Double Dim OGrenz As Integer ' Obergrenze Dim v(100000) As Integer ' für die Statistik Private Sub Command10_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Doku.txt" End Sub Private Sub Command11_Click() FileCopy "C:\Arbeit\Komposi-HCR.rpp", "C:\Arbeit\HHHHH.rpp" End Sub Private Sub Command13_Click() FileCopy "C:\Arbeit\Komposi.rpp", "C:\Arbeit\HHHHH.rpp" End Sub Private Sub Command12_Click() Dim Mldg, Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton2 ' Schaltfläche definieren. Titel = "Frage zur Sicherheit" Mldg = "wirklich Kompposi-HCR.rpp überschreiben?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort <> vbYes Then GoTo Sube9 FileCopy "C:\Arbeit\HHHHH.rpp", "C:\Arbeit\Komposi-HCR.rpp" Sube9: End Sub Private Sub Command2_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & inidatei ' außer Betrieb am 01.02.2014 End Sub Private Sub Command3_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & KT End Sub Private Sub Command4_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt" End Sub Private Sub Command5_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-HC.txt" End Sub Private Sub Command9_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-HCR.txt" End Sub Private Sub Command6_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Test.txt" End Sub Private Sub Command7_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Test2.txt" End Sub Private Sub Command8_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-DTC.txt" End Sub Private Sub Form_Load() version = "Komposi 1.31 vom 29.08.2014" ' ---------------------------------------------------- Dim x As Integer reingeholt = False reingeholt2 = False ZwiFaktor = 0.001 idahe = 1025 ' 1035 txtNot.ForeColor = vbWhite ' neu am 09.04.2014 Text5.ForeColor = vbWhite ' neu am 09.04.2014 Label2.ForeColor = vbWhite txtNot.Text = " K O M P O S I" ' Text5.Text = "" Kefra = False KeineFrage.BackColor = &H9BC4FF inidatei = "C:\Arbeit\Komposi.ini" NeueRegelInfo.BackColor = &H95E2B5 'vbYellow Reaperstart2.BackColor = &HCDFEDF ' &HABFECA ' neu am 24.05.2014 ' ------------------------------------------ Call Initial Call Kurzubersicht_Click ' nicht unbedingt hier ... ' ------------------------------------------ CAPPattern = False If TFm > 2 Then Capellanotenwandeln.Visible = True Capellanotenwandeln2.Visible = True Patti.Visible = True ' Patterns werden von Capella geholt Patti02.Visible = True ' Patterns werden von Capella geholt KeineFrage.Visible = True Else Capellanotenwandeln.Visible = False Capellanotenwandeln2.Visible = False Patti.Visible = False ' Patterns werden von Capella geholt Patti02.Visible = False ' Patterns werden von Capella geholt KeineFrage.Visible = False End If erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = True ' Voreinstellungen: Leuchtfarbe.Visible = False: Leuchtfarbe2.Visible = False: Leuchtfarbe3(0).Visible = False: Leuchtfarbe4(1).Visible = False: Leuchtfarbe5(0).Visible = False: Leuchtfarbe6(1).Visible = False main.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 ' alt: &HC5D8EB ' Farbe am 11.07.2014 geändert txtNot.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 Text5.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 Label2.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 Infos.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 Label5.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 neutral.BackColor = &H9D9D9D '&H5F5AF1 ' &H95E2B5 NeueRegelInfo.BackColor = &H9BC4FF ' &H95E2B5 ' vbWhite ' vbBlack ' Vzg = 0.001 ' 0.001 ... 0.01 ... 0.02 ... 0.05 für die Verzögerung bei der Zufallsberechnung von Tönen KT = "C:\Arbeit\Komposi.txt" ' zu erzeugende Melodiedatei Rt = "C:\Arbeit\Komposi.rpp" ' zu erzeugende Reaperdatei CAPDatei = "C:\Arbeit\Komposi.cap" mi = False ' damit das Frequenzdisplay beim Herumklicken vor ' erstmaliger Betätigung des Startknopfes nichts anzeigt Nmm = 70 ' Variable für die Tonhöhe - 05.12.2013 rund = 100 ' 100 = 2 Stellen (für die Frequenzanzeige) korri = 51 ' (48 oder 51) Anpassung für Gliss. - größer --> kleinere Änderung Notnam = " " bildzaehler = 1 Call midi_listoutdevs(List1) midi_out_close x = midi_out_open(-1) ' gefunden: so stellt sich ein MIDI-Device selbständig ein Label1.Caption = "" Call fill_sound_list Const Midisound = 11 ' Default-Klangnummer 11: Vibraphon, 17: Organ 2, 53: Stimme macht ooo Call program_change(0, 0, Midisound) ' gefunden: so stellt sich ein MIDI-Sound selbständig ein main.Caption = version farb = True Text5.Text = Notnam Call Textscroller("C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt") Call Datenliste_Info Reaperstart.BackColor = &HE0E0E0 ' grau ' Call Inidateilesen ' Call Schlusselwort_finden("SOUND") ' in m steht dann der Wert ' Snd = Val(m) ' If Snd > 1 Then Snd = 2 Else Snd = 1 If Snd = 1 Then ' MIDI Label2.Caption = "D e r M e l o d i e n s p i e l e r" Command1.Visible = False Reaperstart.Visible = False Stopp.Visible = True Startknopf.Visible = True End If If Snd = 2 Or Snd = 3 Or Snd = 4 Then ' SAMPLE Label2.Caption = "D e r A u t o s a m p l e r" Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False Startknopf.Visible = False End If ' Call Dauerncontainer_fullen ' Call Tonhöhencontainer_fullen ' (Noch) nicht in Betrieb (10.03.2014) ' Call KomposiCap_Click ' ist das praktisch hier? - 20.03.2014 ... nicht mehr (27.03.2014) Daten.BackColor = &HFFFFFF ' weiß Zuordnung.BackColor = &HFFFFFF ' weiß inidat.BackColor = &HFFFFFF ' weiß List1.BackColor = &HFFFFFF ' weiß lst_sound_list.BackColor = &HFFFFFF ' weiß Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 breit = False ibreit = True ' Label5.Visible = False End Sub Sub Initial() Call Inidateilesen Call Schlusselwort_finden("SOUND") ' If Val(m) > 1 Then Snd = 2 Else Snd = 1 Snd = Val(m) Call Schlusselwort_finden("ANZAHL") If Val(m) > 0 Then Anz = Val(m) Else Anz = 10 Anzahl = Anz Call Schlusselwort_finden("TONFINDUNGSMETHODE") If Val(m) = 0 Then TFm = 1 Else TFm = Val(m) Call Schlusselwort_finden("TIEFTON") If Val(m) > 0 Then Ttn = Val(m) Else Ttn = 1 Call Schlusselwort_finden("HOCHTON") If Val(m) > 0 Then Htn = Val(m) Else Htn = 127 Call Schlusselwort_finden("STARTTON") If Val(m) > 0 Then Sto = Val(m) Else Sto = Ttn Call Schlusselwort_finden("AUTOPAN") If Val(m) > 0 Then Atp = Val(m) Else Atp = 0 Call Schlusselwort_finden("INTERVALL") If Val(m) > 0 Then Iva = Val(m) Else Iva = 12 Call Schlusselwort_finden("KLEINERGROSSER") If Val(m) > 0 Then Kgl = Val(m) Else Kgl = 1 Call Schlusselwort_finden("TONDAUERDIREKT") If Val(m) > 0 Then Tdd = 1 Else Tdd = 0 Call Schlusselwort_finden("NOTENWERT") If Val(m) > 0 Then Tda = Val(m) Else Tda = 8 Call Schlusselwort_finden("LAUTVAR") If Val(m) > 0 Then Lva = Val(m) Else Lva = 127 Call Schlusselwort_finden("SAMPLETUNING") Stn = Val(m) Call Schlusselwort_finden("SAMPLESTARTPUNKTMODUS") ' NEU am 31.03.2014 Stp = Val(m) Call Schlusselwort_finden("SAMPLEVERSCHIEBUNGSFAKTOR") ' NEU am 31.03.2014 Stf = Val(m) Call Schlusselwort_finden("TEMPO") If Val(m) = 0 Then tempi = 1 Else tempi = Val(m) Call Schlusselwort_finden("LAUT") If Val(m) = 0 Then lauti = 80 Else lauti = Val(m) Call Schlusselwort_finden("SAMPLENUMMER") Snn = Val(m) Call Schlusselwort_finden("ZWISCHENRAUM") Zwv = Val(m) Call Schlusselwort_finden("ÜBERLAPPUNG") Ubl = Val(m) Call Schlusselwort_finden("TRACKZAHL") If Val(m) > 0 And Val(m) <= 8 Then Trz = Val(m) Else Trz = 8 Call Schlusselwort_finden("ORIGINALSAMPLEABSTAND") Oga = Val(m) Call Schlusselwort_finden("ORIGINALSAMPLEDAUER") Ogs = Val(m) Call Schlusselwort_finden("SAMPLEOFFSETTUNE") HTo = Val(m) Call Schlusselwort_finden("TONHÖHENÄNDERUNGSFAKTOR") THf = Val(m) Call Schlusselwort_finden("TRANSPONI") ' NEU am 27.01.2014 Trs = Val(m) ' noch einen Filter einsetzen? Call Schlusselwort_finden("WIEVIELELOOPS") ' NEU am 28.01.2014 If Val(m) = 0 Then LOP = 1 Else LOP = Val(m) Call Schlusselwort_finden("WIEDERHOLUNGSDISTANZ") ' NEU am 26.02.2014 Whd = Val(m) Call Schlusselwort_finden("UNTERGRENZE") ' NEU am 26.02.2014 UGr = Val(m) Call Schlusselwort_finden("OBERGRENZE") ' NEU am 26.02.2014 OGr = Val(m) ' Call Schlusselwort_finden("KLEINSTETRANS") ' NEU am 03.06.2014 - doch nicht verwendet ' KTR = Val(m) Call Schlusselwort_finden("VERZOGERUNG") ' Neu am 01.03.2014 Vzg = Val(m) ' Multiplikator seit dem 10.04.2014 - aber bei den einzelnen Vorkommnissen! Call Schlusselwort_finden("KURZTON") ' Neu am 09.03.2014 KTn = Val(m) Call Schlusselwort_finden("LANGTON") ' Neu am 09.03.2014 LTn = Val(m) Call Schlusselwort_finden("VORRUCK01") ' Neu am 12.03.2014 VR1 = Val(m) Call Schlusselwort_finden("VORRUCK02") ' Neu am 12.03.2014 VR2 = Val(m) Call Schlusselwort_finden("TAKT") ' Neu am 22.03.2014 TKT = Val(m) Call Schlusselwort_finden("VBSCHLUSSEL") ' Neu am 23.03.2014 VBS = Val(m) Call Schlusselwort_finden("TRANSPOSIWERT") ' Neu am 23.03.2014 TRN = Val(m) Call Schlusselwort_finden("KURZESTWERT") ' Neu am 23.03.2014 KZW = Val(m) Call Schlusselwort_finden("NOTENPROZEILE") ' Neu am 23.03.2014 NPZ = Val(m) Call Schlusselwort_finden("KEYTRANSPOSE") ' Neu am 01.04.2014 KTP = Val(m) Call Schlusselwort_finden("SAMPLEEINSCHWING") ' Neu am 05.04.2014 Sfi = Val(m) Call Schlusselwort_finden("SAMPLEAUSSCHWING") ' Neu am 05.04.2014 Sfo = Val(m) Call Schlusselwort_finden("SAMPLELOOPS") ' Neu am 13.05.2014 SPL = Val(m) Call Schlusselwort_finden("SAMPLETRANSU") ' Neu am 15.05.2014 SAU = Val(m) Call Schlusselwort_finden("SAMPLETRANSO") ' Neu am 15.05.2014 SAO = Val(m) Call Schlusselwort_finden("SAMPLEOFFSETSTART") ' Neu am 25.05.2014 SOT = Val(m) If TFm = 1 Or TFm = 2 Then ' so geändert am 16.05.2014 Zwi = Zwv * 0.1 Else Zwi = Zwv * ZwiFaktor End If If TFm = 3 Then Tdd = 1 ' NEU am 27.03.2014 If TFm = 4 Then Tdd = 1 ' NEU am 15.04.2014 <------------ soll das so sein? ... If TFm = 5 Then Tdd = 0 ' NEU am 10.03.2014 If TFm = 6 Then Tdd = 1 ' NEU am 10.03.2014 Stopvalu = False If TFm = 0.1 Then Tdd = 1 ' 30.04.2014 If TFm = 0.1 Then Oga = 1 ' 30.04.2014 If TFm = 0.1 Then tempi = 1 ' 30.04.2014 If TFm = 0.1 Then Stn = 0 ' 03.05.2014 If TFm = 0.1 Then SOT = 0 ' 25.05.2014 ' Hier neu am 13.04.2014: If TFm <= 2 Then Capellanotenwandeln.Visible = False If TFm <= 2 Then Capellanotenwandeln2.Visible = False If TFm <= 2 Then Patti.Visible = False If TFm <= 2 Then Patti02.Visible = False If TFm <= 2 Then KeineFrage.Visible = False 'If TFm <= 2 Then NeueRegelInfo.Visible = False If TFm > 2 Then Capellanotenwandeln.Visible = True If TFm > 2 Then Capellanotenwandeln2.Visible = True If TFm > 2 Then Patti.Visible = True If TFm > 2 Then Patti02.Visible = True If TFm > 2 Then KeineFrage.Visible = True 'If TFm > 2 Then NeueRegelInfo.Visible = True ' neu am 03.06.2014: ' If UGr > OGr Then ' UGr = OGr ' geht das so? ' End If ' neu am 03.06.2014: ' If KTR > (OGr - UGr) Then ' KTR = (OGr - UGr) ' End If ' seit 28.05.2014 hier: If Snd = 1 Then ' MIDI Label2.Caption = "D e r M e l o d i e n s p i e l e r" Command1.Visible = False Reaperstart.Visible = False Stopp.Visible = True Startknopf.Visible = True End If If Snd = 2 Or Snd = 3 Or Snd = 4 Then ' SAMPLE Label2.Caption = "D e r A u t o s a m p l e r" Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False Startknopf.Visible = False End If NurZeileEins = False End Sub Private Sub Command1_Click() ' Knopf 'P' Command1.Enabled = False Call Dateiherstellung_Click ' Call Inidateilesen ' Call Schlusselwort_finden("SOUND") ' in m steht dann der Wert ' Snd = Val(m) ' If Snd > 1 Then Snd = 2 Else Snd = 1 If Snd = 2 Or Snd = 3 Or Snd = 4 Then Call Reaperstart_Click End If Command1.Enabled = True End Sub Private Sub Dateiherstellung_Click() ubs = False erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False Text1.Visible = False inidat.ForeColor = vbBlack inidat.FontBold = False inidat.FontSize = 8 Startknopf.Enabled = False Command1.Enabled = False Dateiherstellung.Enabled = False Capellanotenwandeln.Enabled = False Capellanotenwandeln2.Enabled = False KomposiCap.Enabled = False Command4.Enabled = False Kurzubersicht.Enabled = False Ubersicht.Enabled = False Command2.Enabled = False Command8.Enabled = False Command3.Enabled = False Command5.Enabled = False Command9.Enabled = False Command6.Enabled = False Command7.Enabled = False Command10.Enabled = False Ubersicht_Notenschreiben.Enabled = False Dim K, l As Integer Dim MD As String Dateiherstellung.BackColor = &H288F24 ' = &H84FF84 ' grün Call Initial ' If TFm = 5 Then Tdd = 0 ' <------------ NEU am 10.03.2014 ' If TFm = 6 Then Tdd = 1 ' <------------ NEU am 10.03.2014 ' If TFm = 1 Or TFm = 2 Then Capellanotenwandeln.Enabled = False ' If TFm = 3 Or TFm = 4 Then Capellanotenwandeln.Enabled = True ' Patterns werden von Capella geholt ' If TFm = 1 Or TFm = 2 Then If TFm < 2 Then ' geändert am 30.04.2014 Capellanotenwandeln.Visible = False Capellanotenwandeln2.Visible = False Patti.Visible = False Patti02.Visible = False KeineFrage.Visible = False End If If TFm > 2 Then Capellanotenwandeln.Visible = True Capellanotenwandeln2.Visible = True Patti.Visible = True Patti02.Visible = True KeineFrage.Visible = True Else Capellanotenwandeln.Visible = False Capellanotenwandeln2.Visible = False Patti.Visible = False Patti02.Visible = False KeineFrage.Visible = False End If Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe breit = False ibreit = False Reaperstart.BackColor = &HE0E0E0 ' grau Daten.Clear ' hier neu am 29.12.2013 - außer Betrieb am 15.05.2014 ' doch nicht Daten.ForeColor = &H15B00 ' grün ' &H0040C0 ' HFF Text1.ForeColor = &H15B00 ' grün Daten.FontBold = True Daten.FontSize = 12 Daten.AddItem "" txtNot.Text = "" Text5.Text = "" Zuordnung.Clear ' hier richtig? <-------------------- ja nein .. If Snd = 2 Then ' SAMPLE-Ausgabe Call Zuordnungen ' KL(i) füllen aus C:\Arbeit\Komposi-HC.txt ' Tonhöhenwerten (aus HT()) werden Samples zugeordnet Call Zuordnungsliste_schreiben ' ' If Regelwort <> "" Then ' txtNot.Text = Regelwort: Text5.Text = "" ' Call Verzoegerung(0.3) ' <------ ?? ' Else txtNot.Text = "SAMPLER": Text5.Text = "" Call Verzoegerung(0.9) ' End If ' txtNot.Text = "SAMPLER": Text5.Text = "" Label2.Caption = "D e r A u t o s a m p l e r" Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False ' Leuchtfarbe.Visible = False: Leuchtfarbe2.Visible = False: Leuchtfarbe3(0).Visible = False: Leuchtfarbe4(1).Visible = False: Leuchtfarbe5(0).Visible = False: Leuchtfarbe6(1).Visible = False End If If Snd = 3 Or Snd = 4 Then ' SAMPLE-Ausgabe - Input: Komposi-HCR.rpp <-------- ! NEU am 22.04.2014 Call Zuordnungen2 ' KL(i) füllen aus Komposi-HCR.rpp (muss vorher umgewandelt werden) ' Tonhöhenwerten (aus HT()) werden Samples zugeordnet Call Zuordnungsliste_schreiben ' <---------------------------------- raus am 24.04.2014? - nein txtNot.Text = "SAMPLER": Text5.Text = "" Call Verzoegerung(0.9) Label2.Caption = "D e r A u t o s a m p l e r" Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False End If Regelwort = "" If Snd = 1 Then ' MIDI If Regelwort <> "" Then txtNot.Text = Regelwort Call Verzoegerung(0.3) Else txtNot.Text = "WAVETABLE" Call Verzoegerung(0.9) End If Label2.Caption = "D e r M e l o d i e n s p i e l e r" Command1.Visible = False Reaperstart.Visible = False Stopp.Visible = True ' Leuchtfarbe.Visible = True: Leuchtfarbe2.Visible = True: Leuchtfarbe3(0).Visible = True: Leuchtfarbe4(1).Visible = True: Leuchtfarbe5(0).Visible = True: Leuchtfarbe6(1).Visible = True End If If TFm = 0.1 Then Call Randi01 Call schreib ' Tönedatei (Komposi.txt) schreiben Call Startknopf_Click ' Nach dem Schreiben automatisch abspielen End If If TFm = 0.2 Then ' neu am 05.05.2014 Call Randi01 Call schreib ' Tönedatei (Komposi.txt) schreiben Call Startknopf_Click ' Nach dem Schreiben automatisch abspielen End If If TFm = 1 Then ' Tfm: Tonfindungsmethode Call Randi04 ' Ergebnis abhängig von Einstellung von TIEFTON, HOCHTON, INTERVALL Call schreib ' Tönedatei (Komposi.txt) schreiben Call Startknopf_Click ' Nach dem Schreiben automatisch abspielen End If If TFm = 2 Then ' Tfm: Tonfindungsmethode Call Randi05 ' Einfache Zufallstöne (15.01.2014) Call schreib ' Tönedatei (Komposi.txt) schreiben Call Startknopf_Click ' Nach dem Schreiben automatisch abspielen End If If TFm > 2 Then ' If tempi < 1 And (Snd = 2 Or Snd = 3 Or Snd = 4) Then ' die Samples stehen womöglich ' raus am 29.07.2014 ' ' zu weit auseinander ' Call Hallo("Das Tempo ist vielleicht zu niedrig eingestellt (" & tempi & ")") ' End If Call Randi06 ' TEST: Variation eines vorgegebenen Patterns - oder? Call schreib ' Tönedatei (Komposi.txt) schreiben Call Startknopf_Click ' Nach dem Schreiben automatisch abspielen End If ' Dateiherstellung.Enabled = True ' Capellanotenwandeln.Enabled = True ' Capellanotenwandeln.Visible = True Command1.Enabled = True End Sub Private Sub Schlusselwort_finden(Sch) Dim K, l As Integer Dim MD As String K = 0: l = 0 Do While MD <> Sch And K < 300 K = K + 1 MD = Left(Ini(K), Len(Sch)) Loop m = "": l = 0 Do Until Len(Sch) + 1 + l > Len(Ini(K)) B = Mid(Ini(K), Len(Sch) + 1 + l, 1) If B <> " " Then m = m + B End If l = l + 1 Loop End Sub Private Sub Schlusselwort2_finden(Sch) ' 2 <---- ! Dim K, l As Integer Dim MD As String ' Schlüsselwort (also den Samplenamen) im Feld KL() fínden und den Index (k) merken K = 0: l = 0 Do While MD <> Sch And K < 300 K = K + 1 MD = Left(KL(K), Len(Sch)) Loop ' Jetzt hat es das Schlüsselwort (also den Samplenamen) gefunden. m = "": l = 0 Do Until Len(Sch) + 1 + l > Len(KL(K)) B = Mid(KL(K), Len(Sch) + 1 + l, 1) If B <> " " Then m = m + B End If l = l + 1 Loop End Sub Private Sub Schlusselwort4_finden(Sch) ' 4 <---- ! ' Dies ist die verbesserte Version 3 (gelöscht). ' Es soll folgendes finden: ' Schlüsselwort (hier Samplenamen) MD, ' Sampledauer m, ' Samplestartpunkt m2, ' Playrate, ' Sample-Lautstärke 1, ' Sample-Lautstärke 2, ' Sample-Info Dim K, l As Integer Dim MD As String Dim gefunden As Boolean ' Hier: Samplenamen finden: K = 0 Do While MD <> Sch And K < 300 K = K + 1 MD = Left(KL(K), Len(Sch)) Loop ' Jetzt hat es den Samplenamen gefunden. ' K enthält die Zeilennummer (den Feld-Index) ' ' ' Jetzt: ' Lies einzelne Stellen der Zeile ab Ende Samplenamen von Ende der Leerstellen bis zur ' nächsten Leerstelle und setze die Stellen zu einem Wort zusammen. Merke dir das Wort ' in der Variablen m. ' ' Lies einzelne Stellen der Zeile von Ende der Leerstellen bis zur nächsten Leerstelle ' und setze die Stellen zu einem Wort zusammen. Merke dir dieses Wort in der Variablen m2. ' ' l = 0 ' <---------- ' ' Sampledauer ermitteln: m = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True B = Mid(Sch, Len(SFf) + 1 + l, 1) ' ab Ende Samplenamen die Stellen lesen - SFf neu If B <> " " Then gefunden = True m = m + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Die Sampledauer steht jetzt in m! ' ' Samplestartpunkt ermitteln: m2 = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True ' B = Mid(KL(K), Len(Sch) + 1 + l, 1) ' weiterlesen B = Mid(Sch, Len(SFf) + 1 + l, 1) ' weiterlesen - SFf neu If B <> " " Then gefunden = True m2 = m2 + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Der Samplestartpunkt steht jetzt in m2! ' Tonzahl = i ' Anzahl der Töne gespeichert ' ' ' Playrate ermitteln: m3 = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True B = Mid(Sch, Len(SFf) + 1 + l, 1) ' weiterlesen - SFf neu If B <> " " Then gefunden = True m3 = m3 + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Die Playrate steht jetzt in m3! ' ' ' Samplelautstärke ermitteln: m4 = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True B = Mid(Sch, Len(SFf) + 1 + l, 1) ' weiterlesen - SFf neu If B <> " " Then gefunden = True m4 = m4 + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Die Samplelautstärke steht jetzt in m4! ' ' Samplelautstärke2 ermitteln: m41 = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True B = Mid(Sch, Len(SFf) + 1 + l, 1) ' weiterlesen - SFf neu If B <> " " Then gefunden = True m41 = m41 + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Die Samplelautstärke2 steht jetzt in m41! ' ' Sample-Info ermitteln: m5 = "" gefunden = False Do Until (B = " " Or B = "") And gefunden = True B = Mid(Sch, Len(SFf) + 1 + l, 1) ' weiterlesen - SFf neu If B <> " " Then gefunden = True m5 = m5 + B ' wenn die Stelle keine Leerstelle ist End If l = l + 1 Loop ' Das Sample-Info steht jetzt in m5! ' ' Tonzahl = i ' Anzahl der Töne gespeichert End Sub Private Sub Randi01() ' ein neues Randi01 (30.04.2014) ' Die Felder HT(), LT() und DT() werden gefüllt Regelwort = "T E S T" txtNot.Text = Regelwort Call Verzoegerung(0.7) Dim SZ As Integer ' gespeicherte Zufallszahl Dim Startton As Integer Dim Dfz As Integer ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen Dim q, r, s, rr As Integer Dim iv As Integer iv = 0 Erase HT Erase LT Erase DT If Trz = 1 Then Atp = 0 Ttn = 1 ' Wert für TIEFTON Htn = iHC ' Wert für HOCHTON - iHC enthält die Anzahl der Samples Sto = 1 ' Startton Anzahl = iHC SZ = Sto ' Startwert, dann gespeicherte Zufallszahl i = 0 Text1.Visible = True Do Until i = Anzahl Or jj = 10000 i = i + 1 Dfz = Abs(Zz - SZ) ' Dfz gibt die Differenz zwischen unmittelbar aufeinanderfolgenden Tönen an HT(i) = i SZ = HT(i) ' die verwendete Zahl speichern LT(i) = 127 DT(i) = 3000 ' ?????? Text1.Text = "Ton " & i ' neu am 06.04.2014 Loop Tonzahl = i Text1.Visible = False End Sub Private Sub Randi04() ' füllt die Felder HT(), LT() und DT Regelwort = "Regel 01" txtNot.Text = Regelwort Call Verzoegerung(0.3) Dim SZ As Integer ' gespeicherte Zufallszahl Dim Startton As Integer Dim Dfz As Integer ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen Dim q, r, s, rr As Integer Dim iv As Integer iv = 0 Erase HT Erase LT Erase DT If Anz > 0 Then Daten.AddItem " " & Anz & " Töne" Daten.AddItem " werden berechnet" End If If Trz = 1 Then Atp = 0 ' Ist das hier ok?: If Htn > iHC Then Htn = iHC ' hier und in Randi05 neu am 23.05.2014 If Iva > (Htn - Ttn) Then Iva = Htn ' hier und in Randi05 neu am 26.05.2014 SZ = Sto ' Startwert, dann gespeicherte Zufallszahl i = 0: jj = 0 Text1.Visible = True Do Until i = Anzahl Or jj = 10000 jj = jj + 1 Randomize ' zz = Int(Rnd * 127) + 1 ' Neue Zahl (zwischen 1 und 127) Zz = Int(Rnd * (Htn - Ttn + 1)) + Ttn ' Neue Zahl (zwischen Ttn und Htn) Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen Dfz = Abs(Zz - SZ) ' Dfz gibt die Differenz zwischen unmittelbar aufeinanderfolgenden Tönen an ' If zz >= Ttn And zz <= Htn Then If Kgl = 1 Then ' Intervall kleiner gleich If Dfz <= Iva Then i = i + 1 HT(i) = Zz SZ = Zz ' die verwendete Zahl speichern Randomize LT(i) = Int(Rnd * Lva) + (127 - Lva) + 1 ' abhängig von LAUTVAR Randomize DT(i) = Int(Rnd * Tda) + 1 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen End If End If If Kgl = 2 Then ' Intervall größer gleich If Dfz >= Iva Then i = i + 1 HT(i) = Zz SZ = Zz ' die verwendete Zahl speichern Randomize LT(i) = Int(Rnd * Lva) + (127 - Lva) + 1 ' abhängig von LAUTVAR <------- 19.12.2013 Randomize DT(i) = Int(Rnd * Tda) + 1 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen End If End If If Kgl = 3 Then ' Intervall gleich If Dfz = Iva Then i = i + 1 HT(i) = Zz SZ = Zz ' die verwendete Zahl speichern Randomize LT(i) = Int(Rnd * Lva) + (127 - Lva) + 1 ' abhängig von LAUTVAR <------- 19.12.2013 Randomize DT(i) = Int(Rnd * Tda) + 1 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen End If End If ' End If Text1.Text = "Ton " & i ' neu am 06.04.2014 Loop Text1.Visible = False '----------------------------------------------------------------------------------------/ ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Berechnung der Statistik über die HT-Vorkomnisse: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Stn = 0 And Stp = 0 Then ' TEST - 06.05.2014 Call Statistik_0 End If If Stn > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik ' als Subroutine neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' als Subroutine neu am 29.03.2014 End If Tonzahl = i ' Anzahl der Töne gespeichert Schleifenzahl = jj If jj = 10000 Then ' jj = 10000 bedeutet: zu viele erfolglose Schleifendurchläufe Keinton = True End If End Sub Private Sub Randi05() ' füllt die Felder HT(), LT() und DT() Regelwort = "Regel 02" txtNot.Text = Regelwort Call Verzoegerung(0.3) Dim SZ As Integer ' gespeicherte Zufallszahl Dim Startton As Integer Dim Dfz As Integer ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen Dim q, r, s, rr As Integer Dim iv As Integer Dim Zae As Integer Dim Zwiv As Double Dim adw(1000) As Integer ' Anzahl der Wiederholungen Dim nn As Integer ' Zähler ' 11.05.2014 ' Regel02: ' Samples werden innerhalb eines wählbaren Bereichs per Zufall ausgewählt. ' Bestimmte Samples sollen sich wiederholen (eine Schleife bilden). Die Anzahl ' der Wiederholungen wird vom Zufall (innerhalb von Grenzen) bestimmt. OGrenz = SPL ' <---- Obergrenze für Sample-Wiederholung bei den Loops Erase adw Erase v ' Anzahl der Wiederholungsschleifen berechnen: Daten.AddItem "Speziell in Regel 2:" Daten.AddItem "Für jeden Ton wird die" Daten.AddItem "Anzahl der Wiederholungen" Daten.AddItem "berechnet" Zuordnung.AddItem "" Zuordnung.AddItem "Loops:" For nn = 1 To iHC Call Zufzahl(1, OGrenz) Call Verzoegerung(Vzg * 0.001) adw(nn) = Zuz Zuordnung.AddItem "Ton " & nn & " immer " & Zuz & " mal" v(Zuz) = v(Zuz) + 1 ' <-------- hier?! .... 13.05.2014 Next nn Daten.Clear Daten.AddItem "" iv = 0 Erase HT Erase LT Erase DT If Anz > 0 Then Daten.AddItem " " & Anz & " Töne" Daten.AddItem " werden berechnet" End If If Trz = 1 Then Atp = 0 ' Kein Autopan bei Trackzahl = 1 If Htn > iHC Then Htn = iHC ' hier NEU am 23.05.2014 If Iva > (Htn - Ttn) Then Iva = Htn ' hier und in Randi05 neu am 26.05.2014 '----------------------------------------------------------------------------------------\ ' jj ist ein Schleifendurchlaufzähler, i zählt die verwendeten Töne, zz enthält die ' neueste Zufallszahl, SZ enthält die zuvor verwendete Zufallszahl, in Dfz steht die ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen: i = 0: jj = 0: SZ = 0 Zae = 0 Text1.Visible = True Do Until i = Anzahl Or jj = 1000 ' jj: Überlaufzähler i = i + 1 jj = jj + 1 ' Tonhöhe bzw. Sampleauswahl: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Randomize Zz = Int(Rnd * (Htn - Ttn + 1)) + Ttn ' Neue Zahl (zwischen Ttn und Htn) Call Verzoegerung(Vzg * 0.001) If Zae = 0 Then HT(i) = Zz ' neue Zahl Zae = adw(Zz) ' <---------------- !! ' V(Zae) = V(Zae) + 1 Else HT(i) = SZ ' die vorige Zahl nehmen, weil zae nicht 0 ist ' V(Zae) = V(Zae) + 1 ' ??? hier auch? End If SZ = HT(i) ' die verwendete Zahl speichern Dfz = Abs(Zz - SZ) ' Dfz: Differenz zwischen aufeinanderfolgenden Tönen ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Lautstärke: Randomize LT(i) = Int(Rnd * Lva) + (127 - Lva) + 1 ' abhängig von LAUTVAR Call Verzoegerung(Vzg * 0.001) ' If Zae > 0 Then ' LT(i) = LT(i) * 0.7 ' REGEL: bei Tonwiederholung kürzere Dauer ' End If ' Dauer: Randomize DT(i) = Int(Rnd * Tda) + 1 Call Verzoegerung(Vzg * 0.001) ' If Zae > 0 Then ' ''''''''' ' End If ' Auflisten in Tex Text1.Text = "Ton " & i ' neu am 06.04.2014 If Zae > 0 Then Zae = Zae - 1 ' Wiederholungszähler Loop Text1.Visible = False '----------------------------------------------------------------------------------------/ Call Statistik22 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Berechnung der Statistik über die HT-Vorkomnisse: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Stn > 0 Then ' Stn eingefügt am 08.04.2014 Call Statistik ' als Subroutine neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' als Subroutine neu am 29.03.2014 End If Tonzahl = i ' die Anzahl der Töne wird gespeichert Schleifenzahl = jj If jj = 10000 Then ' jj = 10000 bedeutet: zu viele erfolglose Schleifendurchläufe Keinton = True End If End Sub Private Sub Statistik22() Dim ni As Integer ' Zähler Zuordnung.AddItem "" For ni = 1 To OGrenz Zuordnung.AddItem ni & "-fach-Loop: " & Val(v(ni)) & " mal" Next ni Zuordnung.AddItem "" End Sub Private Sub Randi05v() ' <--- v! füllt die Felder HT(), LT() und DT() - einfache Zufallstöne - ' SOLL: Muster variieren? Regelwort = "Regel 02" txtNot.Text = Regelwort Call Verzoegerung(0.3) Dim SZ As Integer ' gespeicherte Zufallszahl Dim Startton As Integer Dim Dfz As Integer ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen Dim q, r, s, rr As Integer Dim iv As Integer iv = 0 Erase HT Erase LT Erase DT If Anz > 0 Then Daten.AddItem " " & Anz & " Töne" Daten.AddItem " werden berechnet" End If If Trz = 1 Then Atp = 0 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Zufallsfunktionen '----------------------------------------------------------------------------------------\ ' jj ist ein Schleifendurchlaufzähler, i zählt die verwendeten Töne, zz enthält die ' neueste Zufallszahl, SZ enthält die zuvor verwendete Zufallszahl, in Dfz steht die ' Differenz zwischen unmittelbar aufeinanderfolgenden Tönen. Ttn = 1 ' tiefster Ton - wir sind hier in Randi05 If Snd = 1 Then ' MIDI Htn = 127 End If If Snd = 2 Or Snd = 3 Or Snd = 4 Then ' Im SAMPLE-Modus sollen alle ' eingetragenen Samples verwendet werden Ttn = 1 ' Wert für TIEFTON Htn = iHC ' Wert für HOCHTON - iHC enthält die Anzahl der Samples Randomize ' Startton bestimmen: Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen Sto = Int(Rnd * Htn) + 1 ' Zufallszahl zwischen 1 und Htn für STARTTON ermitteln End If i = 0: jj = 0: SZ = 0 Text1.Visible = True Do Until i = Anzahl Or jj = 10000 jj = jj + 1 Randomize Zz = Int(Rnd * (Htn - Ttn + 1)) + Ttn ' Neue Zahl (zwischen Ttn und Htn) Dfz = Abs(Zz - SZ) ' Dfz gibt die Differenz zwischen unmittelbar aufeinanderfolgenden Tönen an i = i + 1 HT(i) = Zz SZ = Zz ' die verwendete Zahl speichern Randomize LT(i) = Int(Rnd * Lva) + (127 - Lva) + 1 ' abhängig von LAUTVAR Randomize DT(i) = Int(Rnd * Tda) + 1 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen Text1.Text = "Ton " & i ' neu am 06.04.2014 Loop Text1.Visible = False '----------------------------------------------------------------------------------------/ '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Call Schlusselwort_finden("SAMPLETUNING") ' in m steht dann der Wert für das Sampletuning ' Stn = Val(m) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Berechnung der Statistik über die HT-Vorkomnisse: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Stn > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik ' als Subroutine neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' als Subroutine neu am 29.03.2014 End If Tonzahl = i ' Anzahl der Töne gespeichert Schleifenzahl = jj If jj = 10000 Then ' jj = 10000 bedeutet: zu viele erfolglose Schleifendurchläufe Keinton = True End If End Sub Private Sub Randi06() ' füllt die Felder HT(), LT() und DT - ' Pattern variieren! ' Dim zeile, bb, B As String Dim Patt As String ' Dim Kxm As String Erase HT Erase LT Erase DT Daten.AddItem " Die Töne" Daten.AddItem " werden berechnet" If Trz = 1 Then Atp = 0 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Snd = 2 Or Snd = 3 Or Snd = 4 Then ' Im SAMPLE-Modus sollen alle ' eingetragenen Samples verwendet werden Ttn = 1 ' Wert für TIEFTON Htn = iHC ' Wert für HOCHTON - iHC enthält die Anzahl der Samples Randomize ' Startton bestimmen: Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen End If Sto = Int(Rnd * Htn) + 1 ' Zufallszahl zwischen 1 und Htn für STARTTON ermitteln ' Die Patternzeilen (Komposi-PT.txt) lesen und analysieren '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ' Zunächst muss eine Datei gelesen werden, die ein Pattern enthält ' Diese Datei heißt C:\Arbeit\Komposi-PT.txt. Dies funktioniert ähnlich ' wie in Sub Neuton(): Patterndatei = "C:\Arbeit\Komposi-Cap-PT.txt" ' NEU am 18.02.2014: nur noch diese Datei Patterndatei2 = "C:\Arbeit\Komposi-Cap-02.txt" ' NEU am 03.03.2014: zweite Patterndatei ' Kxm = "Komposi-01.xml" Patt = Patterndatei Call PatternAnalyse(Patt) ' als Subroutine NEU - 03.03.2014 ' Das Einlesen funktioniert seit dem 22.01.2014 ' Jetzt neue Namen: ' HTpv() enthält die Tonhöhen ' LTpv() enthält die Lautstärken ' DTpv() enthält die Dauern ' des eingelesenen Patterns. ' Pzzv enthält die Anzahl der Patternzeilen ' Erase HTp01 ' Erase LTp01 ' Erase DTp01 Pzz1 = Pzzv For n = 1 To Pzz1 HTp01(n) = HTpv(n) LTp01(n) = LTpv(n) DTp01(n) = DTpv(n) Next n ' If CAPPattern = False Then ' Kein mit Capella erstelltes Pattern über den LKnopf 'M' eingelesen ' Das Pattern in der rechten Spalte namens 'Zuordnung' auflisten: Zuordnung.AddItem "Pattern aus" Zuordnung.AddItem Patterndatei & ":" Zuordnung.AddItem "" For n = 1 To Pzz1 Zuordnung.AddItem HTp01(n) & " " & LTp01(n) & " " & DTp01(n) Next n Zuordnung.AddItem "" ' End If ' Kxm = "Komposi-02.xml" Patt = Patterndatei2 Call PatternAnalyse(Patt) ' als Subroutine NEU - 03.03.2014 ' Erase HTp02 ' Erase LTp02 ' Erase DTp02 Pzz2 = Pzzv For n = 1 To Pzz2 HTp02(n) = HTpv(n) LTp02(n) = LTpv(n) DTp02(n) = DTpv(n) Next n ' If CAPPattern = False Then ' Kein mit Capella erstelltes Pattern über den LKnopf 'M' eingelesen ' Das Pattern in der rechten Spalte namens 'Zuordnung' auflisten: Zuordnung.AddItem "Pattern aus" Zuordnung.AddItem Patterndatei2 & ":" Zuordnung.AddItem "" For n = 1 To Pzz2 Zuordnung.AddItem HTp02(n) & " " & LTp02(n) & " " & DTp02(n) Next n Zuordnung.AddItem "" ' End If '//////////////////////////////////////////////////////////////////////////////////////// ' Melodien erfinden nach REGELN ' """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" If TFm = 3 Then Call Regel03 ' Patterntranspositionen End If If TFm = 4 Then Call Regel04 ' Patternerweiterungen End If If TFm = 5 Then Call Regel05 ' Pattern 2 wird von Pattern 1 'gespielt' End If If TFm = 6 Then Call Regel06 ' Pattern 2 wird von Pattern 1 'gespielt' ... wieder anders End If ' """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" ' Stn = 0 ' das Sampletuning soll hier abgeschaltet werden .... oder doch nicht? (29.03.2014) Tonzahl = i ' normal: Anzahl der Töne in den Feldern gespeichert Schleifenzahl = jj ' Anzahl der Schleifendurchläufe merken If jj = 10000 Then ' jj = 10000 bedeutet: zu viele erfolglose Schleifendurchläufe Keinton = True End If End Sub Private Sub Statistik_0() Dim q, r, s, rr As Integer For q = 1 To i ' früher Anzahl (war falsch) SH(q) = 0 Next q For q = 1 To i ' früher Anzahl (war falsch) HC(q) = HT(q) Next q For q = 1 To i ' früher Anzahl (war falsch) For rr = 1 To i ' früher Anzahl (war falsch) If HC(q) = HT(rr) Then SH(q) = SH(q) + 1 End If Next rr Next q ' in SH(q) steht jetzt die Häufigkeit des q-ten Tons! For q = 1 To i ' früher Anzahl (war falsch) SHmm(q) = 0 Next q For rr = 1 To i ' früher Anzahl (war falsch) For q = 1 To i ' früher Anzahl (war falsch) If HT(rr) = HC(q) Then SH(rr) = SHmm(q) + 1 SHmm(q) = SH(rr) ' TEST End If Next q Next rr Open "C:\arbeit\Komposi-Test.txt" For Output As 9 Print #9, Date & " " & Time Print #9, "" For q = 1 To i ' Anzahl If Stn <= 1 And Stn < 2 Then Print #9, q & ". die Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 2 Or Stn = 4 Then ' Stn = 4 neu am 25.05.2014 Print #9, q & ". die Tonnummer " & HC(q) & " erscheint zum " & SH(q) & ". mal" End If Next q Close #9 Zuordnung.AddItem "" Zuordnung.AddItem "" Zuordnung.AddItem "Statistik (siehe auch:" Zuordnung.AddItem "C:\Arbeit\Komposi-Test.txt):" Zuordnung.AddItem "" For q = 1 To i ' Anzahl If Stn <= 1 And Stn < 2 Then Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 2 Or Stn = 4 Then ' Stn = 4 neu am 25.05.2014 Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " zum " & SH(q) & ". mal" End If Next q End Sub Private Sub Statistik() Dim q, r, s, rr As Integer ' Folgendes muss unabhängig von Stn durchlaufen werden: For q = 1 To i ' früher Anzahl (war falsch) SH(q) = 0 Next q For q = 1 To i ' früher Anzahl (war falsch) HC(q) = HT(q) Next q For q = 1 To i ' früher Anzahl (war falsch) For rr = 1 To i ' früher Anzahl (war falsch) If HC(q) = HT(rr) Then SH(q) = SH(q) + 1 End If Next rr Next q ' in SH(q) steht jetzt die Häufigkeit des q-ten Tons! ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' So funktioniert der Tonwiederholungszähler - 06.01.2014: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Stn = 2 Or Stn = 4 Then ' bei Stn = 3 NICHT! - Stn = 4 neu am 25.05.2014 ' Dim SHmm(100000) As Integer For q = 1 To i ' früher Anzahl (war falsch) SHmm(q) = 0 Next q For rr = 1 To i ' früher Anzahl (war falsch) For q = 1 To i ' früher Anzahl (war falsch) If HT(rr) = HC(q) Then SH(rr) = SHmm(q) + 1 SHmm(q) = SH(rr) ' TEST End If Next q Next rr End If ' in SH(q) steht jetzt die Erscheinungsnummer des q-ten Tons ' (zum wievielten Mal dieser Ton vorkommt). ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Darstellung der Ergebnisliste in der Datei 'Komposi-Test.txt': ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Open "C:\arbeit\Komposi-Test.txt" For Output As 9 Print #9, Date & " " & Time ' Print #9, "STATISTIK - in Randi05 enthält q die laufende Nummer," ' Print #9, "HC(q) die Tonnummer und SH(q) die Häufigkeit:" Print #9, "" For q = 1 To i ' Anzahl If Stn <= 1 And Stn < 2 Then Print #9, q & ". die Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 3 Then Print #9, q & ". die Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 2 Or Stn = 4 Then ' Stn = 4 neu am 25.05.2014 Print #9, q & ". die Tonnummer " & HC(q) & " erscheint zum " & SH(q) & ". mal" End If Next q Close #9 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Darstellung der Ergebnisliste im Feld 'Zuordnung': ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Zuordnung.AddItem "" Zuordnung.AddItem "Statistik (siehe auch:" Zuordnung.AddItem "C:\Arbeit\Komposi-Test.txt):" Zuordnung.AddItem "" For q = 1 To i ' Anzahl If Stn <= 1 And Stn < 2 Then Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 3 Then Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stn = 2 Or Stn = 4 Then ' Stn = 4 neu am 25.05.2014 Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " zum " & SH(q) & ". mal" End If Next q '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' End Sub Private Sub Statistik2() Dim q, r, s, rr As Integer ' Folgendes muss unabhängig von Stp durchlaufen werden: For q = 1 To i ' früher Anzahl (war falsch) SH(q) = 0 Next q For q = 1 To i ' früher Anzahl (war falsch) HC(q) = HT(q) Next q For q = 1 To i ' früher Anzahl (war falsch) For rr = 1 To i ' früher Anzahl (war falsch) If HC(q) = HT(rr) Then SH(q) = SH(q) + 1 End If Next rr Next q ' in SH(q) steht jetzt die Häufigkeit des q-ten Tons! ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' So funktioniert der Tonwiederholungszähler - 06.01.2014: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Stp = 2 Then ' Dim SHmm(100000) As Integer For q = 1 To i ' früher Anzahl (war falsch) SHmm(q) = 0 Next q For rr = 1 To i ' früher Anzahl (war falsch) For q = 1 To i ' früher Anzahl (war falsch) If HT(rr) = HC(q) Then SH(rr) = SHmm(q) + 1 SHmm(q) = SH(rr) ' TEST End If Next q Next rr End If ' in SH(q) steht jetzt die Erscheinungsnummer des q-ten Tons ' (zum wievielten Mal dieser Ton vorkommt). ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Darstellung der Ergebnisliste in der Datei 'Komposi-Test.txt': ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Open "C:\arbeit\Komposi-Test.txt" For Output As 9 Print #9, Date & " " & Time ' Print #9, "STATISTIK - in Randi05 enthält q die laufende Nummer," ' Print #9, "HC(q) die Tonnummer und SH(q) die Häufigkeit:" Print #9, "" For q = 1 To i ' Anzahl If Stp <= 1 And Stp < 2 Then Print #9, q & ". die Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stp = 2 Then Print #9, q & ". die Tonnummer " & HC(q) & " erscheint zum " & SH(q) & ". mal" End If Next q Close #9 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Darstellung der Ergebnisliste im Feld 'Zuordnung': ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Zuordnung.AddItem "" Zuordnung.AddItem "Statistik (siehe auch:" Zuordnung.AddItem "C:\Arbeit\Komposi-Test.txt):" Zuordnung.AddItem "" For q = 1 To i ' Anzahl If Stp <= 1 And Stp < 2 Then Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " kommt " & SH(q) & " mal vor" End If If Stp = 2 Then Zuordnung.AddItem q & ". Tonnummer " & HC(q) & " zum " & SH(q) & ". mal" End If Next q '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' End Sub Private Sub PatternAnalyse(Pn) Dim zeile, BB, B As String ivb = FreeFile Open Pn For Input As ivb ' Patternfile Zz = 1 ' Zeilenzähler Do Until EOF(ivb) Do Line Input #1, zeile Loop Until Val(zeile) <> 0 ' And Len(Zeile) < 16 ' Leerzeilen entfernen i = 0 ' HT berechnen: BB = "" ' bb = Buchstabensammler, b = gelesener Einzelbuchstabe Do i = i + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vieren Buchstaben lesen End If ' neu am 29.08.2014: If B <> " " Then BB = BB + B ' vierte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen fünften Buchstaben lesen End If If B <> " " Then BB = BB + B ' fünfte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen sechsten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "Falschen Wert für HT eingelesen: " & BB ' Fehler in der Komposi-PT-Datei Call Hallo("Falschen Wert für HT eingelesen: " & BB) ' Fehler in der Komposi-PT-Datei BB = 1 End If If Val(BB) > 127 Then ' MsgBox "Wert für HT größer 127 eingelesen: " & BB ' Fehler in der Komposi-PT-Datei Call Hallo("Wert für HT größer 127 eingelesen: " & BB) ' Fehler in der Komposi-PT-Datei BB = 127 End If HTpv(Zz) = BB ' <---------------------------------------------------- HTp schreiben ' LT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dzutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If End If If Val(BB) < 1 Then BB = 1 End If If Val(BB) > 127 Then ' MsgBox "Wert für LT größer 127 eingelesen: " & BB ' Fehler in der Komposi-PT-Datei Call Hallo("Wert für LT größer 127 eingelesen: " & BB) ' Fehler in der Komposi-PT-Datei BB = 127 End If LTpv(Zz) = BB ' <----------------------------------------------------- LTp schreiben ' DT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If If B <> " " Then BB = BB + B ' vierte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen fünften Buchstaben lesen End If If B <> " " Then BB = BB + B ' fünfte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen sechsten Buchstaben lesen End If If B <> " " Then BB = BB + B ' sechste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen siebten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "Wert für DT kleiner 1 eingelesen!" ' Fehler in der Komposi-PT-Datei Call Hallo("Wert für DT kleiner 1 eingelesen!") ' Fehler in der Komposi-PT-Datei BB = 1 End If ' Der Containerwert, auf den bb zeigt, wird in DTpv(zz) eingetragen: ' DTpv(zz) = DC(bb) ' Nein, die Dauerzahl wird direkt in Dtpv(zz) eingetragen: DTpv(Zz) = Val(BB) ' <------------------------------------------------ DTp schreiben Zz = Zz + 1 Loop ' nächste Zeile aus der Datei holen Pzzv = Zz - 1 ' Anzahl der Patternzeilen Close ivb End Sub Private Sub Regel03() ' wird von Randi06 aufgerufen Regelwort = "Regel 03" txtNot.Text = Regelwort Call Verzoegerung(0.3) ' Das Pattern wird mehrmals wiederholt. ' Ein zufällig gefundener Ton in der Reihe des Musters wird ' in der Tonhöhe verändert. ' Folgendes ist noch einzubauen: ' Die Tonhöhe soll soll erst nach x Durchläufen wieder auftauchen ' Dim HTz As Integer Dim SZ As Integer ' gespeicherte Zufallszahl Dim Zufz As Integer ' Zufallszahl Dim TF As Integer ' Tonhöhenfaktor Dim TFme(10000) As Integer ' Tonhöhenfaktormerker Dim Stt As Integer ' Startton für Duplikatstest Dim Ett As Integer ' Endton für Duplikatstest Dim Dupli As Boolean ' Duplikatsindikator Dim K As Integer ' Zähler Dim nn As Integer ' Zähler Dim AZ As Integer ' Anzahl der Zahlen für die Zufallszahl Dim jjj, jjjj As Integer ' Überlaufzähler ' Juhu, der Duplikationstest funktioniert! (25.02.2014, 18:18) ' Whd = 3 bedeutet, dass sich erst beim 4. Schleifendurchlauf ' der Tranpositionsfaktor TF wieder ändern darf! ' ---------------------------------------------------------------------- ' Nochmals die Patterns auflisten: ' Zuordnung.Clear ' <----- Zuordnung.AddItem "" Zuordnung.AddItem "Pattern aus" Zuordnung.AddItem Patterndatei & ":" Zuordnung.AddItem "" For nn = 1 To Pzz1 Zuordnung.AddItem HTp01(nn) & " " & LTp01(nn) & " " & DTp01(nn) Next nn Zuordnung.AddItem "" Zuordnung.AddItem "Pattern aus" Zuordnung.AddItem Patterndatei2 & ":" Zuordnung.AddItem "" For n = 1 To Pzz2 Zuordnung.AddItem HTp02(n) & " " & LTp02(n) & " " & DTp02(n) Next n Zuordnung.AddItem "" Zuordnung.AddItem "Tonhöhenverschiebungsfaktoren:" AZ = (OGr + 1) - UGr ' So geht das!! <-------- ! Anzahl = Pzz2 ' Anzahl der Patternzeilen i = 0 Text1.Visible = True For n = 1 To LOP ' Anzahl der Schleifendurchgänge TF = 0 Dupli = True Randomize ' Zufallszahl für den ersten Ton finden: ' jjjj = 0 ' Do Until TF >= KTR Or jjjj = 10000 ' neu am 03.06.2014, KTR: kleinstmögliche Transposition ' jjjj = jjjj + 1 TF = Int(Rnd * AZ) + UGr ' Zufallszahl zwischen UGr und OGr Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen ' Loop TFme(n) = TF ' Tonhöhenfaktormerker If n > 1 Then jjj = 0 Do Until Dupli = False Or jjj = 10000 ' Solange suchen, bis Dupli falsch ist jjj = jjj + 1 ' Überlaufzähler Randomize ' jjjj = 0 ' Do Until TF >= KTR Or jjjj = 10000 ' neu am 03.06.2014, KTR: kleinstmögliche Transposition ' jjjj = jjjj + 1 TF = Int(Rnd * AZ) + UGr ' Zufallszahl zwischen UGr und OGr Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen ' Loop TFme(n) = TF ' Tonhöhenfaktormerker ' Duplikatstest: ' -------------------------------------------------------------------- If n > Whd Then Stt = n - Whd Else Stt = 1 ' Startton Stt berechnen Ett = n - 1 ' Endeton Ett berechnen Dupli = False For K = Stt To Ett If TF = TFme(K) Then Dupli = True ' wenn TF mindestens EINEM Element gleich End If ' ist, haben wir ein Duplikat Next K ' -------------------------------------------------------------------- Loop End If Zuordnung.AddItem n & " " & TF If jjj >= 10000 Then ' Zuordnung.AddItem n & " Regel nicht eingehalten!" Zuordnung.AddItem "Regel nicht eingehalten!" End If ' ... endlich ein passendes TF gefunden! ii = 0: jj = 0: SZ = 0 Do Until ii = Anzahl Or jj = 10000 i = i + 1 jj = jj + 1 ii = ii + 1 HT(i) = HTp02(ii) + TF ' NEU am 11.04.2014: HTp02 statt 01 ' If HT(i) < 1 Then HT(i) = 1 ' neu am 28.02.2014 ... raus am 03.06.2014 LT(i) = LTp02(ii) DT(i) = DTp02(ii) Loop Text1.Text = "Ton " & i ' neu am 08.04.2014 ' Text1.Text = "Pattern " & N ' neu am 08.04.2014 Next n If Stn > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik ' neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' neu am 29.03.2014 End If Text1.Visible = False End Sub Private Sub Regel04() ' wird von Randi06 aufgerufen Regelwort = "Regel 04" txtNot.Text = Regelwort Call Verzoegerung(0.3) ' KEINE DURCHLÄUFE MEHR SPEICHERN! ALLE ERZEUGTEN TÖNE ' SIND SOWIESO GESPEICHERT - in HT(), LT() usw.! ' ' Regel 04: ' Wenn zwei gespielte Töne mit einer kleinen Sekunde ' aufeinanderfolgen, dann soll ein zusätzlicher Ton mit einem ' bestimmten Intervall eingefügt werden. ' Wenn zwei gespielte Töne mit einer großen Sekunde ' aufeinanderfolgen, dann soll ein zusätzlicher Ton mit einem ' anderen Intervall eingefügt werden. ' Intervall aufwärts oder abwärts? Zur Zeit nur aufwärts. ' Folgendes lässt sich sehr leicht ändern: Welches Intervall, ' aufwärts oder abwärts, auf welches gespielte Intervall soll ' reagiert werden, usw. Zum Beispiel könnte man auf eine Quart aufwärts ' immer eine große (oder kleine) Terz folgen lassen. ' FOLGENDE NEUERUNG BALD REALISIEREN: ' STATT AUF PATTERNTÖNE ZU SCHAUEN, AUF GESPIELTE TÖNE SCHAUEN! ' ALSO INHALTE VON HT(). Schon realisiert. Dim Zufz As Integer ' Zufallszahl Dim DD As Integer ' Differenz, Abstand zwischen zwei Tönen Dim Hd As Integer ' harmonischer Abstand Dim Intervall As Integer jj = 0 ' Überlaufzähler i = 0 ' Erzeugte-Töne-Zähler Text1.Visible = True For n = 1 To LOP ' LOP = Anzahl der Patternwiederholungen ii = 0 Do Until ii = Pzz2 ' Pzz2 = Gesamtzahl der Patternzeilen ii = ii + 1 ' Patternzeilenzähler i = i + 1 HT(i) = HTp02(ii) ' Patternzeilen --> HT() ' NEU am 11.04.2014: HTp02 statt 01 LT(i) = LTp02(ii) DT(i) = DTp02(ii) DD = Abs(HT(i) - HT(i - 1)) ' Differenz zwischen diesem und dem letzten gespielten Ton If n > 1 Then ' <--------- OO einmal original wiedergeben If DD = 1 Then ' Abstand zwischen 2 Tönen eine kleine Sekunde? Randomize ' Der Zufallsgenerator soll entscheiden, ob große Terz oder Oktave + große Terz Zufz = Int(Rnd * 3) 'Zufallszahl zwischen 0 und 2 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen ' If Zufz = 0 Then Intervall = 4 Else Intervall = 16 If Zufz = 0 Then Intervall = 1 If Zufz = 1 Then Intervall = -1 If Zufz = 2 Then Intervall = 0 i = i + 1 ' nächsten Ton wählen ' HT(i) = HTp02(ii) + Intervall ' EIN NEUER TON DAZU - Intervall HT(i) = HT(i - 1) + Intervall ' EIN NEUER TON DAZU - Intervall If HT(i) < 1 Then HT(i) = 1 ' neu am 28.02.2014 ' LT(i) = LT(i - 2) ' LT(i) = 127 DT(i) = DT(i - 2) ' End If If DD = 2 Then ' Abstand zwischen 2 Tönen eine große Sekunde? Randomize ' Der Zufallsgenerator soll entscheiden, ob Quarte oder Oktave + Quarte: Zufz = Int(Rnd * 3) 'Zufallszahl zwischen 0 und 2 Call Verzoegerung(Vzg * 0.001) ' ohne dies entstehen seltsame Musterwiederholungen ' If Zufz = 0 Then Intervall = 4 Else Intervall = 16 If Zufz = 0 Then Intervall = 2 If Zufz = 1 Then Intervall = -2 If Zufz = 2 Then Intervall = 4 i = i + 1 ' HT(i) = HTp02(ii) + Intervall ' EIN NEUER TON DAZU - Intervall HT(i) = HT(i - 1) + Intervall ' EIN NEUER TON DAZU - Intervall If HT(i) < 1 Then HT(i) = 1 ' neu am 28.02.2014 LT(i) = 127 ' FANTASIEZAHL zum Testen ' LT(i) = LT(i - 1) DT(i) = DT(i - 2) End If End If ' <--------- OO Loop Text1.Text = "Ton " & i ' neu am 08.04.2014 Next n Text1.Visible = False If Stn > 0 Then ' Stn eingefügt am 08.04.2014 Call Statistik ' neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' neu am 29.03.2014 End If End Sub Private Sub Regel05() ' wird von Randi06 aufgerufen ' Zufallsrhythmen für das Pattern 02 (Komposi-02.cap). Die Töne in ' Pattern 01 (Komposi-01.cap) bestimmen die Transpositionen von Pattern 02. ' Rhythmen für Pattern 02 werden per Zufall erzeugt. Rhythmen werden sehr ' interessant, wenn in den Dauern teilweise Nullen stehen! Regelwort = "Regel 05" txtNot.Text = Regelwort Call Verzoegerung(0.3) Dim Zufz As Integer ' Zufallszahl Dim DD As Integer ' Differenz, Abstand zwischen zwei Tönen Dim Hd As Integer ' harmonischer Abstand Dim Intervall As Integer ' Intervall Dim K As Integer ' Zähler Dim Vst As Integer ' Verschiebton Dim a As Integer Dim zfz As Integer ' Zufallszahl Vst = 48 ' 48 jj = 0 ' Überlaufzähler i = 0 ' Erzeugte-Töne-Zähler ' LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL Text1.Visible = True For n = 1 To LOP ' LOP = Anzahl der Patternwiederholungen ii = 0 ' P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1 Do Until ii = Pzz1 ' Pzz1 = Gesamtzahl der Patternzeilen ii = ii + 1 ' Patternzeilenzähler i = i + 1 HT(i) = HTp01(ii) ' Patternzeilen --> HT() LT(i) = LTp01(ii) DT(i) = DTp01(ii) If DT(i) >= 5 Then ' wenn ein Ton im Pattern 1 ein bestimmtes Kriterium erfüllt i = i - 1 ' vielleicht: der Originalton wird gelöscht ' P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2 For K = 1 To Pzz2 i = i + 1 HT(i) = (HTp01(ii) - Vst) + HTp02(K) ' Pattern 2 wird addiert LT(i) = LTp02(K) a = (LTn + 1) - KTn Randomize zfz = Int(Rnd * a) + KTn Call Verzoegerung(Vzg * 0.001) ' DT(i) = DTp02(k) ' <-------- ??????? DT(i) = zfz ' <----------------------------- bisher so! ' DT(i) = DTp01(ii) ' das geht nicht, weil sonst Originaldauern hineinkommen, wir brauchen aber Pointer Next K ' P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2 End If Loop ' P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1 Text1.Text = "Ton " & i ' neu am 08.04.2014 Next n Text1.Visible = False ' LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL If Stn > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik ' neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' neu am 29.03.2014 End If End Sub Private Sub Regel06() ' wird von Randi06 aufgerufen ' Pattern 02 (Komposi-02.cap) wird von Pattern 01 (Kompoosi-01) 'gespielt': ' Tiefe Töne in Pattern 01 spielen das Pattern 02 tief ab, hohe hoch. ' Der Rhythmus von Pattern 01 wirkt sich so aus: Lange Töne spielen Pattern 02 ' langsam ab, kurze Töne spielen Pattern 02 schnell ab. ' ' Neue Idee am 11.03.2014: ' Die Abspiellänge von Pattern 02 soll (zufallsgesteuert) variieren! ' ... von Pattern 01 auch? - ja! <---- ist fertig und funktioniert prima! ' ' Mal eine Testdatei schreiben lassen, in der alle Anfangs- und Schlusstöne ' aufgelistet sind - Komposi-Test.txt! - OK - perfekt! ' ' Idee: Mache nach 100 Tönen eine (lange) Pause! (mal ausprobieren) ' ' Bei Patterns mit von Hand eingegebenen Lautstärken müssten jetzt schon ' interessante Lautstärkekombinationen entstehen! ' Wäre es sinnvoll, zusätzlich automatische Lautstärken generieren zu lassen? ' Nach welchen Kriterien? Regelwort = "Regel 06" txtNot.Text = Regelwort Call Verzoegerung(0.3) Dim DD As Integer ' Differenz, Abstand zwischen zwei Tönen Dim Hd As Integer ' harmonischer Abstand Dim Intervall As Integer ' Intervall Dim K As Integer ' Zähler Dim Vst As Integer ' Verschiebton Dim a As Integer ' Hilfsvariable Dim zfz, zfz1, zfz2 As Integer ' Zufallszahlen Dim ATon1, ETon1 As Integer ' Anfangston, Schlusston für Pattern 01 Dim ATon2, ETon2 As Integer ' Anfangston, Schlusston für Pattern 02 Dim steppi1, steppi2 As Integer ' für STEP Dim h As Integer ' zum Zwischenspeichern Vst = 48 ' 48 jj = 0 ' Überlaufzähler i = 0 ' Erzeugte-Töne-Zähler steppi1 = 1 ' Grundeinstellung, für 'Aufwärts' steppi2 = 1 ' Grundeinstellung, für 'Aufwärts' ' LOOPLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLOOP ivb = FreeFile Open "C:\Arbeit\Komposi-Test2.txt" For Output As ivb ' Testdatei Text1.Visible = True Print #ivb, Date & " " & Time Print #ivb, "" For n = 1 To LOP ' LOP = Anzahl der Patternwiederholungen ' P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1 Print #ivb, n & ". Schleife:" ' Erste Zufallszahl für den Start- oder Schlusston von Pattern 01: a = (Pzz1 + 1) - 1 Randomize zfz1 = Int(Rnd * a) + 1 ' Wert zwischen 1 und Patternzeilenzahl Call Verzoegerung(Vzg * 0.001) ' Zweite Zufallszahl für den Start- oder Schlusston von Pattern 01: a = (Pzz1 + 1) - 1 Randomize zfz2 = Int(Rnd * a) + 1 ' Wert zwischen 1 und Patternzeilenzahl Call Verzoegerung(Vzg * 0.001) If zfz2 > zfz1 Then ATon1 = zfz1: ETon1 = zfz2 Else ATon1 = zfz2: ETon1 = zfz1 End If ' If ATon1 = ETon Then MsgBox "Pattern 01:" & ATon1 & " " & ETon1 ' TEST ' MsgBox "Pattern 01: " & ATon1 & " bis " & ETon1 If VR1 = True Then a = (1 + 1) - 0 ' Zufallszahl 0 oder 1 erzeugen Randomize zfz = Int(Rnd * a) + 0 ' Zufallszahl 0 oder 1 erzeugen Call Verzoegerung(Vzg * 0.001) If zfz = 1 Then ' vorwärts steppi1 = -1 h = ATon1 ' Hilfsvariable ATon1 = ETon1 ' getauscht ETon1 = h ' getauscht Else steppi1 = 1 End If End If Print #ivb, "Pattern 01: " & ATon1 & " bis " & ETon1 ' zur Kontrolle in die Datei schreiben For ii = ATon1 To ETon1 Step steppi1 i = i + 1 HT(i) = HTp01(ii) ' Patternzeilen --> HT() LT(i) = LTp01(ii) DT(i) = DTp01(ii) If DT(i) >= 5 Then ' wenn ein Ton im Pattern 1 ein bestimmtes Kriterium erfüllt i = i - 1 ' vielleicht: der Originalton wird gelöscht ' P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2 ' Erste Zufallszahl für den Start- oder Schlusston von Pattern 02: a = (Pzz2 + 1) - 1 Randomize zfz1 = Int(Rnd * a) + 1 ' Wert zwischen 1 und Patternzeilenzahl Call Verzoegerung(Vzg * 0.001) ' Zweite Zufallszahl für den Start- oder Schlusston von Pattern 02: a = (Pzz2 + 1) - 1 Randomize zfz2 = Int(Rnd * a) + 1 ' Wert zwischen 1 und Patternzeilenzahl Call Verzoegerung(Vzg * 0.001) If zfz2 > zfz1 Then ATon2 = zfz1: ETon2 = zfz2 Else ATon2 = zfz2: ETon2 = zfz1 End If ' If ATon2 = ETon Then MsgBox "Pattern 02:" & ATon2 & " " & ETon2 ' TEST ' MsgBox "Pattern 02: " & ATon2 & " bis " & ETon2 ' Print #iVB, "Pattern 02: " & ATon2 & " bis " & ETon2 ' ---------------------------- neu: If VR2 = True Then a = (1 + 1) - 0 ' Zufallszahl 0 oder 1 erzeugen Randomize zfz = Int(Rnd * a) + 0 ' Zufallszahl 0 oder 1 erzeugen Call Verzoegerung(Vzg * 0.001) If zfz = 1 Then ' vorwärts steppi2 = -1 h = ATon2 ' Hilfsvariable ATon2 = ETon2 ' getauscht ETon2 = h ' getauscht Else steppi2 = 1 End If End If Print #ivb, "Pattern 02: " & ATon2 & " bis " & ETon2 ' zur Kontrolle in die Datei schreiben For K = ATon2 To ETon2 Step steppi2 i = i + 1 HT(i) = (HTp01(ii) - Vst) + HTp02(K) ' Pattern 2 wird addiert LT(i) = LTp02(K) ' Pausen in Pattern 01 werden nicht berücksichtigt! DT(i) = DTp01(ii) * DTp02(K) / 400 ' TEST Next K ' ------------------------------------------ ' P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2P2 End If Next ii Print #ivb, "" ' P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1P1 Text1.Text = "Ton " & i ' neu am 08.04.2014 Next n Text1.Visible = False Close ivb ' LOOPLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLOOP If Stn > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik ' neu am 29.03.2014 End If If Stp > 0 Then ' Stp eingefügt am 08.04.2014 Call Statistik2 ' neu am 29.03.2014 End If End Sub Private Sub schreib() ' Melodie in die Tönedatei schreiben Dim zeile As String Dim i As Integer If Tonzahl > 0 Then i = 0 Open KT For Output As 2 Do Until i = Tonzahl i = i + 1 Dim Mldg, Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton1 ' Schaltfläche definieren. Titel = "FEHLER" If (HT(i) + Trs) < 1 Then Mldg = "Als Tonhöhe wurde " & HT(i) & " gelesen - wird als 1 interpretiert - fortfahren?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort <> vbYes Then End ' Programmende End If If (HT(i) + Trs) < 1 Then HT(i) = 1 - Trs ' <---- !! 28.02.2014 zeile = HT(i) + Trs & " " & LT(i) & " " & DT(i) ' + Trs NEU am 27.01.2014 Print #2, zeile ' <--------- in die Tönedatei schreiben Loop Close 2 End If End Sub Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ' Label5.Visible = False Label5.FontBold = True ' Label5.ForeColor = vbRed Label5.ForeColor = vbBlack End Sub ' Private Sub Label5_click() ' Call Kurzubersicht_Click ' End Sub Private Sub List2_Click() erklaminus.Visible = False erklaplus.Visible = False If breit = False Then Daten.Visible = False Zuordnung.Visible = False List2.Width = 11540 List2.ForeColor = vbBlack breit = True inidat.Height = idahe ibreit = False Else Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe breit = False End If ' Call Textscroller("C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt") ' entfernt am 27.04.2014 ' Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt" ' (dauert zu lange) End Sub Private Sub NeueRegelInfo_Click() ubs = False Label5.Visible = False erklaminus.Visible = False erklaplus.Visible = False 'Call Initial Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False inidat.FontBold = True inidat.FontSize = 12 '------------------------------- inidat.Clear inidat.AddItem "" inidat.AddItem " Anleitung zum Einbau neuer Regeln." inidat.AddItem " Beispiel für eine neue Regel 07." inidat.AddItem "" inidat.AddItem " * Ein neues Unterprogramm" inidat.AddItem " 'Sub Regel 07' schreiben." inidat.AddItem "" inidat.AddItem " * In Randi06 einen neuen Programmaufruf" inidat.AddItem " 'If TFm = 7 then call Regel 07'" inidat.AddItem " eintragen." inidat.AddItem " " inidat.AddItem " * Eintrag der Erläuterung zur Regel in" inidat.AddItem " einem neuen Unterprogramm 'Sub U07'." inidat.AddItem " Sie erscheint beim Drücken von 'Regel'." inidat.AddItem " " inidat.AddItem " * Private Sub erklaminus_Click() und" inidat.AddItem " Private Sub erklaplus_Click()" inidat.AddItem " erweitern!" inidat.AddItem " " inidat.AddItem " * In Komposi.ini bei den Erläuterungen" inidat.AddItem " unter Tfm die neue Regel kurz erwähnen." '------------------------------- Label2.Caption = "" ' hier neu am 18.05.2014 'Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Erweiterung.txt" End Sub Private Sub Reaperstart_Click() Shell "C:\Programme\REAPER\reaper.exe " & "C:\\Arbeit\Komposi.rpp" End Sub Private Sub Reaperstart2_Click() Shell "C:\Programme\REAPER\reaper.exe " & "C:\\Arbeit\Komposi-HCR.rpp" End Sub Private Sub Samplemix_Click() Dim Samplemix(1000) As String Dim m, n As Integer Dim Mldg, Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton2 ' Schaltfläche definieren. Titel = "Frage zur Sicherheit" Mldg = "wirklich Samplemix? (Komposi.ini wird dann verändert)?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort <> vbYes Then GoTo Sube Erase Samplemix n = 0 n = n + 1: Samplemix(n) = "Komposi-Einstellungen - Schlüsselwörter und ihre Werte." n = n + 1: Samplemix(n) = "Für übersichtliche Darstellung auf den Knopf 'INI' klicken." n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "TONFINDUNGSMETHODE 1 (TFm) 0.1 = Testmodus, 0.2 = Alle Töne (oder Samples) werden in normaler Reihenfolge einmal durchgespielt, 1 = Regel 01, 2 = Regel 02 usw., bis (z.Zt.) Regel 06." n = n + 1: Samplemix(n) = "SOUND 3 (Snd) 1 oder 3 ... 1 = MIDI-Modus, 2 und 4 = außer Betrieb, 3 = SAMPLE-Modus mit Komposi-HCR.rpp mit großen Samples und Ansteuerung per 'Position'" n = n + 1: Samplemix(n) = "TEMPO 1 (tempi), (Vsl) Tempo - 0.001 ... 10 oder mehr. Wirkt sich bei 'PLAY' aus!" n = n + 1: Samplemix(n) = "TRANSPONI 0 (Trs) Bspl.: 12, -3, 0.25 - Für MIDI: Transposition der gesamten Melodie, für den SAMPLER wirkt sich das als Verschiebung aus. Wirkt in Sub Schreib!" n = n + 1: Samplemix(n) = "TONDAUERDIREKT 0 (Tdd) 0 = nein oder 1 = ja (wird vom Programm bei Regel 05 auf 0, bei Regel 03 und Regel 06 und TEST auf 1 gesetzt! 1 = Tondauernangabe gemäß Komposi.txt, 0 = Liste in Komposi-DTC verwenden. Wirkt sich bei 'PLAY' aus." n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Einstellungen für Regel 01 und teilweise Regel 02:" n = n + 1: Samplemix(n) = "ANZAHL 1000 (Anzahl), (Anz) Anzahl Töne - gilt nur bei TFm 1 oder 2" n = n + 1: Samplemix(n) = "NOTENWERT 1 (Tda) damit entsteht Rhythmus. Bei Tondauerdirekt = 0 gilt: 1 = nur Vierundsechzigstelnote, 12 = 16-fach ganze Note. Tda gilt nur bei TFm 1 und 2" n = n + 1: Samplemix(n) = "LAUTVAR 1 (Lva) 1 = keine, 127 = stärkste - nur bei TFm kleiner 3" n = n + 1: Samplemix(n) = "STARTTON 1 (Sto) Tonhöhe des ersten Tons - nur bei TFm kleiner 3" n = n + 1: Samplemix(n) = "TIEFTON 1 (Ttn) (gilt nicht im SAMPLE-Modus): tiefster Ton - nur bei TFm kleiner 3" n = n + 1: Samplemix(n) = "HOCHTON 1000 (Htn) (gilt nicht im SAMPLE-Modus): höchster Ton - nur bei TFm kleiner 3" n = n + 1: Samplemix(n) = "INTERVALL 1000 (Iva) 1 = Halbtöne, 2 = Ganztöne, 12 = Oktave usw. - nur bei TFm 1 oder 2" n = n + 1: Samplemix(n) = "KLEINERGROSSER 1 (Kgl) 1 = Intervalle gleich oder kleiner dem eingestellten Intervall, 3 = gleich - gilt nur bei TFmr kleiner 3" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Spezielle Einstellung für Regel 02 bei der Verwendung von Samples:" n = n + 1: Samplemix(n) = "SAMPLELOOPS 1 (SPL) 1, 2, 3, 4, ... größtmögliche Anzahl der unmittelbaren Samplewiederholungen. dazu passt gut die Einstellung Stn = 3" n = n + 1: Samplemix(n) = "SAMPLETRANSU -15 (SAU) tiefstmögliche Sampletransposition in Regel 02" n = n + 1: Samplemix(n) = "SAMPLETRANSO 15 (SAO) höchstmögliche Sampletransposition in Regel 02" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Einstellungen für Regel 03, 04, 05, 06:" n = n + 1: Samplemix(n) = "WIEVIELELOOPS 25 (LOP) Gibt an, wie oft ein Pattern wiederholt werden soll. Gilt für alle Regeln, die Patterns verwenden" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Spezielle Einstellungen für Regel 03:" n = n + 1: Samplemix(n) = "WIEDERHOLUNGSDISTANZ 15 (Whd) Einstellung für Regel03: Wieviele Patterndurchläufe, bis eine Wiederholung derselben Transposition erlaubt wird. Erst nach Whd Tönen darf es sich wiederholen!" n = n + 1: Samplemix(n) = "UNTERGRENZE -20 (UGr) Einstellung für Regel03: Maximale Transposition nach unten (Transposition heißt hier: Verschiebung innerhalb der Sampleliste)" n = n + 1: Samplemix(n) = "OBERGRENZE 310 (OGr) Einstellung für Regel03: Maximale Transposition nach oben (Transposition heißt hier: Verschiebung innerhalb der Sampleliste)" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Spezielle Einstellungen für Regel 05:" n = n + 1: Samplemix(n) = "KURZTON 1 (KTn) Kürzester Ton. Es werden die Werte der Liste in Komposi-DTC verwendet. Die Anzahl der Werte hängt von der Größe dieser Liste ab. Tdd wird bei Regel 05 automatisch auf 0 gesetzt." n = n + 1: Samplemix(n) = "LANGTON 1 (LTn) Längster Ton. Es werden die Werte der Liste in Komposi-DTC verwendet. Die Anzahl der Werte hängt von der Größe dieser Liste ab. Tdd wird bei Regel 05 automatisch auf 0 gesetzt." n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Spezielle Einstellungen für Regel 06:" n = n + 1: Samplemix(n) = "VORRUCK01 0 (VR1) 1: Vorwärts- Rückwärtsspielen von Pattern 01 erlauben, 0: nur Vorwärts spielen" n = n + 1: Samplemix(n) = "VORRUCK02 0 (VR2) 1: Vorwärts- Rückwärtsspielen von Pattern 02 erlauben, 0: nur Vorwärts spielen" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Einstellungen für Samples" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "SAMPLENUMMER 0 (Snn) 0 = Samplename schreiben, 1 = Samplenummer schreiben, 2 Sample-Info schreiben" n = n + 1: Samplemix(n) = "ORIGINALSAMPLEABSTAND 1 (Oga) 0 = aus: Der Sampleabstand hängt von der in Komposi.txt angegebenen Dauer ab, 1 = ein: Bei Tempo 1 ist der Sampleabstand gleich der Sampledauer, bei anderen Tempi ist er proportional zur Sampledauer." n = n + 1: Samplemix(n) = "ORIGINALSAMPLEDAUER 1 (Ogs) 0 = aus: Die Dauer wird von Komposi.txt gesteuert, 1 = ein: die Dauer ist unabhängig von der in Komposi.txt angegebenen Dauer" n = n + 1: Samplemix(n) = "ZWISCHENRAUM 0.1 (Zwv) 0, 10, 200, -30 usw.: Zeit zwischen Samples" n = n + 1: Samplemix(n) = "ÜBERLAPPUNG 0 (Ubl) z.B. 0.01, 0.05, 0.1, -0.03 ... verlängert oder verkürzt die Samples um den angegebenen Betrag!" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "KEYTRANSPOSE 0 (KTP) 0, 1, 2, 3 - 0 = nein, 1 = Komposi-HC.txt Zeile 1 bekommt Tonhöhe aus Komposi.txt, 2 = Zufallszeile in Komposi-HC.txt bekommt die Tonhöhe, 3 = Sample-Zeilenfolge" n = n + 1: Samplemix(n) = "SAMPLETUNING 0 (Stn) 0, 1, 2, 3, 4 ... (0 = aus, 1 = Häufigkeitsfeststellung, 2 = Tonwiederholungszähler: Aufwärtstransposition, 3 = Zufallsmelodien, 4 = Tonwiederholungszähler: Abwärtstransposition - 03.06.2014" n = n + 1: Samplemix(n) = "TONHÖHENÄNDERUNGSFAKTOR 0.25 (THf) wirkt nur, wenn Stn nicht 0 ist - Bsp.: 1 Halbton höher, -0.5 Viertelton niedriger. Bei Stn = 3: Faktor für Melodieauslenkung" n = n + 1: Samplemix(n) = "SAMPLEOFFSETTUNE 0 (HTo) Bsp.: 0, 1, 2.5, -3.7 ... Globale Tonhöhenverschiebung (Sample-Gesamt-Tonhöhenverschiebung)" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "SAMPLESTARTPUNKTMODUS 0 (Stp) 0, 1, 2 (0 = aus, 1 = Häufigkeitsfeststellung, 2 = Tonwiederholungszähler" n = n + 1: Samplemix(n) = "SAMPLEVERSCHIEBUNGSFAKTOR 0 (Stf) wirkt nur, wenn Stp nicht 0 ist - Bsp.: Bei 0.1 wird der Samplestartpunkt bei jeder Tonwiederholung um 0.1 Sekunden nach hinten verschoben" n = n + 1: Samplemix(n) = "SAMPLEOFFSETSTART 0 (SOT) ... Bsp.: 0, 0.001, -0.025 ... Globale Samplestartverschiebung (Sample-Gesamt-Zeitpunktverschiebung). Einheit: Sekunden" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "AUTOPAN 0 (Atp) 0 = aus, 1 = ein - Samples werden im Raum verteilt - funktioniert nur, wenn mehrere Spuren geschrieben werden!" n = n + 1: Samplemix(n) = "TRACKZAHL 1 (Trz) 1 ... 8 - Anzahl der Tracks" n = n + 1: Samplemix(n) = "PANBREITE 5 (Pbr) 0, 1, 2, 3, .. noch nicht implementiert" n = n + 1: Samplemix(n) = "SAMPLEEINSCHWING 2 (Sfi) 0.5, 1.5, 2.33, 3, .. (Fade in einstellen) - noch nicht getestet" n = n + 1: Samplemix(n) = "SAMPLEAUSSCHWING 25 (Sfo) 0.5, 1.5, 2.33, 3, .. (Fade out einstellen) - noch nicht getestet" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Einstellungen für Konvertierung Komposi.txt zu Capella (Komposi-Cap.xml):" n = n + 1: Samplemix(n) = "TAKT 0 (TKT) 0 = keine Taktstriche, Eingaben: 44 für 4/4, 68 für 6/8, 716 für 7/16 usw. (die erste Stelle für den Zähler und die rechte Seite, eine oder zwei Stellen, für den Nenner)" n = n + 1: Samplemix(n) = "VBSCHLUSSEL 1 (VBS) 1 = Violinschlüssel, 2 = Bass-Schlüssel" n = n + 1: Samplemix(n) = "TRANSPOSIWERT 0 (TRN) Transposition beim Schreiben der Noten. 0 = keine Transposition, 1 = Halbton höher usw." n = n + 1: Samplemix(n) = "KURZESTWERT 16 (KZW) Kürzester geschriebener Wert. Mögliche Werte: 128, 64, 32, 16, 8, 4. 16 bedeutet Sechzehntel, 4 bedeutet Viertel, usw." n = n + 1: Samplemix(n) = "NOTENPROZEILE 18 (NPZ) Z.B. 20: Nach jeweils 20 Noten erfolgt ein Zeilenumbruch" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "" n = n + 1: Samplemix(n) = "Einstellung für den Programmlauf:" n = n + 1: Samplemix(n) = "VERZOGERUNG 10 (Vzg) ca. 1 bis 50 - Wert für den Zufallsgenerator. Wenn ungewollte Wiederholungsmuster entstehen, muss dieser Wert erhöht werden. Dann gehen die Berechnungen langsamer." ivb = FreeFile Open "C:\Arbeit\Komposi.ini" For Output As ivb For m = 1 To n Print #ivb, Samplemix(m) Next m Close #ivb 'Komposi-HCR wird nicht verändert, nur Komposi.ini. ' ------------------------------------------------------------------------------------------- ivb = FreeFile Open "C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt" For Append As ivb Print #ivb, "" Print #ivb, "Es wurde Samplemix durchgeführt" Print #ivb, "am " & Date & " um " & Time & " Uhr" Close #ivb ' Refresh Listbox 'List2' (27.07.2014) List2.ForeColor = vbBlue Call Textscroller("C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt") ' ------------------------------------------------------------------------------------------- reingeholt2 = True Call main.Kurzubersicht_Click ' die rote Infotafel soll gezeigt werden Sube: End Sub Private Sub Startknopf_Click() ubs = False erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False Text1.Visible = False inidat.ForeColor = vbBlack inidat.FontBold = False inidat.FontSize = 8 Command1.Enabled = False Startknopf.TabIndex = 0 Stopp.TabIndex = 1 ' Startknopf.Visible = False Startknopf.Enabled = False Dateiherstellung.Enabled = False Capellanotenwandeln.Enabled = False Capellanotenwandeln2.Enabled = False KomposiCap.Enabled = False Command4.Enabled = False Kurzubersicht.Enabled = False Ubersicht.Enabled = False Command2.Enabled = False Command8.Enabled = False Command3.Enabled = False Command5.Enabled = False Command9.Enabled = False Command6.Enabled = False Command7.Enabled = False Command10.Enabled = False Ubersicht_Notenschreiben.Enabled = False Dateiherstellung.BackColor = &HC0FFFF ' &HFFFFC0 ' &HC0FFC0 ' &HC6C3FF Startknopf.BackColor = &H288F24 ' &H84FF84 ' grün Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe breit = False ibreit = False Call Initial ' If TFm = 5 Then Tdd = 0 ' <------------ NEU am 10.03.2014 ' If TFm = 6 Then Tdd = 1 ' <------------ NEU am 10.03.2014 all_sounds_off ' Call Inidateilesen Laut = 80 ' Lautstärke Voreinstellung, falls nötig mi = True ' jetzt soll das Frequenzdisplay etwas anzeigen Stopvalu = False Reaperstart.BackColor = &HE0E0E0 ' grau 'Daten.ForeColor = &H40C0 ' braun Daten.ForeColor = &H15B00 ' grün ' &H0040C0 ' HFF ' &H40C0 ' braun Daten.FontBold = False Daten.FontSize = 8 Call Dauerncontainer_fullen("C:\Arbeit\Komposi-DTC.txt") ' neu an dieser Stelle Call Neuton ' <================== ' &H00FFFFC0& ' Startknopf.BackColor = &HFFFFC0 Startknopf.BackColor = &HC0FFFF 'Startknopf.Visible = True Startknopf.Enabled = True Dateiherstellung.Enabled = True Capellanotenwandeln.Enabled = True Capellanotenwandeln2.Enabled = True KomposiCap.Enabled = True 'Capellanotenwandeln.Visible = True Command1.Enabled = True Command4.Enabled = True Kurzubersicht.Enabled = True Ubersicht.Enabled = True Command2.Enabled = True Command8.Enabled = True Command3.Enabled = True Command5.Enabled = True Command9.Enabled = True Command6.Enabled = True Command7.Enabled = True Command10.Enabled = True Ubersicht_Notenschreiben.Enabled = True End Sub Sub Neuton() Dim zeile, BB, B As String Dim Lta As Single Erase HT 'Die neu erzeugten oder handgeschriebenen Töne aus der Tönedatei LESEN: '--------------------------------------------------------------------------- ' On Error GoTo erl ' wenn er keine Datei gefunden hat ' Call Schlusselwort_finden("SOUND") ' in m steht dann der Wert ' Snd = Val(m) ' If Snd > 1 Then Snd = 2 Else Snd = 1 If Snd = 1 Then ' MIDI Call Schlusselwort_finden("AUTOPAN") ' in m steht dann das Ergebnis If Val(m) > 0 Then Atp = Val(m) Else Atp = 0 Call Schlusselwort_finden("TRACKZAHL") ' in m steht dann das Ergebnis If Val(m) > 0 And Val(m) <= 8 Then Trz = Val(m) Else Trz = 8 ' default: 8 Spuren If Trz = 1 Then Atp = 0 End If If Snd = 2 Then ' ------------------------------------------------------------------------------- Call Zuordnungen ' Tonhöhenwerten (aus HT()) werden Samples zugeordnet ' Call Zuordnungen vielleicht besser in Randi..? <--- ' iHC enthält jetzt die Anzahl der Einträge in Komposi-HC.txt! ' ------------------------------------------------------------------------------- If Regelwort <> "" Then txtNot.Text = Regelwort: Text5.Text = "" Call Verzoegerung(0.3) Else txtNot.Text = "SAMPLER": Text5.Text = "" Call Verzoegerung(0.9) End If ' txtNot.Text = "SAMPLER": Text5.Text = "" Label2.Caption = "D e r A u t o s a m p l e r" ' Leuchtfarbe.Visible = False: Leuchtfarbe2.Visible = False: Leuchtfarbe3(0).Visible = False: Leuchtfarbe4(1).Visible = False: Leuchtfarbe5(0).Visible = False: Leuchtfarbe6(1).Visible = False Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False End If If Snd = 3 Or Snd = 4 Then ' SAMPLE-Ausgabe - Input: Komposi-HCR.rpp <-------- ! NEU am 22.04.2014 Call Zuordnungen2 ' KL(i) füllen aus Komposi-HCR.rpp (muss vorher umgewandelt werden) ' Tonhöhenwerten (aus HT()) werden Samples zugeordnet Call Zuordnungsliste_schreiben ' <------------------------------------- raus am 24.04.2014? - nein. txtNot.Text = "SAMPLER": Text5.Text = "" Call Verzoegerung(0.9) Label2.Caption = "D e r A u t o s a m p l e r" Command1.Visible = True Reaperstart.Visible = True Stopp.Visible = False End If If Snd = 1 Then If Regelwort <> "" Then txtNot.Text = Regelwort Call Verzoegerung(0.3) Else txtNot.Text = "WAVETABLE" Call Verzoegerung(0.9) End If Label2.Caption = "D e r M e l o d i e n s p i e l e r" ' Leuchtfarbe.Visible = True: Leuchtfarbe2.Visible = True: Leuchtfarbe3(0).Visible = True: Leuchtfarbe4(1).Visible = True: Leuchtfarbe5(0).Visible = True: Leuchtfarbe6(1).Visible = True Command1.Visible = False Reaperstart.Visible = False Stopp.Visible = True End If ' Die Zeilen der Melodiedatei C:\Arbeit\Komposi.txt lesen und analysieren ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ' Hier eventuell: ' Call Komposinotenlesen ' <----------------- 19.03.2014 'On Error GoTo erl Open KT For Input As 1 ' (KT = C:\Arbeit\Komposi.txt) Zz = 1 ' Zeilenzähler Do Until EOF(1) Do Line Input #1, zeile Loop Until Val(zeile) <> 0 ' And Len(Zeile) < 16 ' Leerzeilen entfernen i = 0 ' HT berechnen: BB = "" ' bb = Buchstabensammler, b = gelesener Einzelbuchstabe Do i = i + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vieren Buchstaben lesen End If ' neu am 21.07.2014: If B <> " " Then BB = BB + B ' Vierte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' Noch einen fünften Buchstaben lesen. End If ' So können bis zu 9999 Samples verwendet werden End If If Val(BB) < 1 Then Call Hallo("Falschen Wert für HT eingelesen: " & BB) ' Fehler in der Komposi-Datei BB = 1 End If If Val(BB) > 127 And Snd = 1 Then ' NEU: bei Snd = 2 (Sample) dürfen die Werte höher sein! Call Hallo("Wert für HT größer 127 eingelesen: " & BB) ' Fehler in der Komposi-Datei BB = 127 End If HT(Zz) = BB ' <------------------------------------- HT ins Feld ' MsgBox "HT(" & zz & ") : " & HT(zz) ' LT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "Wert für LT kleiner 1 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)" Call Hallo("Wert für LT kleiner 1 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)") BB = 1 End If If Val(BB) > 127 Then ' MsgBox "Wert für LT größer 127 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)" Call Hallo("Wert für LT größer 127 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)") BB = 127 End If LT(Zz) = BB ' <------------------------------------- LT ins Feld ' DT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If If B <> " " Then BB = BB + B ' vierte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen fünften Buchstaben lesen End If If B <> " " Then BB = BB + B ' fünfte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen sechsten Buchstaben lesen End If If B <> " " Then BB = BB + B ' sechste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen siebten Buchstaben lesen End If If B <> " " Then BB = BB + B ' siebte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen achten Buchstaben lesen End If If B <> " " Then BB = BB + B ' achte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen neunten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "in Neuton Wert für DT kleiner 1 eingelesen!" ' Fehler in der Komposi-Datei BB = 1 End If If Tdd = 0 Then ' wenn TONDAUERDIREKT nicht gesetzt ist ' Der Containerwert, auf den bb zeigt, wird in DT(zz) eingetragen: DT(Zz) = DC(BB) Else DT(Zz) = BB End If ' MsgBox "DT(" & zz & ") : " & DT(zz) Zz = Zz + 1 Loop ' nächste Zeile aus der Datei holen ' Close 1 ' /////////////////////////////////////////////////////////////////////////////////////////// If Snd = 1 Then Call Midispielen ' <------------ Seit dem 27.12.2013 als Subroutine End If ' If Snd = 2 And KL(1) <> "" Then ' NEU - falsch war KL(HT(1)) <---- ! If Snd = 2 Or Snd = 3 Or Snd = 4 Then ' NEU - falsch war KL(HT(1)) <---- ! Call Reaperdateischreiben_3 ' NEU am 27.12.2013 - 30.12.2013 End If GoTo erm erl: ' MsgBox "FEHLER: Keine Töne in " & KT & " gefunden" Call Hallo("FEHLER: Keine Töne in " & KT & " gefunden") erm: Close 1 End Sub Private Sub Midispielen() 'Jetzt diese Töne abspielen '--------------------------------------------------------------------------- 'Dim lauti, tempi As Single Dim Lta As Single Dim Vzo, korri As Double ' Korrekturfaktor korri = 4800 ' 4800 ist wohl richtig! i = 1 ' brauchen wir nicht: ' Call Schlusselwort_finden("LAUT") ' lauti = Val(m) ' lauti ist der Lautstärkefaktor ' If lauti = 0 Then lauti = 80 ' Lautstärkefaktor default lauti = 80 ' Call Schlusselwort_finden("TEMPO") ' tempi = Val(m) ' tempi ist die Tempoeinstellung ' If tempi = 0 Then tempi = 1 ' Tempoeinstellung default Dim Z, z2 As Integer Z = 0: z2 = 0 ' Daten.Clear ' außer Betrieb gesetzt am 15.05.2014 Daten.AddItem "" Daten.AddItem "Anzahl der Schleifendurchläufe" Daten.AddItem "im Tonfindungsgenerator: " & Schleifenzahl Daten.AddItem "" Do While HT(i) > 0 Z = Z + 1: z2 = z2 + 1 Lta = lauti / 100 ' Lautstärkefaktor - neu: aus INI-Datei gelesen If Lta < 0.01 Then Lta = 0.01 ' Lautstärkefaktor - Begrenzung If Lta > 1 Then Lta = 1 ' Lautstärkefaktor - Begrenzung ' If TFm = 1 Then Vsl = tempi / 200 ' NEU am 01.03.2014 - wieder rausgeworfen am 01.05.2014 If TFm = 0.1 Then Vsl = tempi / 10 ' NEU am 30.04.2014 If TFm = 0.2 Then Vsl = tempi / 10 ' NEU am 05.05.2014 If TFm = 2 Then Vsl = tempi / 200 ' NEU am 01.03.2014 - weg am 15.05.2014 If TFm = 2 Then Vsl = tempi ' 15.05.2014 If Oga = 0 Then Vsl = tempi / 1000 ' neu am 16.05.2014 If TFm > 2 Then Vsl = tempi ' Vsl = Tempofaktor - aus INI-Datei gelesen Vzo = DT(i) / korri / Vsl ' korri = Dauernfaktor ' PLAY: ' ==================================================================== Call sb_play_Change(HT(i), LT(i) * Lta) ' einen Ton spielen <----- ' ==================================================================== ' Die gespielten Töne der Töneliste zur Kontrolle auflisten: If Z < 28 Then ' 22 Daten.AddItem i & " " & HT(i) & " " & LT(i) & " " & DT(i) Else Daten.Clear Daten.AddItem i & " " & HT(i) & " " & LT(i) & " " & DT(i) Z = 0 End If ' ==================================================================== Call Verzoegerung(Vzo) ' ==================================================================== If Stopvalu = True Then Stopvalu = False: GoTo erm ' Stopptaste! i = i + 1 Loop Call note_off(0, Vornote) ' Note ausschalten Close 1 ' <----------------------------------------- wozu ist das ????? Daten.Clear If z2 > 0 Then Daten.AddItem "Anzahl der Schleifendurchläufe" Daten.AddItem "im Tonfindungsgenerator: " & Schleifenzahl Daten.AddItem "" For ii = 1 To z2 Daten.AddItem ii & " " & HT(ii) & " " & LT(ii) & " " & DT(ii) ' <----- hier die komplette Liste Next ii Else Daten.AddItem "" Daten.AddItem " Keine Töne erzeugt." Daten.AddItem " Die Einstellungen in" Daten.AddItem " Komposi.ini müssen" Daten.AddItem " geändert werden!" End If Exit Sub ' ??? Call note_off(0, Vornote) ' Note ausschalten Daten.Clear For ii = 1 To z2 Daten.AddItem HT(ii) & " " & LT(ii) & " " & DT(ii) Next ii erm: End Sub Private Sub Zuordnungen2() ' NEU am 24.04.2014 ' Die Datei mit den Samples, Komposi-HCR.rpp, ' wird gelesen und interpretiert. Dim HCR As String Dim i As Integer Dim m As Integer Dim Suchwort As String Dim Wort As String Dim ZEIPU As Double Dim LENGU As Double Dim NAMU As String Dim LAUTU As String Dim LAUTU2 As String Dim TONHU As String Dim j As Integer Dim l As Integer Dim B, BB As String Dim INF22 As String Dim tabu(20) As Integer Erase KL ' KL() löschen! j = 0 iVB1 = FreeFile Open "C:\Arbeit\Komposi-HCR.txt" For Output As iVB1 ' Testdatei Komposi-HCR.txt <--- iVB2 = FreeFile On Error GoTo Keinedateida Open "C:\Arbeit\Komposi-HCR.rpp" For Input As iVB2 ' vorbereitetes Reaperfile tabu(1) = 8: tabu(2) = 30: tabu(3) = 38: tabu(4) = 50: tabu(5) = 58: tabu(6) = 66: tabu(7) = 74 Print #iVB1, Date & " " & Time Print #iVB1, "Format in C:\Arbeit\Komposi-HCR.txt:" Print #iVB1, "" Print #iVB1, " Spalte" Print #iVB1, " ----------------------------------------------------------" Print #iVB1, " 1 2 3 4 5 6 7" Print #iVB1, " | | | | | | |" Print #iVB1, " | | | | | | Beschreibung" Print #iVB1, " | | | | | | (kann entfallen)" Print #iVB1, " | | | | | Samplelautstärke 2" Print #iVB1, " | | | | Samplelautstärke 1" Print #iVB1, " | | | Playrate" Print #iVB1, " | | Samplezeitpunkt in der Original-WAV-Datei" Print #iVB1, " | Sampledauer" Print #iVB1, " Samplename" Print #iVB1, " ----------------------------------------------------------" Print #iVB1, "" ' Print #iVB1, ; Tab(8); Date & " " & Time Print #iVB1, "" Print #iVB1, ; Tab(tabu(1)); "1"; Tab(tabu(2) + 1); "2"; Tab(tabu(3) + 1); "3"; Tab(tabu(4)); "4"; Tab(tabu(5)); "5"; Tab(tabu(6)); "6"; Tab(tabu(7)); "7" ' TEST - GEÄNDERT am 01.05.2014 Print #iVB1, ; Tab(tabu(1)); "NAME"; Tab(tabu(2) + 1); "DT"; Tab(tabu(3) + 1); "ZTP"; Tab(tabu(4)); "HT"; Tab(tabu(5)); "LT1"; Tab(tabu(6)); "LT2"; Tab(tabu(7)); "INF" ' TEST - GEÄNDERT am 01.05.2014 Do Until EOF(iVB2) Line Input #iVB2, Zeilie ' ... oder gar nicht in ein Feld einlesen? ... ' analysiere zeilie <---- Suchwort = "= Len(Zeilie) ' bis das Suchwort gefunden wird If Wort = Suchwort Then ' If Snd = 3 Then ' entfernt - nur noch der nächste Algorithmus wird verwendet! - 01.05.2014 ' Call Finden("POSITION") ' Startzeitpunkt innerhalb des einen großen Samples ' Call runden(1000, Val(Fund)) ' ZEIPU = yy ' Call Finden("LENGTH") ' Call runden(1000, Val(Fund)) ' LENGU = yy ' Call Finden("NAME") ' ' Anführungszeichen und .wav weg: ' B = "": BB = "" ' For l = 1 To (Len(Fund) - 4) ' B = Mid(Fund, l, 1) ' If B <> """" Then ' BB = BB + B ' End If ' Next l ' NAMU = BB ' j = j + 1 ' Print #iVB1, NAMU & " " & LENGU & " " & ZEIPU ' TEST ' KL(j) = NAMU + " " + Str(LENGU) + " " + Str(ZEIPU) ' rein ins Klangteilchenfeld ' End If If Snd = 3 Or Snd = 4 Then ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call Finden("LENGTH") ' Samplelänge finden Call runden(1000, Val(Fund)) LENGU = yy ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call Finden("NAME") ' Samplenamen finden ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Jetzt schauen, ob in Fund ein Punkt enthalten ist und ' schauen, wieviele Stellen es rechts vom Punkt gibt. ' rvp heißt rechts vom Punkt und ist als Variable statt der '4' einzusetzen. ' Wenn es mehr als 3 Stellen sind: ' Zeichen "-" nach dem Punkt suchen und rauswerfen; ' die Zeichen nach "-" finden und in einer Variablen Inf22 speichern. Dim rvp As Integer ' Anzahl der Stellen rechts vom Punkt Dim iz, jz, kz As Integer ' Zähler Dim Zz As String iz = 0 Zz = "" Do Until Zz = "." Or iz = Len(Fund) iz = iz + 1 Zz = Mid(Fund, iz, 1) Loop jz = 0 Do Until Zz = "-" Or iz = Len(Fund) ' - ist ein verbindliches Zeichen, das unmittelbar hinter dem Samplenamen stehen muss iz = iz + 1 jz = jz + 1 Zz = Mid(Fund, iz, 1) Loop INF22 = "" ' jz = 0 Do Until iz = Len(Fund) ' - ist ein verbindliches Zeichen, das unmittelbar hinter dem Samplenamen stehen muss iz = iz + 1 jz = jz + 1 Zz = Mid(Fund, iz, 1) INF22 = INF22 + Zz Loop rvp = jz + 1 ' Anzahl der Stellen rechts vom Punkt ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Anführungszeichen und .wav oder .mp3 weg: B = "": BB = "" For l = 1 To (Len(Fund) - rvp) B = Mid(Fund, l, 1) If B <> """" Then BB = BB + B End If Next l NAMU = BB ' <------------ ok ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' NEU - Samplelautstärke berücksichtigen ... <-------- 01.05.2014 ' muss auch in Komposi-HCR.txt eingetragen werden! ' Call Finden("VOLPAN") ' Samplelautstärke finden ' Call runden(1000, Val(Fund)) ' LAUTU = yy ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' NEU: Samplelautstärke2 (3. Eintrag hinter VOLPAN in der Reaperdatei)! Call Finden3("VOLPAN") ' Samplelautstärke finden Call runden(1000, Val(Fund2)) LAUTU = yy Call runden(1000, Val(Fund)) LAUTU2 = yy ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call Finden("SOFFS") ' Start im Sample finden Call runden(1000, Val(Fund)) ZEIPU = yy ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' NEU - Playrate berücksichtigen ... <-------- 01.05.2014 ' muss auch in Komposi-HCR.txt eingetragen werden! Call Finden2("PLAYRATE") ' Sample-Tonhöhe (Playrate) finden - steht in Fund! Call runden(1000, Val(Fund)) TONHU = yy ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' j = j + 1 Print #iVB1, j; Tab(tabu(1)); NAMU; Tab(tabu(2)); LENGU; Tab(tabu(3)); ZEIPU; Tab(tabu(4)); TONHU; Tab(tabu(5)); LAUTU; Tab(tabu(6)); LAUTU2; Tab(tabu(7)); INF22 ' TEST - GEÄNDERT am 01.05.2014 - 05.05.2014 ' OK: KL(j) = NAMU + " " + Str(LENGU) + " " + Str(ZEIPU) + " " + Str(TONHU) + " " + Str(LAUTU) + " " + Str(LAUTU2) + " " + INF22 ' rein ins Klangteilchenfeld - GEÄNDERT am 01.05.2014 - 05.05.2014 ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' End If ' TAB End If Loop iHC = j ' Anzahl der Samplezeilen! <------------- ! Close iVB2 Close iVB1 ' Testdatei Exit Sub Keinedateida: MsgBox "C:\Arbeit\Komposi-HCR.rpp ist nicht vorhanden!" End ' Programmende End Sub Private Sub Finden3(s) ' S = "VOLPAN" ' aus Private Sub ExtraktVolkurvenZeitpunkte() von Hukumu Dim Suchwort, Worts, Wort, Teil As String Do Line Input #iVB2, Zeilie Suchwort = s Worts = "" m = 1 Do Worts = Mid(Zeilie, m, Len(Suchwort)) m = m + 1 Loop Until Worts = Suchwort Or m = Len(Zeilie) ' bis das Suchwort gefunden wird If Worts = Suchwort Then Wort = "" m = m + Len(Suchwort) Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) End If Loop Until Worts = Suchwort Fund2 = Wort Wort = "" Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) Wort = "" Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) Fund = Wort ' das Gesuchte steht in Fund! <---------- End Sub Private Sub Finden2(s) ' S = "PLAYRATE" ' aus Private Sub ExtraktVolkurvenZeitpunkte() von Hukumu Dim Suchwort, Worts, Wort, Teil As String Do Line Input #iVB2, Zeilie Suchwort = s Worts = "" m = 1 Do Worts = Mid(Zeilie, m, Len(Suchwort)) m = m + 1 Loop Until Worts = Suchwort Or m = Len(Zeilie) ' bis das Suchwort gefunden wird If Worts = Suchwort Then Wort = "" m = m + Len(Suchwort) Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) End If Loop Until Worts = Suchwort Wort = "" Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) Wort = "" Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) Fund = Wort ' das Gesuchte steht in Fund! <---------- End Sub Private Sub Finden(s) ' z.B. S = "LENGTH" ' aus Private Sub ExtraktVolkurvenZeitpunkte() von Hukumu Dim Suchwort, Worts, Wort, Teil As String Do Line Input #iVB2, Zeilie Suchwort = s Worts = "" m = 1 Do Worts = Mid(Zeilie, m, Len(Suchwort)) m = m + 1 Loop Until Worts = Suchwort Or m = Len(Zeilie) ' bis das Suchwort gefunden wird If Worts = Suchwort Then Wort = "" ' m = m + Len(Suchwort) - 1 m = m + Len(Suchwort) Do Teil = Mid(Zeilie, m, 1) ' Ziffer lesen If Teil <> " " Then Wort = Wort + Teil Else ' VolumeSpalte = m + 1 End If m = m + 1 Loop Until Teil = " " Or m = Len(Zeilie) Else ' MsgBox "'PT ' nicht gefunden", , "FEHLER" ' PTnichtgefunden = True End If Loop Until Worts = Suchwort Fund = Wort ' das Gesuchte steht in Fund! <---------- End Sub Public Sub runden(x, y) ' runden auf so viele Stellen hinter dem Komma, wie x Nullen hat: yy = Int((y * x) + 0.5) / x End Sub Private Sub Zuordnungen() Dim zeile As String ivb = FreeFile Open "C:\Arbeit\Komposi-HC.txt" For Input As ivb Erase KL i = 0 Do While Not EOF(ivb) i = i + 1 Line Input #ivb, zeile KL(i) = zeile ' ins Klangteilchenfeld Loop iHC = i ' Anzahl der Einträge in Komposi-HC.txt merken Close ivb End Sub Private Sub Zuordnungsliste_schreiben() Dim ivb As Integer i = 1 'Zuordnung.Clear Zuordnung.AddItem "" Zuordnung.AddItem "Tonnummern, zugeordnete" Zuordnung.AddItem "Samples und deren Tondauern:" ' Zuordnung.AddItem "(Inhalt von Komposi-HC.txt):" Zuordnung.AddItem "" If KL(1) = "" Then Zuordnung.AddItem "In den ersten Zeilen von" Zuordnung.AddItem "Komposi-HC.txt steht nichts." Zuordnung.AddItem "" Do Until KL(i) <> "" i = i + 1 Loop End If Do Until KL(i) = "" Zuordnung.AddItem i & " = " & KL(i) i = i + 1 Loop Zuordnung.AddItem "" End Sub Private Sub Reaperdateischreiben_3() Dim Vzo1, Vzo2, Vzo3, Vzo4 As Double Dim Zurdatei4, zeile As String Dim Z As Integer Dim P, n As Integer Dim TDauer As Double Dim Vzoo(100) As Double Dim zeileM As String ' Call Schlusselwort_finden("LAUT") ' lauti = Val(m) ' lauti ist der Lautstärkefaktor If lauti = 0 Then lauti = 80 ' Lautstärkefaktor default ' Call Schlusselwort_finden("TEMPO") ' tempi = Val(m) ' tempi ist die Tempoeinstellung ' If tempi = 0 Then tempi = 1 ' Tempoeinstellung default Zurdatei4 = Rt ' (C:\Arbeit\Komposi.rpp) iVB1 = FreeFile Open Zurdatei4 For Output As iVB1 ' schreibe Komposi-RPP-01 (den Vorspann) -------------------------- ' datum = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 2) & Left(Time, 2) & Mid(Time, 4, 2) & Right(Time, 2) datum = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 2) & "-" & Left(Time, 2) & Mid(Time, 4, 2) & "-" & Right(Time, 2) ' neu am 24.05.2014 iVB2 = FreeFile Open "C:\Arbeit\Komposi-RPP-01" For Input As iVB2 Do While Not EOF(iVB2) Line Input #iVB2, zeile ' eine einzelne Zeile ersetzen: If zeile = " RENDER_FILE ""C:\Arbeit\Test-001.wav""" Then zeile = " RENDER_FILE C:\Arbeit\Komposi-" & datum & ".wav" zeileM = "C:\Arbeit\Komposi-" & datum & ".wav" End If Print #iVB1, zeile Loop Clipboard.Clear ' sollte davor stehen Clipboard.SetText zeileM ' ins Clipboard Close iVB2 ' Reaperstart.BackColor = &H288F24 ' = &H84FF84 ' grün ' &HFFFF00 ' mint ' Reaperstart.BackColor = &HC0FFFF ' gelblich ' &H288F24 Reaperstart.BackColor = &H78FEAA '&H51FFC5 ' &H288F24 ' grün ' ----------------------------------------------------------------- Call TrackItem ' <--------------- Items (sind bei mir Samples) schreiben ' ----------------------------------------------------------------- ' Track abschließen: iVB2 = FreeFile Open "C:\Arbeit\Komposi-RPP-02" For Input As iVB2 Print #iVB1, ">" Close iVB2 ' ----------------------------------------------------------------- ' Daten.Clear ' außer Betrieb am 15.05.2014 Daten.AddItem "Anzahl der Schleifendurchläufe" Daten.AddItem "im Tonfindungsgenerator: " & Schleifenzahl Daten.AddItem "" Daten.AddItem "Jetzt Reaper schließen und" Daten.AddItem "dann Knopf 'Reaper' drücken." Daten.AddItem "" ' Ergebnis in der Datenliste zeigen: For ii = 1 To zz2 If KTP = 0 Then Daten.AddItem ii & " " & HT(ii) & " " & KL(HT(ii)) & " " & LT(ii) & " " & DT(ii) End If If KTP = 1 Then ' nur das Sample in der ersten Zeile wird verwendet Daten.AddItem ii & " " & HT(ii) & " " & KL(1) & " " & LT(ii) & " " & DT(ii) End If If KTP = 2 Or KTP = 3 Then ' Sample: Zufallszeile Daten.AddItem ii & " " & HT(ii) & " " & KL(HCZl(ii)) & " " & LT(ii) & " " & DT(ii) End If If KTP > 3 Then ' zur Sichereheit Daten.AddItem ii & " " & HT(ii) & " " & KL(1) & " " & LT(ii) & " " & DT(ii) End If ' Daten.AddItem ii & " " & HT(ii) & " " & KL(HT(ii)) Next ii Close iVB1 erm: End Sub Private Sub TrackItem() ' schreibt Track-Informationen in die Reaperdatei Komposi.rpp '==================================================================================== Dim zeile As String Dim TDauer As Double Dim Z, l As Integer Dim Lta As Single Dim Vzo, Vzo1, Vzo2, Vzo3, Vzo4, Vzo5, Vzo6, Vzo7 As Double Dim Lts As Single Dim Dkrw As Double ' Dauernkorrekturwert Dim Fadein, Fadeout As String Dim pp As Integer Dim ZZZ As String Dim Zle, Adi As String Dim LANG As Double ' Samplelänge Dim PLATE As Double ' Playrate Dim VOLE As Double ' Samplelautstärke Dim VOLE2 As Double ' Samplelautstärke2 Dim INFZ As String ' Sample-Info Dim Sams As Double ' Samplestartpoint Dim SF As String Dim q As Integer Dim HTH As Integer ' Vorkommenshäufigkeitszähler Dim Tz As Integer ' Tönezähler Dim SHy As Integer Dim tonnr As Integer Dim korri As Double ' Korrekturfaktor Dim TRedu As Integer ' Reduzierungsfaktor für Samples bei Tfm = 1 oder Tfm = 2 Dim TKey As Integer ' Tiefster Ton in Komposi.txt Dim iaz As Integer ' ----------------------------------------------------------------------- ' In TrackItem ist i die Samplenummer <--------------------------------- ! ' ----------------------------------------------------------------------- Reaperstart.BackColor = &HE0E0E0 ' grau korri = 4800 ' 4800 ist wohl richtig! TRedu = 200 ' 200 ... 'TRedu = 1 If Stn = 3 Then Daten.AddItem "" Daten.AddItem "Zufalls-Sampletranspositionen" Daten.AddItem "werden berechnet:" Daten.AddItem "" End If ' NEU am 11.01.2014: ' ALLE Sampledauern ermitteln ' Es gibt neuerdings ein Feld DS() für die Sampledauern ' Soundfilename filtern: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Wofür brauchen wir diesen Abschnitt? - Antwort: für Originalsampleabstand 1, ' und zwar um die Soundfiledauer zu ermitteln! For i = 1 To Tonzahl ' Tonzahl: die tatsächlich herzustellende Anzahl der Töne Zle = KL(HT(i)) ' Feldinhalt pp = 0: Adi = "": ZZZ = "" Do While ZZZ <> " " And pp < 100 pp = pp + 1 ZZZ = Mid(Zle, pp, 1) Adi = Adi + ZZZ Loop SF = Left(Adi, pp - 1) SFf = SF ' <-------------------- jaja, sowas ... ' NEU am 16.04.2014: Call Schlusselwort4_finden(Zle) DS(i) = Val(m) * korri ' die Soundfiledauer wurde ermittelt Next i ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 01.04.2014 ' --------------------------------------------------- ' Ermittlung des tiefsten Tons in Komposi.txt: TKey TKey = 127 For i = 1 To Tonzahl If HT(i) < TKey Then TKey = HT(i) Next i ' --------------------------------------------------- Dkrw = 1 'Fadein = "1 0.00050000 0.000000" ' EINSTELLEN! 'Fadeout = "1 0.00050000 0.000000" ' EINSTELLEN! Fade-in und -out für die Samples Fadein = "1 " & Sfi * 0.001 & " 0.000000" ' Fade-in und -out für die Samples Fadeout = "1 " & Sfo * 0.001 & " 0.000000" ' If TFm = 1 Then Vsl = tempi ' NEU am 01.03.2014 - weiter hinten in TrackItem nochmals - And Ogs = 1 ist neu am 02.05.2014 If TFm = 1 And Oga = 0 Then Vsl = tempi / TRedu If TFm = 0.1 Then Vsl = tempi ' NEU am 30.04.2014 If TFm = 0.2 Then Vsl = tempi ' NEU am 05.05.2014 ' If TFm = 2 Then Vsl = tempi / TRedu ' NEU am 01.03.2014 - weiter hinten in TrackItem nochmals - weg am 15.05.2014 If TFm = 2 Then Vsl = tempi ' 15.05.2014 If Oga = 0 Then Vsl = tempi / 1000 ' neu am 16.05.2014 If TFm > 2 Then Vsl = tempi ' Tempofaktor, aus INI-Datei gelesen If Trz = 1 Then Atp = 0 l = Trz ' <------------------------ Anzahl der Tracks zz2 = 0 ' Tönezähler Tz = 1 '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ For n = 1 To l ' offenen TRACK n schreiben - mit PAN-Verteilung der Tracks '-------------------------------------------------- iVB2 = FreeFile Open "C:\Arbeit\Komposi-RPP-02" For Input As iVB2 Do While Not EOF(iVB2) Line Input #iVB2, zeile If Atp = 1 Then ' verteiltes PAN eintragen ' eine einzlne Zeile austauschen: If zeile = " VOLPAN 1.00000000000000 0.00000000000000 -1.00000000000000" Then If n = 1 Then zeile = " VOLPAN 1.00000000000000 -0.13800000000000 -1.00000000000000" If n = 2 Then zeile = " VOLPAN 1.00000000000000 0.13600000000000 -1.00000000000000" If n = 3 Then zeile = " VOLPAN 1.00000000000000 -0.37400000000000 -1.00000000000000" If n = 4 Then zeile = " VOLPAN 1.00000000000000 0.41000000000000 -1.00000000000000" If n = 5 Then zeile = " VOLPAN 1.00000000000000 -0.72600000000000 -1.00000000000000" If n = 6 Then zeile = " VOLPAN 1.00000000000000 0.72400000000000 -1.00000000000000" If n = 7 Then zeile = " VOLPAN 1.00000000000000 -0.88400000000000 -1.00000000000000" If n = 8 Then zeile = " VOLPAN 1.00000000000000 0.88200000000000 -1.00000000000000" End If End If Print #iVB1, zeile Loop Close iVB2 '-------------------------------------------------- 'Samples (ITEMS) für TRACK n schreiben Z = 0 ' MsgBox zz2 i = n ' <-------------------------------- i = n --- i = n --- i = n --- i = n ' Berechnung der ersten Tonzeitpunkts in einem Track ' n gibt die Tracknummer an Dim DT1, DT2, DT3, DT4, DT5, DT6, DT7, DT8 As Long If Oga = 0 Then ' <---------------------------------- ausgeschaltet: Originalsampleabstand DT1 = DT(1): DT2 = DT(2): DT3 = DT(3): DT4 = DT(4): DT5 = DT(5): DT6 = DT(6): DT7 = DT(7): DT8 = DT(8) End If If Oga = 1 Then ' <---------------------------------- eingeschaltet: Originalsampleabstand DT1 = DS(1): DT2 = DS(2): DT3 = DS(3): DT4 = DS(4): DT5 = DS(5): DT6 = DS(6): DT7 = DS(7): DT8 = DS(8) End If ' n gibt die Tracknummer an: If n = 1 Then TDauer = 0 End If If n = 2 Then TDauer = ((DT1) / korri / Vsl) + Zwi End If If n = 3 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) End If If n = 4 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) + (((DT3) / korri / Vsl) + Zwi) End If If n = 5 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) + (((DT3) / korri / Vsl) + Zwi) + (((DT4) / korri / Vsl) + Zwi) End If If n = 6 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) + (((DT3) / korri / Vsl) + Zwi) + (((DT4) / korri / Vsl) + Zwi) + (((DT5) / korri / Vsl) + Zwi) End If If n = 7 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) + (((DT3) / korri / Vsl) + Zwi) + (((DT4) / korri / Vsl) + Zwi) + (((DT5) / korri / Vsl) + Zwi) + (((DT6) / korri / Vsl) + Zwi) End If If n = 8 Then TDauer = (((DT1) / korri / Vsl) + Zwi) + (((DT2) / korri / Vsl) + Zwi) + (((DT3) / korri / Vsl) + Zwi) + (((DT4) / korri / Vsl) + Zwi) + (((DT5) / korri / Vsl) + Zwi) + (((DT6) / korri / Vsl) + Zwi) + (((DT7) / korri / Vsl) + Zwi) End If '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Do While HT(i) > 0 Z = Z + 1: zz2 = zz2 + 1 ' <------------- zz2: Tönezähler! Lta = lauti / 100 ' Lautstärkefaktor - neu: aus INI-Datei gelesen If Lta < 0.01 Then Lta = 0.01 ' Lautstärkefaktor - Begrenzung If Lta > 1 Then Lta = 1 ' Lautstärkefaktor - Begrenzung If TFm = 1 Then Vsl = tempi ' NEU am 01.03.2014 - And Ogs = 1 ist neu am 02.05.20144 If TFm = 1 And Oga = 0 Then Vsl = tempi / TRedu If TFm = 0.1 Then Vsl = tempi ' NEU am 30.04.2014 If TFm = 0.2 Then Vsl = tempi ' NEU am 05.05.2014 ' If TFm = 2 Then Vsl = tempi / TRedu ' NEU am 01.03.2014 - weg am 15.05.2014 If TFm > 2 Then Vsl = tempi ' Tempofaktor, aus INI-Datei gelesen If Oga = 1 Then DT(i) = DS(i) End If If Oga = 0 Then Vzo = (DT(i)) / korri / Vsl ' korri ist der Dauernfaktor Vzo1 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi) / korri / Vsl Vzo2 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi) / korri / Vsl Vzo3 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi + (DT(i + 3)) + Zwi) / korri / Vsl Vzo4 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi + (DT(i + 3)) + Zwi + (DT(i + 4)) + Zwi) / korri / Vsl Vzo5 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi + (DT(i + 3)) + Zwi + (DT(i + 4)) + Zwi + (DT(i + 5)) + Zwi) / korri / Vsl Vzo6 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi + (DT(i + 3)) + Zwi + (DT(i + 4)) + Zwi + (DT(i + 5)) + Zwi + (DT(i + 6)) + Zwi) / korri / Vsl Vzo7 = ((DT(i)) + Zwi + (DT(i + 1)) + Zwi + (DT(i + 2)) + Zwi + (DT(i + 3)) + Zwi + (DT(i + 4)) + Zwi + (DT(i + 5)) + Zwi + (DT(i + 6)) + Zwi + (DT(i + 7)) + Zwi) / korri / Vsl End If Lts = LT(i) / 127 ' Sample-Lautstärke If Oga = 1 Then Vzo = (DS(i)) / korri / Vsl ' korri ist der Dauernfaktor Vzo1 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi) / korri / Vsl Vzo2 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi) / korri / Vsl Vzo3 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi + (DS(i + 3)) + Zwi) / korri / Vsl Vzo4 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi + (DS(i + 3)) + Zwi + (DS(i + 4)) + Zwi) / korri / Vsl Vzo5 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi + (DS(i + 3)) + Zwi + (DS(i + 4)) + Zwi + (DS(i + 5)) + Zwi) / korri / Vsl Vzo6 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi + (DS(i + 3)) + Zwi + (DS(i + 4)) + Zwi + (DS(i + 5)) + Zwi + (DS(i + 6)) + Zwi) / korri / Vsl Vzo7 = ((DS(i)) + Zwi + (DS(i + 1)) + Zwi + (DS(i + 2)) + Zwi + (DS(i + 3)) + Zwi + (DS(i + 4)) + Zwi + (DS(i + 5)) + Zwi + (DS(i + 6)) + Zwi + (DS(i + 7)) + Zwi) / korri / Vsl End If Lts = LT(i) / 127 ' Sample-Lautstärke 1/127 ... 1 ' ---------------------------------- ' Neu am 01.04.2014 ' Keytranspose - bei KTP = 1 wird nur die erste Zeile in Komposi-HC.txt verwendet! If KTP = 0 Then Zle = KL(HT(i)) ' Feldinhalt End If If KTP = 1 Then Zle = KL(1) ' erste Zeile! End If If KTP = 2 Then ' NEU am 18.04.2014 Call Zufzahl(1, iHC) ' Zahl zwischen erster und letzter Zeile in Komposi-HC.txt finden ' iHC enthält die Zeilennummer der höchsten Eintragung! ' Zuz enthält jetzt diese Zahl HCZl(i) = Zuz Zle = KL(Zuz) ' Zle enthält jetzt den Inhalt der zufällig ausgewählten Zeile End If ' TEST: If KTP = 3 Then ' NEU am 21.04.2014? iaz = iaz + 1 If iaz > iHC Then iaz = 1 Zle = KL(iaz) ' Zeilen in der Reihenfolge der Samplezeilen End If If KTP > 3 Then ' zur Sicherheit Zle = KL(1) ' erste Zeile! End If ' ---------------------------------- ' ---------------------------------- ' NEU am 01.04.2014 - Berechnung der Tonhöhe Kyt: If KTP = 1 Or KTP = 2 Or KTP = 3 Then Kyt = (HT(i) - TKey) * 1 ' statt der 1 kann auch ein Faktor stehen ' Kyt = HT(i) ' TKey probeweise rausgeworfen ... am 20.04.2014 ' dann wird es aber insgesamt viel zu hoch! Else Kyt = 0 End If ' ---------------------------------- Dim Mldg, Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton1 ' Schaltfläche definieren. Titel = "FEHLER" If Snd = 2 Then Mldg = "Das Programm möchte ein Sample von der Zeile " & HT(i) & " in der Datei" & vbCrLf & vbCrLf & "Komposi-HC.txt wiedergeben. Dort ist aber kein Sample eingetragen! " & vbCrLf & vbCrLf & "Nur die erste Zeile in Komposi-HC.txt verwenden? (Nein = Programmabbruch!)" End If If Snd = 3 Or Snd = 4 Then Mldg = "Das Programm möchte ein Sample Nummer " & HT(i) & " aus der Datei Komposi-HCR.rpp " & vbCrLf & vbCrLf & "wiedergeben. Diese Datei enthält aber nur eine geringere Zahl von Samples! " & vbCrLf & vbCrLf & "Nur das erste Sample aus Komposi-HCR.rpp verwenden? (Nein = Programmabbruch!)" End If If Zle = "" And NurZeileEins = False Then Antwort = MsgBox(Mldg, Stil, Titel) If Antwort <> vbYes Then End ' Programmende ' Call Form_Load ' <---------- so geht das nicht !! Else Mldg = "Nur Zeile 1 in Komposi-HC.txt verwenden?" If Antwort <> vbYes Then End ' Programmende Else NurZeileEins = True End If End If End If If NurZeileEins = True Then ' neu am 14.04.2014 Zle = KL(1) ' erste Zeile! End If ' Soundfilename filtern: pp = 0: Adi = "": ZZZ = "" Do While ZZZ <> " " And pp < 100 pp = pp + 1 ZZZ = Mid(Zle, pp, 1) Adi = Adi + ZZZ Loop SF = Left(Adi, pp - 1) SFf = SF Soundfile = SF + ".wav" Sample = Soundfile Call Schlusselwort4_finden(Zle) LANG = Val(m) ' <--------------------------------- Länge des Soundfiles SSP = Val(m2) ' <--------------------------------- Samplestartpunkt PLATE = Val(m3) ' <--------------------------------- Playrate VOLE = Val(m4) ' <--------------------------------- Samplelautstärke VOLE2 = Val(m41) ' <--------------------------------- Samplelautstärke 2 INFZ = m5 ' <--------------------------------- Sample-Info If Stn = 0 Then Ply = 0 ' keine Tonhöhenveränderung End If If Stn = 1 Then Ply = (SH(i) - 1) * THf ' so! End If If Stn = 2 Or Stn = 4 Then ' Stn = 4 ist NEU am 25.05.2014 Ply = (SH(i) - 1) * THf ' Tonhöhe entsprechend der Erscheinungsnummer (wurde in Sub Statistik berechnet) End If ' Zufallstonhöhe berechnen (11.05.2014 - 14.05.2014) bei Stn = 3 <------- ! If Stn = 3 Then Dim Zuzv, Zuzw As Double Dim jzz As Integer ' Überlaufzähler jzz = 0 Do ' Es sollen keine unmittelbaren Tonhöhenwiederholungen vorkommen: Do Until ((Zuz <> Zuzv) And (Zuz <> Zuzw)) Or jzz = 1000 Call Zufzahl(-SH(i), SH(i)) ' tiefer - 0 - höher ... bei höherem Tonvorkommen Call Verzoegerung(Vzg * 0.001) ' gibt es eine größere Melodieauslenkung! jzz = jzz + 1 Loop Zuzw = Zuzv Zuzv = Zuz Ply = Zuz * THf ' Tonhöhe mit Zufallsmelodie ' Unter- und Obergrenze nicht überschreiten: Loop While Ply < SAU Or Ply > SAO Daten.AddItem "Ton " & i & ": Transposition " & Ply ' i? End If ' NEU am 31.03.2014: If Stp = 0 Then SSS = 0 ' keine Samplestartpunktverschiebung End If If Stp = 1 Then SSS = (SH(i) - 1) * Stf End If If Stp = 2 Then SSS = (SH(i) - 1) * Stf ' Verschiebung entsprechend der Erscheinungsnummer End If '==================================================================================================================================== ' Reaperdatei schreiben mit Daten wie Klangname, Tonhöhe, Lautstärke usw. Print #iVB1, " "" Then Print #iVB1, " NAME "; INFZ ' Samplename Else Print #iVB1, " NAME "; Sample ' Samplename End If End If Print #iVB1, " VOLPAN "; Lts * VOLE; " 0.000000 "; VOLE2; " -1.000000" ' LT - VOLE uns VOLE2 neu am 01.05.2014 Print #iVB1, " SOFFS "; SSP + SSS + SOT ' Samplestartpunkt - SSS neu am 31.03.2014, SOT neu am 25.05.2014 If Stn = 0 Or Stn = 1 Or Stn = 2 Or Stn = 3 Then Print #iVB1, " PLAYRATE 1.00000000000000 1 "; HTo + Ply + Kyt + PLATE; " -65536" ' HT - neu am 01.05.2014 End If If Stn = 4 Then ' neu am 25.05.2014 Print #iVB1, " PLAYRATE 1.00000000000000 1 "; HTo - Ply + Kyt + PLATE; " -65536" ' HT - neu am 01.05.2014 End If Print #iVB1, " CHANMODE 0" Print #iVB1, " GUID {9628E193-CA29-4783-A547-73A6C9A1E198}" Print #iVB1, " " Print #iVB1, " >" '==================================================================================================================================== ' Hier wird der Tonabstand berechnet (die Variable 'TDauer'). ' l gibt an, wieviele Tracks geschrieben werden. If l = 1 Then TDauer = (TDauer + Vzo) * Dkrw + Zwi + Zwi End If If l = 2 Then TDauer = (TDauer + Vzo1) * Dkrw + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 3 Then TDauer = (TDauer + Vzo2) * Dkrw + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 4 Then TDauer = (TDauer + Vzo3) * Dkrw + Zwi + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 5 Then TDauer = (TDauer + Vzo4) * Dkrw + Zwi + Zwi + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 6 Then TDauer = (TDauer + Vzo5) * Dkrw + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 7 Then TDauer = (TDauer + Vzo6) * Dkrw + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If If l = 8 Then TDauer = (TDauer + Vzo7) * Dkrw + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi + Zwi ' Zwi = Zwischenraum End If i = i + l ' <-------------------- i = i + l ---- i = i + l ---- i = i + l ---- i = i + l Tz = Tz + 1 'Tönezähler ' If Oga = 1 Then ' eingeschaltet: Originalsampleabstand ' ' n gibt die Tracknummer an: ' ' ' End If Loop '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Print #iVB1, " >" ' Track schließen - damit ist der (erste) Track beendet Next n '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// '' TEST - es funktioniert jetzt prima! 05.01.2014 ' Zuordnung.AddItem "" ' For q = 1 To 127 ' Zuordnung.AddItem HCm(q) ' Next q If Stn = 3 Then Daten.AddItem "" End If Reaperstart.BackColor = &H78FEAA ' grün End Sub Private Sub Zufzahl(Ug, Og) Dim a As Integer ' Abstand a = (Og + 1) - Ug Randomize Zuz = Int(Rnd * a) + Ug End Sub Private Sub Inidateischau_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & inidatei End Sub Private Sub Infos_Click() ' Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt" ' Der komplette Irvan-View-Ordner muss in C:\Arbeit sein! ' Das Bild Fm-Test-10-2.bmp muss im Irvan-View-Ordner sein! ' Das Bild Komposi-00.jpg muss Ordner C:\Arbeit\VB\Komposi\Bilder\ sein! Call KillApp("Fm-Test-10-2.bmp - IrfanView") ' Titel des zu schließenden Fensters eintragen! ' absolut cool - es funktioniert!!! (17.02.2010) ' Shell "C:\Arbeit\IrfanView\i_view32.exe C:\Arbeit\IrfanView\Fm-Test-10-2.bmp", vbNormalFocus Shell "C:\Arbeit\IrfanView\i_view32.exe C:\Arbeit\VB\Komposi\Bilder\Komposi-00.jpg", vbNormalFocus End Sub Private Function KillApp(Titel As String) Dim myHwnd As Long, MyCaption As String myHwnd = FindWindowEx(0, 0, vbNullString, vbNullString) Do While myHwnd MyCaption = String(255, 0) GetWindowText myHwnd, MyCaption, 255 If InStr(1, LCase(MyCaption), LCase(Titel)) Then SendMessage myHwnd, WM_CLOSE, 0, 0 ' Anwendung_Schließen = True End If myHwnd = FindWindowEx(0, myHwnd, vbNullString, vbNullString) Loop End Function Private Sub inidatvv_Click() Dim T, B, BB As String Dim i, j As Integer inidat.ForeColor = vbBlack '------------------------------------------------------------------------------- ' Das, was in der angeklickten Zeile rechts in Klammern ' im Text steht (ein Variablenname), soll ins Clipboard '------------------------------------------------------------------------------- If ubs = True Then T = inidat.Text ' dann enthält T den Text, auf den geklickt wurde - 07.04.2014 i = 0 If T <> "" Then Do Until B = "(" B = Mid(T, Len(T) - i, 1) i = i + 1 Loop j = i ' Anzahl Stellen + 1 BB = Mid(T, (Len(T) - j + 2), j - 2) ' so steht genau das, was rechts in Klammern ' stand, also der Variablenname, in BB Clipboard.Clear ' sollte davor stehen Clipboard.SetText BB ' das gesuchte Wort (der Variablenname, der in der Klammer stand) ' kommt in den Zwischenspeicher! Shell "C:\Arbeit\Editor-K\NoteTab.exe " & inidatei End If Else '----------------------------------------- If ibreit = False Then Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False Else Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe ibreit = False End If Call Textscroller2(inidatei) '----------------------------------------- End If End Sub Private Sub inidat_Click() Dim T, B, BB As String Dim i, j As Integer inidat.ForeColor = vbBlack '------------------------------------------------------------------------------- ' Das, was in der angeklickten Zeile rechts in Klammern ' im Text steht (ein Variablenname), soll ins Clipboard '------------------------------------------------------------------------------- erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False T = inidat.Text ' dann enthält T den Text, auf den geklickt wurde - 07.04.2014 If ubs = True And T <> "" Then T = inidat.Text ' dann enthält T den Text, auf den geklickt wurde - 07.04.2014 i = 0 ' If T <> "" Then Do Until B = "(" B = Mid(T, Len(T) - i, 1) i = i + 1 Loop j = i ' Anzahl Stellen + 1 BB = Mid(T, (Len(T) - j + 2), j - 2) ' so steht genau das, was rechts in Klammern ' stand, also der Variablenname, in BB Clipboard.Clear ' sollte davor stehen Clipboard.SetText BB ' das gesuchte Wort (der Variablenname, der in der Klammer stand) ' kommt in den Zwischenspeicher! Shell "C:\Arbeit\Editor-K\NoteTab.exe " & inidatei ' End If Else '----------------------------------------- If ibreit = False Then Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False Else Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe ibreit = False End If Call Textscroller2(inidatei) '----------------------------------------- ubs = False End If End Sub Private Sub Dateischau_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & KT End Sub Private Sub Daten_Click() ' Shell "C:\Arbeit\Editor-K\NoteTab.exe " & KT End Sub Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 46 Then Print "Mausekuchen" End Sub Private Sub Form_Unload(Cancel As Integer) midi_out_close End Sub Private Sub Stopp_Click() Stopvalu = True End Sub Sub Kurzubersicht_Click() ubs = True ' Übersicht ein. Beim Klick auf eine Zeile ist ' dann der Modus eingeschaltet, bei dem der (rechts ' in Klammern stehende) Variablenname ins Clipboard kopiert ' wird und dann Kompposi.ini aufgerufen wird. ' Siehe Private Sub inidat_Click() <------- ! erklaminus.Visible = False erklaplus.Visible = False Label5.FontBold = False Label5.ForeColor = vbBlack Label5.Visible = True Label5.Caption = "Um einen Wert zu verändern, hier oben auf die entsprechende Zeile" & vbCrLf & "klicken. Dann im Editor - im Clip MUSIK - auf F I N D E N klicken." ' ------------------------------------- ' Voraussetzung für diese Funktion ist: ' Im Editor 'NoteTab Light' wird Komposi.ini angezeigt. ' Es muss ein Clip 'C:\Arbeit\Editor-K\Libraries\MUSIK.clb' aktiv sein. ' Dieser Clip muss folgendes enthalten: ' ------------------------------------- ' H="F I N D E N (click!)" ' ^!Set %x%=^$GetClipboard$ ' ^!Find (^%x%) W ' ------------------------------------- Call Initial Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False inidat.FontBold = True inidat.FontSize = 12 inidat.Clear inidat.AddItem "" If reingeholt = True Then inidat.ForeColor = vbRed inidat.AddItem " Komposi.ini, Komposi-HCR.rpp," inidat.AddItem " Komposi-01.cap und Komposi-02.cap" inidat.AddItem " wurden verändert." inidat.AddItem " " inidat.AddItem " Bei der Verwendung von Patterns müssen" inidat.AddItem " die Capelladateien Komposi-01.cap und" inidat.AddItem " Komposi-02.cap neu als XML-Dateien ex-" inidat.AddItem " portiert werden (CAP 01 und CAP 02 drücken," inidat.AddItem " um diese Dateien zu öffnen)." inidat.AddItem " Dann müssen in KOMPOSI die Knöpfe XML 01" inidat.AddItem " und XML 02 gedrückt werden." inidat.AddItem " " inidat.AddItem " Komposi.ini zeigt im Editor eventuell" inidat.AddItem " falsche Werte an. Erst schließen, dann" inidat.AddItem " wieder öffnen!" inidat.AddItem " " inidat.AddItem " Am Ende der Datei 'C:\Arbeit-jms\Eigene" inidat.AddItem " Dateien 2\Texte\Bedienungsanleitungen\" inidat.AddItem " Komposi-Proginfo.txt' werden automatisch" inidat.AddItem " die zuletzt geladenen Presets eingetragen." inidat.AddItem " " inidat.AddItem " In die linke (blau gewordene) Liste klicken," inidat.AddItem " und ganz nach unten scrollen, um sie anzusehen!" ' inidat.AddItem " " MsgBox "weiter?" inidat.Clear inidat.ForeColor = vbBlack inidat.AddItem "" End If If reingeholt2 = True Then inidat.ForeColor = &H339942 inidat.AddItem " SAMPLEMIX" inidat.AddItem "" inidat.AddItem " Mit Samplemix kann man verschiedene Sample-" inidat.AddItem " Sammlungen, die bereits in Reaperdateien" inidat.AddItem " aufgenommen wurden (z.B. in" inidat.AddItem " Komposi-HCR-01.rpp, Komposi-HCR-02.rpp," inidat.AddItem " usw.) mischen und in eine Zufallsreihenfolge" inidat.AddItem " bringen." inidat.AddItem " " inidat.AddItem " Erläuterung der Arbeitsschritte:" inidat.AddItem " In Reaper die WAV-Dateien aus aus den ver-" inidat.AddItem " schiedenen Reaperdateien hintereinander-" inidat.AddItem " setzen als 'Komposi-HCR.rpp' speichern." inidat.AddItem " In KOMPOSI den Knopf 'Samples' drücken und" inidat.AddItem " nachsehen, ob die richtigen Samples in" inidat.AddItem " Komposi-HCR.rpp geladen sind." inidat.AddItem " In Komposi.ini müssen eventuell noch" inidat.AddItem " Tiefton und Hochton angepasst werden." inidat.AddItem " Jetzt in KOMPOSI 'P' drücken (es sind 1000" inidat.AddItem " Töne voreingestellt). Die entstehende Reaper-" inidat.AddItem " datei Komposi.rpp als HHHHH.rpp oder mit" inidat.AddItem " beliebigem neuem Namen (z.B." inidat.AddItem " Komposi-HCR-33.rpp) abspeichern." inidat.AddItem " Diese Reaperdatei kann dann jederzeit als" inidat.AddItem " Komposi-HCR.rpp kopiert und dann mit KOMPOSI" inidat.AddItem " verwendet werden." MsgBox "weiter? (erst genau lesen!)" inidat.Clear inidat.ForeColor = vbBlack inidat.AddItem "" End If If Snd = 1 Then inidat.AddItem " MIDI mit Wavetable (Snd)" End If If Snd = 2 Then inidat.AddItem " SAMPLER mit Komposi-HC.txt (Snd)" End If If Snd = 3 Then inidat.AddItem " SAMPLER mit Komposi-HCR.rpp (Snd)" End If If Snd = 4 Then inidat.AddItem " SAMPLER mit Komposi-HCR.rpp (Snd)" End If If Snd = 2 Or Snd = 3 Or Snd = 4 Then If Snn = 0 Then inidat.AddItem " WAV-Datei als Samplenamen (Snn)" End If If Snn = 1 Then inidat.AddItem " Ton-Nummern als Samplenamen (Snn)" End If If Snn = 2 Then inidat.AddItem " Sample-Infos als Samplenamen (Snn)" End If If Trz = 1 Then inidat.AddItem " " & Trz & " Reaper-Spur (Trz)" Else inidat.AddItem " " & Trz & " Reaper-Spuren (Trz)" End If If Trz = 1 Then inidat.AddItem " Deshalb kein Autopan" Else If Atp = 0 Then inidat.AddItem " Autopan aus (Atp)" End If If Atp = 1 Then inidat.AddItem " Autopan ein (Atp)" End If End If inidat.AddItem " Fade in " & Sfi & " (Sfi)" inidat.AddItem " Fade out " & Sfo & " (Sfo)" ' inidat.AddItem " Panoramabreite " & Pbr & " (Pbr)" End If If Snd = 2 Or Snd = 3 Or Snd = 4 Then If TFm = 2 Then inidat.AddItem " Obergrenze Anzahl Sampleloops: " & SPL & " (SPL)" End If If TFm = 2 Then If Stn <> 0 Then inidat.AddItem " Tiefstmögliche Sampletransposition: " & SAU & " (SAU)" inidat.AddItem " Höchstmögliche Sampletransposition: " & SAO & " (SAO)" inidat.AddItem " Transpositionsfaktor " & THf & " (THf)" End If End If If Oga = 0 Then inidat.AddItem " Sampleabstand wie in Komposi.txt (Oga)" End If If Oga = 1 Then inidat.AddItem " Sampleabstand = Sampledauer bei Tempo 1 (Oga)" End If If Ogs = 0 Then inidat.AddItem " Sampledauer wie in Komposi.txt (Ogs)" End If If Zwi = 0 Then inidat.AddItem " Keine Pausen zwischen den Samples (Zwv)" Else inidat.AddItem " Pausen zwischen den Samples: " & Zwv & " (Zwv)" End If If Ubl = 0 Then inidat.AddItem " Keine Sample-Überlappung (Ubl)" Else inidat.AddItem " Sample-Überlappung: " & Ubl & " (Ubl)" End If If Ogs = 1 Then inidat.AddItem " Original-Sampledauer (Ogs)" End If If KTP = 0 Then inidat.AddItem " Kein Keytranspose (KTP)" End If If KTP = 1 Then inidat.AddItem " Keytranspose: Sample auf Zeile 1 (KTP)" End If If KTP = 2 Then inidat.AddItem " Keytranspose m. zufallsgewählten Samples (KTP)" End If If KTP = 3 Then inidat.AddItem " Keytranspose, Samples in Zeilenfolge (KTP)" End If If Stn = 0 Then inidat.AddItem " Kein Sampletuning (Stn)" End If If Stn = 1 Then inidat.AddItem " Sampletuning nach Vorkommenshäufigkeit (Stn)" End If If Stn = 2 Then inidat.AddItem " Sampletuning immer höher (Stn)" End If If Stn = 3 Then inidat.AddItem " Sampletuning mit Melodien (Stn)" End If If Stn = 4 Then inidat.AddItem " Sampletuning immer tiefer (Stn)" End If If Stn > 0 Then If TFm <> 2 Then ' denn bei Tfm = 2 wird THf schon weiter oben angezeigt inidat.AddItem " Transpositionsfaktor " & THf & " (THf)" End If End If If HTo = 0 Then inidat.AddItem " Keine Gesamt-Sampletransposition (HTo)" End If If Abs(HTo) > 0 Then inidat.AddItem " Transposition für alle Samples: " & HTo & " (HTo)" End If If Stp = 0 Then inidat.AddItem " Keine Samplestartpunktvariationen (Stp)" End If If Stp = 1 Then inidat.AddItem " Samplestartpunkt nach Vorkommenshäufigkeit (Stp)" inidat.AddItem " Sampleverschiebungsfaktor " & Stf & " (Stf)" End If If Stp = 2 Then inidat.AddItem " Samplestartpunkt bei Samplewiederholung (Stp)" inidat.AddItem " Sampleverschiebungsfaktor " & Stf & " (Stf)" End If If SOT = 0 Then inidat.AddItem " Keine Gesamt-Samplezeitverschiebung (SOT)" End If If Abs(SOT) > 0 Then inidat.AddItem " Zeitverschiebung für alle Samples: " & SOT & " (SOT)" End If inidat.AddItem "" End If If TFm >= 1 Then ' wegen der Optik (30.04.2014) inidat.AddItem " REGEL 0" & TFm & " (TFm)" Else inidat.AddItem " REGEL " & TFm & " (TESTMODUS) (TFm)" End If If TFm = 6 Then If VR1 = False Then inidat.AddItem " Pattern 01 vorwärts (VR1)" End If If VR1 = True Then inidat.AddItem " Pattern 01 vorwärts und rückwärts (VR1)" End If If VR2 = False Then inidat.AddItem " Pattern 02 vorwärts (VR2)" End If If VR2 = True Then inidat.AddItem " Pattern 02 vorwärts und rückwärts (VR2)" End If End If inidat.AddItem " Tempo " & tempi & " (tempi)" If Abs(Trs) > 0 Then inidat.AddItem " Allgemeine Tontransposition " & Trs & " (Trs)" Else inidat.AddItem " Keine allgemeine Tontransposition (Trs)" End If If TFm = 3 Or TFm = 4 Or TFm = 5 Or TFm = 6 Then If LOP > 1 Then inidat.AddItem " " & LOP & " Patterndurchläufe (LOP)" Else inidat.AddItem " " & LOP & " Patterndurchlauf (LOP)" End If End If If TFm = 1 Or TFm = 2 Then inidat.AddItem " " & Anz & " Töne (Anz)" End If If TFm = 0.1 Or TFm = 0.2 Then ' neu am 30.04.2014 ' inidat.AddItem " " & Anz & " Töne (Anz)" inidat.AddItem " Alle Töne aus Komposi-HCR.txt (Anz)" End If If Tdd = 0 Then inidat.AddItem " Tondauern indirekt (Tdd)" If TFm = 5 Then inidat.AddItem " Kleinster Wert " & KTn & " (KTn)" inidat.AddItem " Größter Wert " & LTn & " (LTn)" End If End If If Tdd = 1 Then inidat.AddItem " Tondauern direkt (Tdd)" End If If TFm = 1 Or TFm = 2 Then If Tdd = 0 Then inidat.AddItem " Größte indirekte Tondauer " & Tda & " (Tda)" End If If Tdd = 1 Then inidat.AddItem " Größte direkte Tondauer " & Tda & " (Tda)" End If End If If TFm = 1 Or TFm = 2 Then inidat.AddItem " Lautstärkevariation " & Lva & " (Lva)" End If If TFm = 1 Or TFm = 2 Then If Snd = 1 Then inidat.AddItem " Startton " & Sto & " (Sto)" inidat.AddItem " Tiefster Ton " & Ttn & " (Ttn)" inidat.AddItem " Höchster Ton " & Htn & " (Htn)" Else inidat.AddItem " Startton " & Sto & " (Sto)" ' neu am 06.04.2014 inidat.AddItem " Tiefster Ton " & Ttn & " (Ttn)" inidat.AddItem " Höchster Ton " & Htn & " (Htn)" End If End If If TFm = 1 Then ' Or TFm = 2 ist falsch inidat.AddItem " Das Intervall ist eingestellt auf " & Iva & " (Iva)" If Kgl = 1 Then inidat.AddItem " Intervalle gleich oder kleiner " & Iva & " (Kgl)" End If If Kgl = 3 Then inidat.AddItem " Nur Intervall " & Iva & " wird verwendet (Kgl)" End If End If If TFm = 3 Then inidat.AddItem " Pattern-Wiederholungsdistanz " & Whd & " (Whd)" End If If TFm = 3 Then inidat.AddItem " Maximale Abwärtstransposition " & UGr & " (UGr)" inidat.AddItem " Maximale Aufwärtstransposition " & OGr & " (OGr)" ' inidat.AddItem " Kleinstmögliche Transposition " & KTR & " (KTR)" End If inidat.AddItem "" inidat.AddItem " Verzögerungsfaktor " & Vzg & " (Vzg)" '----------------------------------- 'inidat.FontBold = False 'inidat.FontSize = 8 reingeholt = False reingeholt2 = False End Sub Private Sub Ubersicht_Click() ubs = False Label5.Visible = False erklaminus.Visible = True erklaplus.Visible = True Call Initial Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False inidat.FontBold = True inidat.FontSize = 12 inidat.Clear '------------------------------- Select Case TFm Case 0.1 erkla = 0: Call U001 Case 1 erkla = 1: Call U01 Case 2 erkla = 2: Call U02 Case 3 erkla = 3: Call U03 Case 4 erkla = 4: Call U04 Case 5 erkla = 5: Call U05 Case 6 erkla = 6: Call U06 End Select '------------------------------- End Sub Private Sub erklaplus_Click() erkla = erkla + 1 Select Case erkla Case 0 Call U001 Case 1 Call U01 Case 2 Call U02 Case 3 Call U03 Case 1 Call U01 Case 4 Call U04 Case 5 Call U05 Case 6 Call U06 Case 7 erkla = 0 Call U001 End Select End Sub Private Sub erklaminus_Click() erkla = erkla - 1 Select Case erkla Case -1 erkla = 6 Call U06 Case 5 Call U05 Case 4 Call U04 Case 3 Call U03 Case 2 Call U02 Case 1 Call U01 Case 0 Call U001 End Select End Sub Private Sub U001() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung des Testmodus:" inidat.AddItem "" inidat.AddItem " Im Testmodus werden alle in der Datei" inidat.AddItem " Komposi-HCR.txt vorhandenen Samples in" inidat.AddItem " der Originalreihenfolge geschrieben und" inidat.AddItem " wiedergegeben." inidat.AddItem " Alle in dieser Datei angegebenen Features" inidat.AddItem " (Samplename, Dauer, Original-Samplezeitpunkt," inidat.AddItem " Playrate, Samplelautstärke 1 und 2) werden" inidat.AddItem " übernommen." inidat.AddItem "" inidat.AddItem " Das Tempo wird automatisch auf 1 gestellt," inidat.AddItem " die Parameter Tdd (direkte Tondauer) und" inidat.AddItem " Oga (Original-Sampleabstand) werden" inidat.AddItem " ebenfalls auf 1 gestellt und" inidat.AddItem " Snd (SOUND) wird auf 3 gestellt," inidat.AddItem " Stn (Sampletuning auf 0)." inidat.AddItem "" End Sub Private Sub U01() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 01:" inidat.AddItem "" inidat.AddItem " Es wird eine Zufallsmelodie erzeugt," inidat.AddItem " die von der Einstellung der vier Parameter" inidat.AddItem " Startton, Tiefton, Hochton und Intervall" inidat.AddItem " abhängt. Es werden keine Patterns verwendet." inidat.AddItem "" inidat.AddItem " Für alle Regeln gilt:" inidat.AddItem " Bei der Verwendung von Samples kann" inidat.AddItem " eingestellt werden, ob sich je" inidat.AddItem " nach Vorkommenshäufigkeit die Sampletonhöhe" inidat.AddItem " verändern soll (Sampletuning THf = 1)," inidat.AddItem " oder ob sie sich bei jeder" inidat.AddItem " Vorkommenswiederholung erhöhen soll" inidat.AddItem " (THf = 2). Der Grad der Erhöhung (oder" inidat.AddItem " Erniedrigung) wird mit dem" inidat.AddItem " Transpositionsfaktor (THf) eingestellt." End Sub Private Sub U02() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 02:" inidat.AddItem "" inidat.AddItem " Es können Loops erzeugt werden." inidat.AddItem " Töne mit zufälligen Tonhöhen werden erzeugt." inidat.AddItem " Auch Tondauern und Lautstärken werden im" inidat.AddItem " Rahmen der vorgenommenen Einstellungen" inidat.AddItem " zufällig erzeugt, abhängig von den vier" inidat.AddItem " Parametern Startton, Tiefton, Hochton und" inidat.AddItem " Intervall. Es werden keine Patterns" inidat.AddItem " verwendet." inidat.AddItem " " inidat.AddItem " Als Loops sind unmittelbare mehrfache" inidat.AddItem " Tonwiederholungen zu verstehen. Bei" inidat.AddItem " Samples (Snd >= 2), kann eingestellt werden," inidat.AddItem " ob sich die Sampletonhöhe je nach Vorkom-" inidat.AddItem " menshäufigkeit verändern soll (Sampletuning" inidat.AddItem " Stn = 1), oder ob sie sich bei jeder" inidat.AddItem " Wiederholung erhöhen soll (Stn = 2)." inidat.AddItem " NEU: Bei Stn = 3 erfolgt eine zufällige" inidat.AddItem " Tonhöheneinstellung, abhängig von THf und" inidat.AddItem " von der (zufällig erzeugten) Sample-" inidat.AddItem " Wiederholungsrate (je höher diese Rate," inidat.AddItem " desto größer die Tonhöhenvariation in der" inidat.AddItem " Melodie). Es wird sichergestellt, dass" inidat.AddItem " keine unmittelbare (Sample-)Tonhöhenwieder-" inidat.AddItem " holung erfolgt. Erst nach 2 verschiedenen" inidat.AddItem " Tonhöhen darf sich die erste wiederholen." inidat.AddItem " Dies funktioniert aber nur, wenn die" inidat.AddItem " Trackzahl (Trz) auf 1 gestellt ist." inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " End Sub Private Sub U03() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 03:" inidat.AddItem "" inidat.AddItem " Hier wird nur EIN Pattern, das" inidat.AddItem " Pattern 02 verwendet." inidat.AddItem " " inidat.AddItem " Informationen zu den Patterns:" inidat.AddItem " Ein Pattern kann sehr lang, aber auch sehr" inidat.AddItem " kurz sein. Im Extremfall ist es eine ganze" inidat.AddItem " Komposition, oder aber es besteht es nur" inidat.AddItem " aus einer einzigen Note." inidat.AddItem " Ein Pattern darf nur einstimmig sein, sonst" inidat.AddItem " funktioniert das Programm nicht richtig." inidat.AddItem " " inidat.AddItem " HERSTELLUNG EINES PATTERNS (hier als" inidat.AddItem " Beispiel Pattern 02): Zuerst in Komposi" inidat.AddItem " den Knopf CAP 02 drücken (links unten)," inidat.AddItem " dann öffnet sich das Programm Capella" inidat.AddItem " Mit Capella kann eine Tonfolge geschrieben" inidat.AddItem " werden, die dann als MusicXML-Datei mit" inidat.AddItem " Namen Komposi-02.xml exportiert werden" inidat.AddItem " muss. In Komposi auf den Knopf XML-02" inidat.AddItem " gedrückt, und es wird umgewandelt in" inidat.AddItem " Komposi-Cap-02.txt. Das ist Pattern 02." inidat.AddItem " " inidat.AddItem " Das komplette Pattern wird bei jeder" inidat.AddItem " Wiederholung transponiert. Es kann ange-" inidat.AddItem " geben werden, nach wievielen Durchgängen" inidat.AddItem " sich das Transpositionsintervall wieder-" inidat.AddItem " holen darf (Wiederholungsdistanz Whd)," inidat.AddItem " außerdem kann man eine Ober- und eine" inidat.AddItem " Untergrenze für das Tranpositionsintervall" inidat.AddItem " einstellen. (Untergrenze UGr und Obergrenze" inidat.AddItem " OGr). Wenn das Pattern nur EINEN Ton" inidat.AddItem " enthält, können ZWÖLFTONMELODIEN erzeugt" inidat.AddItem " werden! (Aber auch Dreiton, Neunton," inidat.AddItem " Zwanzigtonmelodien, was insbesondere im" inidat.AddItem " Zusammenhang mit Samples interessant" inidat.AddItem " sein kann.)" inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " End Sub Private Sub U04() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 04:" inidat.AddItem "" inidat.AddItem " Es wird nur Pattern 02 verwendet." inidat.AddItem " Infos zur Erzeugung von Patterns" inidat.AddItem " siehe Regel 03." inidat.AddItem "" inidat.AddItem " Dies ist eine noch im Experimentierstadium" inidat.AddItem " befindliche Regel: Wenn zwei gespielte Töne" inidat.AddItem " mit einer kleinen Sekunde aufeinanderfolgen," inidat.AddItem " dann soll ein zusätzlicher Ton mit einem" inidat.AddItem " bestimmten Intervall eingefügt werden. Wenn" inidat.AddItem " zwei gespielte Töne mit einer großen Sekunde" inidat.AddItem " aufeinanderfolgen, dann soll ein zusätzlicher" inidat.AddItem " Ton mit einem anderen Intervall eingefügt" inidat.AddItem " werden. Intervall aufwärts oder abwärts? Zur" inidat.AddItem " Zeit nur aufwärts. Folgendes lässt sich sehr" inidat.AddItem " leicht ändern: Welches Intervall, aufwärts" inidat.AddItem " oder abwärts, auf welches gespielte Intervall" inidat.AddItem " soll reagiert werden, usw. Zum Beispiel" inidat.AddItem " könnte man auf eine Quart aufwärts immer" inidat.AddItem " eine große (oder kleine) Terz folgen lassen." End Sub Private Sub U05() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 05:" inidat.AddItem "" inidat.AddItem " Es werden 2 Patterns verwendet. Infos zur" inidat.AddItem " Erzeugung von Patterns siehe Regel 03." inidat.AddItem "" inidat.AddItem " Die Töne des ersten Patterns bestimmen die" inidat.AddItem " Gesamttonhöhe eines Durchlaufs von Pattern" inidat.AddItem " 02. Der Rhythmus wird für das 2. Pattern" inidat.AddItem " per Zufallsgenerator frei erfunden." End Sub Private Sub U06() inidat.Clear inidat.AddItem "" inidat.AddItem " Erläuterung der Regel 06:" inidat.AddItem "" inidat.AddItem " Es werden 2 Patterns verwendet. Infos zur" inidat.AddItem " Erzeugung von Patterns siehe Regel 03." inidat.AddItem "" inidat.AddItem " Pattern 02 (Komposi-02.cap) wird von" inidat.AddItem " Pattern 01 (Komposi-01.cap) 'gespielt'" inidat.AddItem " Pattern 01 ist also das steuernde Pattern," inidat.AddItem " Pattern 02 ist das gespielte Pattern." inidat.AddItem " Tiefe Töne in Pattern 01 spielen das" inidat.AddItem " Pattern 02 tief ab, hohe hoch. Lange" inidat.AddItem " Töne spielen Pattern 02 langsam, kurze" inidat.AddItem " Töne spielen es schnell. Pausen in" inidat.AddItem " Pattern 01 werden nicht berücksichtigt." inidat.AddItem " Die Anzahl der Töne, die tatsächlich von" inidat.AddItem " Pattern 02 gespielt werden, sowie die" inidat.AddItem " Anzahl der Töne, die im steuernden" inidat.AddItem " Pattern 01 berücksichtigt werden, ist" inidat.AddItem " zufallsgesteuert." inidat.AddItem " Außerdem gibt es einstellbare Abspielmodi:" inidat.AddItem " Bei Vorruck01 (VR1) = 1 wird Pattern 01" inidat.AddItem " zufallsgesteuert vorwärts und rückwärts" inidat.AddItem " gespielt, bei Vorruck01 (VR1) = 0 nur" inidat.AddItem " vorwärts. In gleicher Weise gilt die" inidat.AddItem " Einstellung von Vorruck02 (VR2) für" inidat.AddItem " Pattern 02." inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " inidat.AddItem " " End Sub Private Sub Ubersicht_Notenschreiben_Click() ubs = True ' Übersicht ein. Beim Klick auf eine Zeile ist ' dann der Modus eingeschaltet, bei dem der (rechts ' in Klammern stehende) Variablenname ins Clipboard kopiert ' wird und dann Kompposi.ini aufgerufen wird. ' Siehe Private Sub inidat_Click() <------- ! erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False Label5.FontBold = False Label5.ForeColor = vbBlack Label5.Visible = True ' Label5.Caption = "Um einen Wert zu verändern, hier auf die entsprechende Zeile" & vbCrLf & "klicken. Dann im Editor, im Clip MUSIK, auf F I N D E N klicken." ' ------------------------------------- ' Voraussetzung für diese Funktion ist: ' Im Editor 'NoteTab Light' wird Komposi.ini angezeigt. ' Es muss ein Clip 'C:\Arbeit\Editor-K\Libraries\MUSIK.clb' aktiv sein. ' Dieser Clip muss folgendes enthalten: ' ------------------------------------- ' H="F I N D E N (click!)" ' ^!Set %x%=^$GetClipboard$ ' ^!Find (^%x%) W ' ------------------------------------- Call Initial Daten.Visible = False Zuordnung.Visible = False inidat.Height = 7540 ibreit = True List2.Width = 3525 breit = False Label5.Caption = "" ' hier neu am 18.05.2014 inidat.FontBold = True inidat.FontSize = 12 'inidat.ForeColor = vbRed inidat.Clear inidat.AddItem "" If TKT = 0 Then inidat.AddItem " Keine Taktstriche (TKT)" Else inidat.AddItem " Takt: " & Left(TKT, 1) & "/" & Right(TKT, Len(TKT) - 1) & " (TKT)" End If If VBS = 1 Then inidat.AddItem " Violinschlüssel (VBS)" End If If VBS = 2 Then inidat.AddItem " Bass-Schlüssel (VBS)" End If If TRN = 0 Then inidat.AddItem " Keine Transposition (TRN)" End If If TRN >= 1 Then If TRN = 1 Then inidat.AddItem " Transposition: " & TRN & " Halbton nach oben (TRN)" Else inidat.AddItem " Transposition: " & TRN & " Halbtöne nach oben (TRN)" End If End If If TRN < 0 Then If Abs(TRN) = 1 Then inidat.AddItem " Transposition: " & Abs(TRN) & " Halbton nach unten (TRN)" Else inidat.AddItem " Transposition: " & Abs(TRN) & " Halbtöne nach unten (TRN)" End If End If inidat.AddItem " Der kürzeste Notenwert ist 1/" & KZW & " (KZW)" inidat.AddItem " Es werden " & NPZ & " Noten pro Zeile geschrieben (NPZ)" End Sub Private Sub VScroll1_Change() If mi = False Then GoTo raus Dim y As Single Static last_y_value As Single y = VScroll1.value ' fein Call Bendersub(0, y) ' scaleheight set 0 to 16383 Keyz = (Int(y / 1000 * 100 + 0.5) / 100) - 8.2 ' + 4 Ziffern (= 2 cm) = Halbe Note ' Text3.Text = Int(Keyz * 100 + 0.5) / 100 ' Call rechnen(sb_play.value) Call rechnen(Nmm) ' Neuwert = Val(sb_play.value) Neuwert = Val(Nmm) KeyOk = Val(Key) * (2 ^ (1 / korri)) ^ Keyz KeyOkr = Int((KeyOk * rund) + 0.5) / rund txtNot.Text = Val(KeyOkr) & " Hz" ' Clipboard.Clear ' Clipboard.SetText KeyOkr ' neu am 03.02.2011 raus: End Sub Private Sub neutral_Click() VScroll1.value = 8200 ' Clipboard.Clear ' Clipboard.SetText KeyOkr ' neu am 03.02.2011 End Sub Private Sub Bender_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Static last_y_value As Single 'Remove previous line by overdrawing with inverted draw mode 'scale width set from 0 to 1 Bender.Line (0, last_y_value)-(1, last_y_value) Call Bendersub(0, y) ' scaleheight set to 0 to 16383 'Draw new line Bender.Line (0, y)-(1, y) last_y_value = y Keyz = (Int(y / 1000 * 10 + 0.5) / 10) - 8.2 ' + 4 Ziffern (= 2 cm) = Halbe Note ' Text3.Text = Int(Keyz * 10 + 0.5) / 10 ' Call rechnen(sb_play.value) Call rechnen(Nmm) ' Neuwert = Val(sb_play.value) Neuwert = Val(Nmm) KeyOk = Val(Key) * (2 ^ (1 / korri)) ^ Keyz KeyOkr = Int((KeyOk * rund) + 0.5) / rund 'Text1.Text = Val(KeyOk) ' <--------- TEST txtNot.Text = Val(KeyOkr) & " Hz" End Sub Sub Verzoegerung(Pausenlänge) Dim Start, Ende, Gesamtdauer Start = Timer ' Anfangszeit setzen. Do While Timer < Start + Pausenlänge DoEvents ' Steuerung an andere Prozesse ' abgeben. Loop Ende = Timer ' Ende festlegen. End Sub Private Sub fill_sound_list() Dim s As String ivb = FreeFile Open App.Path & "\genmidi.txt" For Input As #ivb Do While Not EOF(ivb) Line Input #ivb, s lst_sound_list.AddItem s Loop Close #ivb End Sub ' Private Sub leiselaut_Change() ' Laut = leiselaut.value ' txtNot.Text = Laut ' Test ' all_sounds_off ' Command1.BackColor = &HFF ' Knopf rot ' farb = False ' ' Label2.Caption = "Stop" ' Call sb_play_Change ' ' Text2.Text = Laut ' End Sub Private Sub List1_Click() Dim x As Integer midi_out_close x = midi_out_open(List1.ItemData(List1.ListIndex)) Label1.Caption = "" End Sub Private Sub lst_sound_list_Click() Call program_change(0, 0, lst_sound_list.ListIndex) End Sub Private Sub sb_play_Change(Hertz As Integer, Dezabel As Integer) ' stark modifiziert am 05.12.2013 Static prev_note As Integer ' remember variable (static) ' MsgBox Dezabel ' Nmm enthält den Midiwert der Tonhöhe! ' Turn off previous note: Call note_off(0, prev_note) ' turn on this note: Call note_on(0, Hertz, Dezabel) ' Nm: Tonhöhe, Dezabel: velocity ' save note as previous: prev_note = Hertz ' merk dir die Tonhöhe Call rechnen(Hertz) Neuwert = Val(Hertz) KeyOk = Val(Key) * (2 ^ (1 / korri)) ^ Keyz KeyOkr = Int((KeyOk * rund) + 0.5) / rund ' Text4.Text = Neuwert txtNot.Text = Val(KeyOkr) & " Hz" Call Notenname(Neuwert) Text5.Text = Notnam farb = False ' Clipboard.Clear ' Clipboard.SetText KeyOkr ' neu am 03.02.2011 Vornote = prev_note End Sub Private Sub Notenname(y) While y > 0 y = Int(y - 12): n = n + 1 Wend If y < 0 Then y = y + 12 If y = 0 Then Notnam = "C" If y = 1 Then Notnam = "Cis" If y = 2 Then Notnam = "D" If y = 3 Then Notnam = "Dis" If y = 4 Then Notnam = "E" If y = 5 Then Notnam = "F" If y = 6 Then Notnam = "Fis" If y = 7 Then Notnam = "G" If y = 8 Then Notnam = "Gis" If y = 9 Then Notnam = "A" If y = 10 Then Notnam = "Ais" If y = 11 Then Notnam = "H" End Sub Private Sub rechnen(ntn) 'Aus Midikey und Glissando die Frequenz ausrechnen Dim ntn1 As Integer ntn1 = Val(ntn) Key = (440 * (2 ^ (1 / 12)) ^ (ntn1 - 69)) Key = (Int(Key * rund + 0.5)) / rund End Sub Private Sub Inidateilesen() ' Inhalt der INI-Datei (Voreinstellungen in Klammern): ' ---------------------------------------------------- ' neuester Stand vom 13.12.2013: ' 1 Anzahl der Töne ' 2 Tempofaktor (1) ' 3 Lautstärkefaktor (80) ' 4 Modus (1) ' ---------------------------------------------------- 'On Error GoTo erle ivb = FreeFile Open inidatei For Input As ivb i = 0 Do Until EOF(1) i = i + 1 Line Input #1, Ini(i) Loop zeileni = i ' Anzahl der gelesenen Zeilen Close ivb i = 0 inidat.Clear Do Until i = zeileni i = i + 1 inidat.AddItem Ini(i) ' <------ vorübergehend außer Betrieb gesetzt (31.03.2014) - nicht mehr Loop 'Exit Sub erle: 'MsgBox "Die Inidatei " & inidatei & " ist nicht vorhanden" End Sub Private Sub Info() For i = 1 To 4 List2.AddItem " " Next i List2.AddItem " Infos - hier klicken!" For i = 1 To 25 List2.AddItem " " Next i ' Call Textscroller("C:\Arbeit-jms\Eigene Dateien 2\Texte\Bedienungsanleitungen\Komposi-Proginfo.txt") End Sub Private Sub Datenliste_Info() For i = 1 To 4 Daten.AddItem " " Next i ' Daten.AddItem " Tonliste" Daten.AddItem " " For i = 1 To 14 Daten.AddItem " " Next i End Sub Private Sub Textscroller2(von) 'Ein Text wird im Fenster gezeigt Dim zeile As String inidat.FontBold = False inidat.FontSize = 8 Open von For Input As #8 inidat.Clear Do While Not EOF(8) Line Input #8, zeile inidat.AddItem zeile Loop Close #8 End Sub Public Sub Textscroller(von) 'Ein Text wird im Fenster gezeigt Dim zeile As String ' inidat.FontBold = False ' inidat.FontSize = 8 'On Error GoTo weiter1 Open von For Input As #8 List2.Clear Do While Not EOF(8) Line Input #8, zeile List2.AddItem zeile Loop Close #8 weiter1: End Sub Private Sub Dauerncontainer_fullen(DD) Dim nn As Integer ' Zähler Dim zeile As String ' gelesene Zeilew ivb = FreeFile Open DD For Input As ivb ' C:\Arbeit\Komposi-DTC.txt (Dauerncontainer) nn = 0 Do Until EOF(ivb) nn = nn + 1 Line Input #ivb, zeile DC(nn) = Val(zeile) Loop Close ivb ' DC(1) = 1000 / 128 ' DC(2) = 1000 / 64 ' DC(3) = 1000 / 32 ' DC(4) = 1000 / 16 ' DC(5) = 1000 / 8 ' DC(6) = 1000 / 4 ' DC(7) = 1000 / 2 ' DC(8) = 1000 / 1 ' DC(9) = 1000 / 0.5 ' DC(10) = 1000 / 0.25 ' DC(11) = 1000 / 0.125 ' DC(12) = 1000 / 0.0625 End Sub Private Sub Ende_Click() midi_out_close End End Sub Private Sub Zuordnung_Click() Call Initial ' If Snd = 1 Then ' Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Cap-PT.txt" ' End If ' If Snd = 2 Then ' Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-HC.txt" ' End If End Sub Private Sub CapellaStart_Click() Shell "C:\Programme\capella2008\capella.exe C:\Arbeit\Komposi-01.cap", vbNormalFocus End Sub Private Sub CapellaStart02_Click() Shell "C:\Programme\capella2008\capella.exe C:\Arbeit\Komposi-02.cap", vbNormalFocus End Sub Private Sub Patti_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Cap-PT.txt" End Sub Private Sub Patti02_Click() Shell "C:\Arbeit\Editor-K\NoteTab.exe " & "C:\Arbeit\Komposi-Cap-02.txt" End Sub Private Sub Capellanotenwandeln_Click() ' liest und analysiert eine MusicXML-Datei ' und schreibt ein Pattern (Komposi-Cap-PT.txt) erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False Call CapNotWandel("C:\Arbeit\Komposi-01.xml", "C:\Arbeit\Komposi-Cap-PT.txt") Pzz1 = Pzzv ' Anzahl Patternzeilen End Sub Private Sub Capellanotenwandeln2_Click() ' liest und analysiert eine MusicXML-Datei ' und schreibt ein Pattern (Komposi-Cap-02.txt) erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False Call CapNotWandel("C:\Arbeit\Komposi-02.xml", "C:\Arbeit\Komposi-Cap-02.txt") Pzz2 = Pzzv ' Anzahl Patternzeilen End Sub Private Sub KeineFrage_Click() If Kefra = False Then Kefra = True KeineFrage.BackColor = &H95E2B5 ' vbWhite '&H1612CF ' vbRed Else Kefra = False KeineFrage.BackColor = &H9BC4FF End If End Sub Private Sub CapNotWandel(Kxm, PatDt) Call Initial ' If TFm = 5 Then Tdd = 0 ' <------------ NEU am 10.03.2014 ' If TFm = 6 Then Tdd = 1 ' <------------ NEU am 10.03.2014' If TFm = 1 Or TFm = 2 Then Capellanotenwandeln.Visible = False ' If TFm = 3 Or TFm = 4 Then Capellanotenwandeln.Visible = True ' Patterns werden von Capella geholt Daten.Visible = True Zuordnung.Visible = True List2.Width = 3525 inidat.Height = idahe breit = False ibreit = False ' ' Es wird direkt in die Felder HTpv(), DTpv() und LTpv() geschrieben! ' ' -------------------------------------------------------------------------------------------------- ' Programmablaufplan ' -------------------------------------------------------------------------------------------------- ' Suche das Wort - ermittle den Wert Variable Divisions ' DO LOOP ' Suche das Wort oder das Wort ' Suche das Wort - wenn gefunden ' Suche das Wort - wenn gefunden ' Suche das Wort - ermittle den Inhalt (Notenname, z.B. 'C') Variable Pitch ' Suche das Wort - wenn vorhanden, ermittle den Wert ('1' oder '-1') Variable Alter ' Suche das Wort - ermittle den Wert (z.B. '4') Variable Oktave ' Bilde aus pitch, alter und octave die Tonhöhe <------------------------ Variable HTxml ' Suche das Wort - ermittle den Wert (z.B. 1920) Variable Dauer ' Bilde die Tondauer: ' Tondauer = duration / divisions * Multiplikator (1000) <---------------- Variable DTvv ' Suche das Wort - wenn vorhanden, beachte das Folgende: ' ----------- ' Suche das Wort - ermittle den Wert (z.B. 480) Variable Dauer ' Addiere diesen Wert zur vorher ermittelten duration. DTvv = DTvv + Dauer ' ----------- ' Behandle die beiden Zeilen zwischen den Strichen als Schleife, ' bis der tiedtype-Zähler wieder 0 ist <--------- ! ' Erläuterung: Jeder Auftritt von soll diesen ' Zähler um 1 erhöhen und jeder Auftritt von ' soll ihn um 1 erniedrigen. Bei 0 sind wir dann raus aus den Schleifen. ' Bilde die Tondauer: ' Tondauer = (Gesamt)-duration / divisions * Multiplikator Variable DTxml ' (DTxml = DTvv / Divisions * Multiplikator) ' Suche das Wort - wenn gefunden ' Suche das Wort - ermittle den Wert (z.B. 480) Variable Dauer ' Bilde die Pausendauerdauer: Pausendauerdauer = duration / divisions * Multiplikator ' Variable DTxml ' LT soll dabei 0 sein ' UNTIL DATEI-ENDE ' -------------------------------------------------------------------------------------------------- Dim Ba As String ' Buchstabe Dim ErstesVorkommen As Boolean ' Dim Flag, WortGefunden As Boolean ' Dim mz As Integer ' Dim Wort, Clef, Zli As String ' Dim Suchwort As String ' Dim WortM As String ' Dim WortMM As String ' Dim WortMN As String ' Dim Angebunden As Boolean ' Dim Oktavverschiebung As Integer Dim Multiplikator As Integer Dim iii As Integer Dim x As Integer ' neu am 07.03.2014 ---------------------------------------------------------------------\ Dim Mldg, Stil, Titel, Antwort Dim HTkill, LTkill, DTkill As Boolean Stil = vbYesNo + vbDefaultButton1 ' Schaltfläche für die MsgBox definieren. Titel = "Vorsicht" ' für die MsgMox ' neu am 07.03.2014 ---------------------------------------------------------------------/ ' neu am 07.03.2014 ---------------------------------------------------------------------\ If Kefra = False Then Mldg = "Die TONHÖHEN werden mit Werten aus Capella überschrieben - ok?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort = vbYes Then HTkill = True Else HTkill = False Mldg = "Die LAUTSTÄRKEN werden mit 100 überschrieben - ok?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort = vbYes Then LTkill = True Else LTkill = False Mldg = "Die TONDAUERN werden mit Werten aus Capella überschrieben - ok?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort = vbYes Then DTkill = True Else DTkill = False Else ' NEU am 09.03.2014 HTkill = True LTkill = True DTkill = True End If Call PatternAnalyse(PatDt) ' als Subroutine NEU - 03.03.2014 ' neu am 07.03.2014 ---------------------------------------------------------------------/ Oktavverschiebung = 0 ' mal so testen ... <--------- Multiplikator = 2000 ' für die Tondauer, also für DTxml <--------- ' --------------------------------------------------------------------- ' Zuerst die MusicXML-Datei öffnen und alle Zeilen in ein Feld tun. ivb = FreeFile ' Open "C:\Arbeit\Komposi.xml" For Input As iVB ' Komposi.xml oder ... Open Kxm For Input As ivb ' Komposi.xml oder ... i = 0 Do Until EOF(1) i = i + 1 Line Input #ivb, XL(i) Loop nv = i ' Anzahl der gelesenen Zeilen Close ivb ' -------------------------------------------------------------------- ' Jetzt den Feldinhalt analysieren und bestimmte Inhalte heraussuchen: ' -------------------------------------------------------------------- ' suchen '------------------------------------------------------------------- Suchwort = "" ErstesVorkommen = False ny = 0 ' Zeilenmerker For n = 1 To nv ' nv Zeilen, also alle Zeilen nacheinander aufrufen If ErstesVorkommen = False Then Wort = "": Clef = "": Flag = 0 Zli = XL(n) ' die ganze Zeile steht in Zli For mz = 1 To Len(Zli) ' Eine Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then ny = n ' Zeile merken nx = mz ' Spalte merken ErstesVorkommen = True End If Next mz End If Next n m = Mid(XL(ny), nx + Len(Suchwort), 12) ' Wert ohne VAL Divisions = Val(m) ' MsgBox " = " & Divisions '------------------------------------------------------------------- ' mit , , , und ' oder mit suchen '------------------------------------------------------------------- Angebunden = False ' Sollte die folgende Note angebunden werden, ' wäre Angebunden = True. Es würde dann beim ' Schreiben der Datei Komposi-PT.txt nur die Dauer ' des folgenden Tons berücksichtigt werden und zur ' zuvor ermittelten Dauer addiert werden. iii = 0 n = 0 ' Zeilenzähler Do Until n = nv ' alle Zeilen lesen Alter = 0 WortM = "" n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny End If Next mz ' nächste Stelle in der Zeile If WortM = "" Then iii = iii + 1 ' Patternfelderzähler jj = 0 Do Until WortM = "" Or WortM = "" Or jj = 100 jj = jj + 1 ' Überlaufzähler n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken WortMN = Wort ' merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny End If Next mz ' nächste Stelle in der Zeile ' suchen '------------------------------------------------------------------- Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken WortMN = Wort ' merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny End If Next mz ' nächste Stelle in der Zeile Loop If WortM = "" Then ' suchen '------------------------------------------------------------------- n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny '' Wert ermitteln .. steht dann in Pitch '''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''' m = Mid(Zli, nx + Len(Suchwort), 12) ' Wert ohne VAL i = 0 Ba = "" Do Until Ba = "<" Or i = 200 i = i + 1 Ba = Mid(m, i, 1) Loop Pitch = Mid(m, i - 1, 1) ' MsgBox "Notenname: " & Pitch '''''''''''''''''''''''''''''''''''''''''''''''''''''''' End If Next mz ' nächste Stelle in der Zeile WortMM = "" Do Until WortMM = "" ' suchen '------------------------------------------------------------------- n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken WortMM = WortM ' gemerkt ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny End If Next mz ' nächste Stelle in der Zeile If WortM <> "" Then ' suchen '------------------------------------------------------------------- Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny '' Wert ermitteln .. steht dann in Alter '''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''' m = Mid(Zli, nx + Len(Suchwort), 12) ' Wert ohne VAL Alter = Val(m) ' MsgBox "Kreuz oder B: " & Alter '''''''''''''''''''''''''''''''''''''''''''''''''''''''' End If Next mz ' nächste Stelle in der Zeile ' suchen '------------------------------------------------------------------- Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny '' Wert ermitteln .. steht dann in Oktave '''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''' m = Mid(Zli, nx + Len(Suchwort), 12) ' Wert ohne VAL Oktave = Val(m) ' MsgBox "Oktavlage: " & Oktave '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call NotMid ' den MIDI-Wert ausrechnen - er steht dann in HTxml HTxml = HTxml + Oktavverschiebung * 12 ' MsgBox "errechnete Tonhöhe: " & HTxml End If Next mz ' nächste Stelle in der Zeile End If ' if WortM <> "" Loop End If ' If WortM = "pitch" n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox " steht bei Zeilennummer = " & ny '' Wert ermitteln .. steht dann in Dauer '''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''' m = Mid(Zli, nx + Len(Suchwort), 12) ' Wert ohne VAL Dauer = Val(m) If WortMN = "" Then If Angebunden = False Then DTvv = Dauer ' Dauer merken ' MsgBox "Tondauer: " & Dauer DTxml = Dauer / Divisions * Multiplikator ' schreibe eine Zeile mit HTxml und DTxml und LT = 100 If HTkill = True Then HTpv(iii) = HTxml End If If DTkill = True Then DTpv(iii) = DTxml End If If LTkill = True Then LTpv(iii) = 100 End If Else Dauer = Dauer + DTvv ' die gemerkte Dauer zur aktuellen Dauer addiert! DTvv = Dauer ' die neue Dauer merken ' MsgBox "Gesamtdauer jetzt: " & Dauer DTxml = Dauer / Divisions * Multiplikator ' korrigiere die Dauer bei der aktuellen Zeile mit DTxml iii = iii - 1 ' um die Dauer zu korrigieren If DTkill = True Then DTpv(iii) = DTxml End If ' MsgBox "es wurde korrigiert: - Feld Nummer " & iii & ": " & HTpv(iii) & " " & DTpv(iii) & " " & LTpv(iii) End If End If If WortMN = "" Then ' MsgBox "Pausendauer: " & Dauer DTxml = Dauer / Divisions * Multiplikator ' schreibe eine Zeile mit HTxml und DTxml und LT = 0 If HTkill = True Then HTpv(iii) = HTxml End If If DTkill = True Then DTpv(iii) = DTxml End If If LTkill = True Then LTpv(iii) = 1 ' <-------- Pause End If ' MsgBox "es wurde in die Felder geschrieben: - Feld Nummer " & iii & ": " & HTpv(iii) & " " & DTpv(iii) & " " & LTpv(iii) End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''' End If Next mz ' nächste Stelle in der Zeile ' hier wird noch nach ' gesucht. ' Wenn direkt nach steht, ' wird die nächste Tondauer drangehängt. If WortMN = "" Then n = n + 1 Zli = XL(n) ' die ganze Zeile steht in Zli Suchwort = "" For mz = 1 To Len(Zli) ' Einzelne Stellen in der Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then WortM = Wort ' Wort merken ny = n ' Zeile merken nx = mz ' Spalte merken ' MsgBox "" Then Angebunden = True Else Angebunden = False End If ' MsgBox "JETZT DIE NÄCHSTE ZEILE ..." End If ' If WortM = "" Loop ' nächste Zeile ' Das Pattern in die Datei PatternDatei schreiben ivb = FreeFile ' Patterndatei = "C:\Arbeit\Komposi-Cap-PT.txt" Patterndatei = PatDt Open Patterndatei For Output As ivb ' Patternfile Pzzv = iii ' Anzahl der Patternzeilen For x = 1 To Pzzv If HTpv(x) <> 0 Then Print #ivb, HTpv(x) & " " & LTpv(x) & " " & DTpv(x) End If Next x Close ivb ' Das Pattern in der rechten Spalte namens 'Zuordnung' auflisten: Zuordnung.Clear ' Zuordnung.AddItem "Pattern aus " & CAPDatei & ":" Zuordnung.AddItem "Pattern von der Capelladatei" Zuordnung.AddItem "Datei " & PatDt Zuordnung.AddItem "" Pzzv = iii ' Anzahl der Patternzeilen For x = 1 To Pzzv If HTpv(x) <> 0 Then Zuordnung.AddItem HTpv(x) & " " & LTpv(x) & " " & DTpv(x) End If Next x Zuordnung.AddItem "" CAPPattern = True ' NEU: ' Call Dateiherstellung_Click ' .... doch nicht End Sub Private Sub NotMid() ' den MIDI-Wert ausrechnen If Pitch = "C" Then HTxml = 0 + Oktave * 12 + Alter End If If Pitch = "D" Then HTxml = 2 + Oktave * 12 + Alter End If If Pitch = "E" Then HTxml = 4 + Oktave * 12 + Alter End If If Pitch = "F" Then HTxml = 5 + Oktave * 12 + Alter End If If Pitch = "G" Then HTxml = 7 + Oktave * 12 + Alter End If If Pitch = "A" Then HTxml = 9 + Oktave * 12 + Alter End If If Pitch = "B" Then HTxml = 11 + Oktave * 12 + Alter End If End Sub Private Sub SucheWort(Suchwort) ' nach einem Wort suchen ' nach SucheSpurnamen() aus Hukumu Dim ErstesVorkommen As Boolean Dim Flag, WortGefunden As Boolean Dim mz As Integer Dim Wort, Clef, Zli As String ErstesVorkommen = False ny = 0 For n = 1 To nv ' nv Zeilen, also alle Zeilen nacheinander aufrufen If ErstesVorkommen = False Then Wort = "": Clef = "": Flag = 0 Zli = XL(n) ' die ganze Zeile steht in Zli For mz = 1 To Len(Zli) ' Eine Zeile checken Wort = Mid$(Zli, mz, Len(Suchwort)) If Wort = Suchwort Then ' Reaper-Schlüsselwort ny = n ' Zeile merken nx = mz ' Spalte merken WortGefunden = True ' brauchen wir das? ErstesVorkommen = True End If Next mz End If Next n ' m = Val(Mid(XL(ny), nx + Len(Suchwort), 12)) ' in m steht der Wert m = Mid(XL(ny), nx + Len(Suchwort), 12) ' Wert ohne VAL End Sub Private Sub Komposinotenlesen() ' aus Sub Neuton übernommen Dim zeile, BB, B As String Dim Lta As Single Erase HT Erase DT Erase LT Call Dauerncontainer_fullen("C:\Arbeit\Komposi-DTC.txt") Open KT For Input As 1 ' (KT = C:\Arbeit\Komposi.txt) Zz = 1 ' Zeilenzähler ' ibreit = False ' Call inidat_Click ' ??? ' Daten.Clear Do Until EOF(1) Do Line Input #1, zeile Loop Until Val(zeile) <> 0 ' And Len(Zeile) < 16 ' Leerzeilen entfernen i = 0 ' HT berechnen: BB = "" ' bb = Buchstabensammler, b = gelesener Einzelbuchstabe Do i = i + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vieren Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "Falschen Wert für HT eingelesen: " & BB ' Fehler in der Komposi-Datei Call Hallo("Falschen Wert für HT eingelesen: " & BB) ' Fehler in der Komposi-Datei BB = 1 End If If Val(BB) > 127 And Snd = 1 Then ' NEU: bei Snd = 2 (Sample) dürfen die Werte höher sein! ' MsgBox "Wert für HT größer 127 eingelesen: " & BB ' Fehler in der Komposi-Datei Call Hallo("Wert für HT größer 127 eingelesen: " & BB) ' Fehler in der Komposi-Datei BB = 127 End If HT(Zz) = BB ' <------------------------------------- HT ins Feld ' MsgBox "HT(" & zz & ") : " & HT(zz) ' LT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "Wert für LT kleiner 1 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)" Call Hallo("Wert für LT kleiner 1 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)") BB = 1 End If If Val(BB) > 127 Then ' MsgBox "Wert für LT größer 127 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)" Call Hallo("Wert für LT größer 127 eingelesen! ..." & BB & "... (Fehler in Komposi.txt)") BB = 127 End If LT(Zz) = BB ' <------------------------------------- LT ins Feld ' DT berechnen: BB = "" j = 0 Do i = i + 1: j = j + 1: B = Mid(zeile, i, 1) ' einen Buchstaben lesen Loop Until Val(B) > 0 Or j > 100 ' führende Leerstellen entfernen If Val(B) > 0 Then BB = BB + B ' erste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen zweiten Buchstaben lesen If B <> " " Then BB = BB + B ' zweite Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen dritten Buchstaben lesen End If If B <> " " Then BB = BB + B ' dritte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen vierten Buchstaben lesen End If If B <> " " Then BB = BB + B ' vierte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen fünften Buchstaben lesen End If If B <> " " Then BB = BB + B ' fünfte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen sechsten Buchstaben lesen End If If B <> " " Then BB = BB + B ' sechste Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen siebten Buchstaben lesen End If If B <> " " Then BB = BB + B ' siebte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen achten Buchstaben lesen End If If B <> " " Then BB = BB + B ' achte Stelle dazutun i = i + 1: B = Mid(zeile, i, 1) ' noch einen neunten Buchstaben lesen End If End If If Val(BB) < 1 Then ' MsgBox "in Neuton Wert für DT kleiner 1 eingelesen!" ' Fehler in der Komposi-Datei BB = 1 End If If Tdd = 0 Then ' wenn TONDAUERDIREKT nicht gesetzt ist ' Der Containerwert, auf den bb zeigt, wird in DT(zz) eingetragen: DT(Zz) = DC(BB) Else DT(Zz) = BB End If ' MsgBox "DT(" & zz & ") : " & DT(zz) ' Daten.AddItem zz & " " & HT(zz) & " " & LT(zz) & " " & DT(zz) Zz = Zz + 1 Loop ' nächste Zeile aus der Datei holen Zza = Zz - 1 ' Zeilenzahl erm: Close 1 End Sub Private Sub KomposiCap_Click() ' 19.03.2014 Dim Schlussel As String ' Schlüssel Dim ZaNe As String ' Hilfsvariable für Taktangabe Dim Za, Ne As Integer ' Zähler, Nenner für Taktangabe Dim NT As String ' Note Dim OL As Integer ' Oktavlage Dim NW As String ' Notenwert als Note (Viertel, Halbe, ..) Dim NWz As String ' Notenwert als Zahl .... Dim ii As Integer ' Zähler Dim dtmax As Double ' enthält den größten Notenwert Dim dtmin As Double ' enthält den kleinsten Notenwert Dim Pt As Integer ' Verlängerungspunkt erklaminus.Visible = False erklaplus.Visible = False Label5.Visible = False inidat.ForeColor = vbBlack inidat.FontBold = False inidat.FontSize = 8 Call Initial ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Einstellungen: If VBS = 1 Then Schlussel = "G" ' G = Violinschlüssel End If If VBS = 2 Then Schlussel = "F" ' F = Bass-Schlüssel End If ZaNe = Str(TKT) If ZaNe <> 0 Then Za = Left(TKT, 1) ' Zähler - bei Za = 0: kein Takt! Ne = Right(TKT, Len(TKT) - 1) ' Nenner Else Za = 0: Ne = 0 End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Call Komposinotenlesen ' die Felder HT(), LT() und DT() werden ' mit den Daten aus Komposi.tst gefüllt ' Getestet! - Die Felder sind gefüllt! ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'größten Notenwert ermitteln: dtmax = 0 For ii = 1 To Zza If DT(ii) > dtmax Then dtmax = DT(ii) Next ii 'dtmax enthält nun den größten vorkommenden Notenwert 'kleinsten Notenwert ermitteln: dtmin = dtmax For ii = 1 To Zza If DT(ii) < dtmin Then dtmin = DT(ii) Next ii 'dtmin enthält nun den kleinsten vorkommenden Notenwert Dim NWe(10, 2) As String ' Feld, das die Notenwertenamen enthält If KZW = 128 Then NWe(1, 1) = "128th" NWe(1, 2) = "8" NWe(2, 1) = "64th" NWe(2, 2) = "15" NWe(3, 1) = "32nd" NWe(3, 2) = "30" NWe(4, 1) = "16th" NWe(4, 2) = "60" NWe(5, 1) = "eightth" NWe(5, 2) = "120" NWe(6, 1) = "quarter" NWe(6, 2) = "240" NWe(7, 1) = "half" NWe(7, 2) = "480" NWe(8, 1) = "whole" NWe(8, 2) = "960" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If If KZW = 64 Then NWe(1, 1) = "64th" NWe(1, 2) = "15" NWe(2, 1) = "32nd" NWe(2, 2) = "30" NWe(3, 1) = "16th" NWe(3, 2) = "60" NWe(4, 1) = "eightth" NWe(4, 2) = "120" NWe(5, 1) = "quarter" NWe(5, 2) = "240" NWe(6, 1) = "half" NWe(6, 2) = "480" NWe(7, 1) = "whole" NWe(7, 2) = "960" NWe(8, 1) = "breve" NWe(8, 2) = "1920" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If If KZW = 32 Then NWe(1, 1) = "32nd" NWe(1, 2) = "30" NWe(2, 1) = "16th" NWe(2, 2) = "60" NWe(3, 1) = "eightth" NWe(3, 2) = "120" NWe(4, 1) = "quarter" NWe(4, 2) = "240" NWe(5, 1) = "half" NWe(5, 2) = "480" NWe(6, 1) = "whole" NWe(6, 2) = "960" NWe(7, 1) = "breve" NWe(7, 2) = "1920" NWe(8, 1) = "breve" NWe(8, 2) = "1920" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If If KZW = 16 Then NWe(1, 1) = "16th" NWe(1, 2) = "60" NWe(2, 1) = "eightth" NWe(2, 2) = "120" NWe(3, 1) = "quarter" NWe(3, 2) = "240" NWe(4, 1) = "half" NWe(4, 2) = "480" NWe(5, 1) = "whole" NWe(5, 2) = "960" NWe(6, 1) = "breve" NWe(6, 2) = "1920" NWe(7, 1) = "breve" NWe(7, 2) = "1920" NWe(8, 1) = "breve" NWe(8, 2) = "1920" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If If KZW = 8 Then NWe(1, 1) = "eightth" NWe(1, 2) = "120" NWe(2, 1) = "quarter" NWe(2, 2) = "240" NWe(3, 1) = "half" NWe(3, 2) = "480" NWe(4, 1) = "whole" NWe(4, 2) = "960" NWe(5, 1) = "breve" NWe(5, 2) = "1920" NWe(6, 1) = "breve" NWe(6, 2) = "1920" NWe(7, 1) = "breve" NWe(7, 2) = "1920" NWe(8, 1) = "breve" NWe(8, 2) = "1920" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If If KZW = 4 Then NWe(1, 1) = "quarter" NWe(1, 2) = "240" NWe(2, 1) = "half" NWe(2, 2) = "480" NWe(3, 1) = "whole" NWe(3, 2) = "960" NWe(4, 1) = "breve" NWe(4, 2) = "1920" NWe(5, 1) = "breve" NWe(5, 2) = "1920" NWe(6, 1) = "breve" NWe(6, 2) = "1920" NWe(7, 1) = "breve" NWe(7, 2) = "1920" NWe(8, 1) = "breve" NWe(8, 2) = "1920" NWe(9, 1) = "breve" NWe(9, 2) = "1920" End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ivb = FreeFile Open "C:\Arbeit\Komposi-Cap.xml" For Output As ivb Call Vorspann Call Mittelspann(Za, Ne, Schlussel) ' ==========================================================================================\ For i = 1 To Zza ' jetzt Zahlen aus HT() und DT() in Notencodes umwandeln! 'Tonhöhenwert: TWert = HT(i) + 13 + TRN ' Korrekturwert, + 13 ist normal, dazu kommt der TRANSPOSIWERT TRN ii = 0 Do Until TWert <= 0 TWert = TWert - 12 ii = ii + 1 Loop 'Notenwert: TWert = TWert + 12 ' damit TWert wieder positiv wird 'Oktavlage: OL = ii - 2 ' Korrekturfaktor .. <---- hier wird die Oktavlage bestimmt Select Case TWert Case 1 NT = "C" VK = 0 Case 2 NT = "C" VK = 1 ' Kreuz Case 3 NT = "D" VK = 0 Case 4 NT = "D" VK = 1 Case 5 NT = "E" VK = 0 Case 6 NT = "F" VK = 0 Case 7 NT = "F" VK = 1 Case 8 NT = "G" VK = 0 Case 9 NT = "G" VK = 1 Case 10 NT = "A" VK = 0 Case 11 NT = "A" VK = 1 Case 12 NT = "B" VK = 0 End Select '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Info: ' Doppelganze Ganze Halbe Viertel Achtel ' breve whole half quarter eightth 16th 32nd 64th ' Notenwert: NWert = DT(i) ' Nachsehen, welcher Notenwert (Viertel, Achtel usw.) am ehesten ' der Tondauer in DT() entspricht (NEU, mit Punktierung!): ' Pt = 0 ' zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ' Versuch mit Punktierungen, aber hier ist was falsch: ' Dim Zwe1, Zwe2, Zwe3 ' Zwischenwert ' Dim xx As Integer ' ' Zwe1 = 0.25 ' Zwe2 = 0.625 ' Zwe3 = 0.83 ' oder 0.8125? ' ' For xx = 1 To 8 ' If xx = 1 Then ' If NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe2)) Then ' NW = NWe(xx) ' z.B. Sechzehntel ' Pt = 0 ' End If ' Else ' If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe1)) And NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe2)) Then ' NW = NWe(xx) ' z.B. Sechzehntel ' Pt = 0 ' End If ' End If ' If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe2)) And NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe3)) Then ' NW = NWe(xx) ' Pt = 1 ' punktiert ' End If ' If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe3)) And NWert < Int(dtmin * 2 ^ (xx + Zwe1)) Then ' NW = NWe(xx) ' Pt = 2 ' doppelt punktiert ' End If ' Next xx '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ' yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy ' zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ' Neuer Versuch (00:55 26.03.2014). ' Dies funktioniert jetzt perfekt: Dim Zwe1, Zwe2, Zwe3, Zwe4 ' Zwischenwert Dim xx As Integer Zwe1 = 0.8125 Zwe2 = 1.25 Zwe3 = 1.625 Zwe4 = 1.8125 If NWert < Int(dtmin * 2 ^ Zwe1) Then NW = NWe(1, 1) NWz = NWe(1, 2) Pt = 0 End If For xx = 1 To 8 If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe1)) And NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe2)) Then NW = NWe(xx + 1, 1) NWz = NWe(xx + 1, 2) Pt = 0 End If If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe2)) And NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe3)) Then NW = NWe(xx + 1, 1) NWz = NWe(xx + 1, 2) Pt = 1 End If If NWert >= Int(dtmin * 2 ^ ((xx - 1) + Zwe3)) And NWert < Int(dtmin * 2 ^ ((xx - 1) + Zwe4)) Then NW = NWe(xx + 1, 1) NWz = NWe(xx + 1, 2) Pt = 2 End If Next xx ' zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz ' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ''''''''''''''''''''''''''''''''''''''''''''''''' ' Eine Note oder eine Pause schreiben: If LT(i) > 1 Then ' Note Call Ton(NT, OL, NW, NWz, Pt) ' Note, Oktavlage, Notenwert, Verlängerungspunkt Else ' Pause Call Pause(NW, NWz, Pt) ' Notenwert, Verlängerungspunkt End If ''''''''''''''''''''''''''''''''''''''''''''''''' ' Neue Zeile, also Zeilenumbruch: If i / NPZ = Int(i / NPZ) Then Call NeueZeile(i / NPZ) End If Next i ' ==========================================================================================/ Call Nachspann Close ivb End Sub Private Sub Ton(note, Oktave, wert, wertz, Punkt) ' Note, Oktavlage, Notenwert Print #ivb, " " Print #ivb, " " Print #ivb, " " & note & "" If VK = 1 Then Print #ivb, " 1" End If Print #ivb, " " & Oktave & "" Print #ivb, " " Print #ivb, " " & wertz & "" Print #ivb, " 1" Print #ivb, " " & wert & "" If Punkt = 1 Then Print #ivb, " " End If If Punkt = 2 Then Print #ivb, " " Print #ivb, " " End If If VK = 1 Then Print #ivb, " sharp" End If Print #ivb, " " End Sub Private Sub Pause(wert, wertz, Punkt) ' Notenwert Print #ivb, " " Print #ivb, " " Print #ivb, " " & wertz & "" Print #ivb, " 1" Print #ivb, " " & wert & "" If Punkt = 1 Then Print #ivb, " " End If If Punkt = 2 Then Print #ivb, " " Print #ivb, " " End If Print #ivb, " " End Sub Private Sub NeueZeile(Neuzeile) ' Zeilenumbruch - die erste einzugebende Zahl für ' die Neuzeile ist 1, dann fortlaufend 2, 3, 4, .. Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " 30" Print #ivb, " 0" Print #ivb, " " Print #ivb, " 120" Print #ivb, " " Print #ivb, " " Print #ivb, " 20" Print #ivb, " " Print #ivb, " " End Sub Private Sub Vorspann() Print #ivb, "" Print #ivb, "" Print #ivb, "" Print #ivb, "" Print #ivb, " " Print #ivb, " " ' Print #iVB, " 2014-03-19" Print #ivb, " " & Date & "" Print #ivb, " CapToMusic.py CapXML to MusicXML converter version 1.11" Print #ivb, " Options: FinaleDolet33=1, ChordCaseMatters=0, ExportToSibelius=0" Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " 1.8" Print #ivb, " 10.0" Print #ivb, " " Print #ivb, " " Print #ivb, " 1650" Print #ivb, " 1166" Print #ivb, " " Print #ivb, " 111" Print #ivb, " 111" Print #ivb, " 111" Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " 0" Print #ivb, " 0" Print #ivb, " " Print #ivb, " 40" Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " Midi_12" Print #ivb, " " Print #ivb, " " Print #ivb, " 1" Print #ivb, " 12" Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " 0" Print #ivb, " 0" Print #ivb, " " Print #ivb, " 60" Print #ivb, " " Print #ivb, " " Print #ivb, " 20" Print #ivb, " " Print #ivb, " " Print #ivb, " " Print #ivb, " 480" Print #ivb, " " Print #ivb, " 0" Print #ivb, " major" Print #ivb, " " End Sub Private Sub Mittelspann(Za, Ne, Schlussel) Print #ivb, " " Print #ivb, " " Print #ivb, " " & Schlussel & "" Print #ivb, " 2" Print #ivb, " " Print #ivb, " " End Sub Private Sub Nachspann() Print #ivb, " " Print #ivb, " " Print #ivb, "" End Sub Private Sub Hallo(Mldg) Dim Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton1 ' Schaltfläche definieren. Titel = "FEHLER" Antwort = MsgBox(Mldg & " - weiter?", Stil, Titel) If Antwort <> vbYes Then End ' Programmende End Sub Private Sub Speichern_Click() Dim Mldg, Stil, Titel, Antwort Stil = vbYesNo + vbDefaultButton2 ' Schaltfläche definieren. Titel = "Frage zur Sicherheit" Mldg = "die aktuellen Einstellungen wirklich speichern?" Antwort = MsgBox(Mldg, Stil, Titel) If Antwort <> vbYes Then GoTo Sube2 Call Linien.Speichern2_Click Sube2: End Sub Private Sub Load_Click() Dim zeile2, ttxt As String Linien.Show Linien.Lini.Clear ivb = FreeFile Open "C:\Arbeit\Komposi-Doku.txt" For Input As ivb Do Until EOF(ivb) Line Input #ivb, zeile2 Linien.Lini.AddItem zeile2 Loop Close #ivb End Sub