Easy program for making melody for Pascal

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: KMP (Club of young programmers)
klavirus.pngAuthor: Patrik Benyak
Program: Klavirus.pas

Easy program for making melody for Pascal. He is write melody to file. Run script is on end of file. All instructions is in source code. Other description in Slovak.
{ KLAVIRUS.PAS 1.0                                                  }
{ Program pre tvorbu melodii                                        }
{ -------------------------------------------                       }
{ | pato1 studio @ Patrik Benyak            |                       }
{ | http://pato1.ic.cz/                     |                       }
{ -------------------------------------------                       }
{ | Tento program je sireny pod licenciu    |                       }
{ | P1PL OS (http://pato1.ic.cz/p1plos.txt) |                       }
{ -------------------------------------------                       }
{ | Copyrights (C) pato1 2009/10            |                       }
{                                                                   }
{ Datum:19.04.2009                             http://www.trsek.com }
 
program klavirus;
uses crt, JwaWinBase;
var
 a, b, c, d, e: integer;
 znak: char;
 f: TextFile;
 meno, songname: string;
begin
 d:=50;
 ClrScr;
 writeln('Vitaj v klaviruse: n stroji na skladanie mel˘diĄ pre pascal');
 writeln;
 write('N hodn  pripoŸĄtan  hodnota [1/0]: ');
 readln(e);
 if e=0 then
 begin
  write('PripoŸĄtan  hodnota:  ');
  readln(d);
 end;
 write('Zadaj poŸet MILISEKéND d’§ky ka§d‚ho t˘nu: ');
 readln(b);
 write('Zadaj meno sŁboru: ');
 readln(meno);
 write('Zadaj meno melodie: ');
 readln(songname);
 writeln;
 writeln('1.riadok v subore je "TONERATE". 2.riadok v subore je "SONGNAMA" a zviçok sŁ t˘ny');
 writeln;
 Assign(f, meno);
 ReWrite(f);
 writeln(f, b);
 writeln(f, songname);
 writeln('Hraj !!! [ESC]koniec');
 repeat
  if e=1 then d:=Random(100)+30;
  znak:=ReadKey;
  Beep(Ord(znak)+d, b);
  writeln(f, Ord(znak)+d);
 until znak=#27;
 Close(f);
 ClrScr;
end.
 
{ rutiny na spustanie melodie (neodskusana (iba teoria)):(treba vymazat posledny riadok)
program run;
uses crt, SysUtils, pato1asvk; //pre spustaciu rutinu je potrebn  moja kniznica pato1asvk v 1.3 (http://pato1.ic.cz/pato1asvk/13.rar)
var
 a: integer;
 f: TextFile;
 meno, songname, buffer: string;
begin
  Write('Zadaj meno suboru: ';)
 readln(meno);
 Assign(f, meno);
 readln(f, buffer);
 a:=StrToInt(buffer);
 readln(f, songname);
 ClrScr;
 writeln(songname, '  TONERATE: ', a, ' : PLAYING:');
 while not Eof(f) do
 begin
  readln(f, buffer);
  pip(StrtoInt(buffer), a);
 end;
end.     }