Vianočná tématika

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: KMP (Programy mladňakoch

Zrobil: Miroslav Lízal, Tomáš Okurek
web: pascalweb.wz.cz/index86.html

Program: Vanoce.pas
Subor exe: Vanoce.exe

Vianočná tématika. Program sa spustí len na Vianoce 24.12.
{ VANOCE.PAS             Copyright (c) Miroslav Lízal, TomᚠOkurek }
{ Vianocna tematika. Program sa spusti len na vianoce 24.12.        }
{                                                                   }
{ Datum:04.11.2003                             http://www.trsek.com }
 
program narozeniny;
uses crt,dos;
var rep,tempo,zar:integer;
var p:char;
var c,d,e,f,g,a,h,c2:integer;
var d1,d2,d3,d4,d1t,d8:integer;
var den,y,mesic,dow:word;
var m:string;
begin
  clrscr;
  GetDate(y,mesic,den,dow);
 
  if (den=24) and (mesic=12) then begin
m:='                                            ';
nosound;
c:=261;
d:=293;
e:=329;
f:=349;
g:=392;
a:=440;
h:=493-27;
c2:=523;
 
tempo:=200;
d8:=tempo;
d1:=tempo*2;
d1t:=tempo*3;
d2:=tempo*4;
d3:=tempo*6;
d4:=tempo*8;
 
textbackground(blue);
clrscr;
textcolor(white);
gotoxy(1,27);
p:=chr(219);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
textcolor(red);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
textcolor(white);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln('         ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
gotoxy(45,8);
textcolor(green);
writeln('         ',p);
writeln(m,'        ',p,p,p);
writeln(m,'       ',p,p,p,p,p);
writeln(m,'      ',p,p,p,p,p,p,p);
writeln(m,'     ',p,p,p,p,p,p,p,p,p);
writeln(m,'       ',p,p,p,p,p);
writeln(m,'      ',p,p,p,p,p,p,p);
writeln(m,'     ',p,p,p,p,p,p,p,p,p);
writeln(m,'    ',p,p,p,p,p,p,p,p,p,p,p);
writeln(m,'   ',p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln(m,'      ',p,p,p,p,p,p,p);
writeln(m,'     ',p,p,p,p,p,p,p,p,p);
writeln(m,'    ',p,p,p,p,p,p,p,p,p,p,p);
writeln(m,'   ',p,p,p,p,p,p,p,p,p,p,p,p,p);
writeln(m,'  ',p,p,p,p,p,p,p,p,p,p,p,p,p,p,p);
textcolor(brown);
writeln(m,'         ',p);
 
gotoxy(17,25);textcolor(red);write(p,p,'   ',p,p);
gotoxy(19,26);textcolor(red);write(p,p,p);
gotoxy(20,27);textcolor(red);write(p);
gotoxy(20,28);textcolor(red);write(p);
gotoxy(20,29);textcolor(red);write(p);
gotoxy(20,30);textcolor(red);write(p);
gotoxy(20,31);textcolor(red);write(p);
gotoxy(20,32);textcolor(red);write(p);
gotoxy(20,33);textcolor(red);write(p);
gotoxy(20,34);textcolor(red);write(p);
textcolor(white);
GOTOXY(10,10);writeln('Stastny a vesely!');
write('                          Mirecek');
gotoxy(30,49);write('Jake koliv pripominky piste na +420 777 846 881');
 
 
for rep:=1 to 2 do begin
sound(f);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(f);
  delay(d1);
  nosound;
sound(e);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(g+24);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(h);
  delay(d1);
  nosound;
sound(h);
  delay(d3);
  nosound;
 
sound(c2);
  delay(d1t);
  nosound;
sound(h);
  delay(d8);
  nosound;
sound(h);
  delay(d1);
  nosound;
sound(a);
  delay(5*d1);
  nosound;
 
sound(c);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(h);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
if rep=1 then begin
              sound(f);
                delay(d1);
                nosound;
              sound(f);
                delay(d1);
                nosound;
              sound(f);
                delay(d1);
                nosound;
              sound(f);
                delay(d1);
                nosound;
              sound(g);
                delay(d1);
                nosound;
              sound(a);
                delay(d1);
                nosound;
              sound(g);
                delay(7*d1);
                nosound;
                delay(2*d1);
              end
         end;      (* Konec repetice*)
sound(g);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
sound(g);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
 
sound(f);
  delay(3*d1);
  nosound;
sound(d);
  delay(3*d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
  delay(2*d1);
        (*   2. strana           <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<*)
 
sound(f);
  delay(d1);
  nosound;
sound(e);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(d);
  delay(d1);
  nosound;
sound(c+17);
  delay(d1);
  nosound;
sound(d);
  delay(d1);
  nosound;
 
sound(f);
  delay(d1);
  nosound;
sound(e);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(g);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
sound(d);
  delay(d1);
  nosound;
 
sound(c);
  delay(d1);
  nosound;
sound(f);
  delay(2*d1);
  nosound;
 
  delay(d1);
sound(a);
  delay(d1);
  nosound;
sound(g+23);
  delay(d1);
  nosound;
 
sound(h);
  delay(d1);
  nosound;
sound(a);
  delay(3*d1);
  nosound;
  delay(2*d1);
 
sound(c2+54);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
sound(f);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(c2+54);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
sound(f);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(c2);
  delay(d1);
  nosound;
  delay(6*d1);
  nosound;
 
 
 
(*         <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<*)
sound(f);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(f);
  delay(d1);
  nosound;
sound(e);
  delay(d1);
  nosound;
sound(f);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(g+24);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(h);
  delay(d1);
  nosound;
sound(h);
  delay(d3);
  nosound;
 
sound(c2);
  delay(d1t);
  nosound;
sound(h);
  delay(d8);
  nosound;
sound(h);
  delay(d1);
  nosound;
sound(a);
  delay(5*d1);
  nosound;
 
sound(c);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(a);
  delay(d1);
  nosound;
sound(h);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
 
sound(g);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
sound(g);
  delay(d1);
  nosound;
sound(a);
  delay(d1);
  nosound;
sound(g);
  delay(d1);
  nosound;
 
 
sound(f);
  delay(d1);
  nosound;
 
end
else begin
      textbackground(red);
      clrscr;
      textcolor(black);
      writeln;
      write('  Tento program je urcen k spusteni pouze o vanocich.');
      readkey;
     end
end.