Paint Brush

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)

Autor: Slavomír Hudák
Program: Proj1_0.pas
Soubor exe: Proj1_0.exe
Potřebné: Egavga.bgi

Paint Brush. Podarená náhrada známeho grafického editora.
{ PROJ1_0.PAS                                                       }
{                                                                   }
{ Author: Slavomir Hudak                                            }
{ Date  : 15.02.1997                           http://www.trsek.com }
 
program Stargr_1_0;
uses crt,graph;
var gd,gm,x,y,h,xh,yh:integer;
    v:char;
procedure inst;
 begin
 clrscr;
 writeln('Pohyb sipkami do prava,do lava,hore,dole.');
 writeln('Kreslenie:');
 writeln('ENTER-vodorovna ciara.');
 writeln('BACKSPACE-zvisla ciara.');
 writeln('Mazanie:');
 writeln('Cislo 1-vodorovne ciary.');
 writeln('Cislo 2-zvisle ciary.');
 writeln('Klaves M nakresli palicku: \.');
 writeln('Klaves N nakresli palicku: /.');
 writeln('Klaves X maze palicku: \.');
 writeln('Klaves Z maze palicku: /.');
 v:=readkey;
end;
begin
 repeat;
 clrscr;
 textbackground(green);
 textcolor(15);
 gotoxy(25,5);write('     Hlavne MENU:     ');
 gotoxy(25,6);write('       1.Start        ');
 gotoxy(25,7);write('     2.Instrukcie     ');
 gotoxy(25,8);write('         ***          ');
 v:=readkey;
 textbackground(0);
  if v='2' then inst;
 until (v='1');
  if v='1' then begin;
  x:=100;y:=200;
  gd:=detect;initgraph(gd,gm, '');
  settextstyle(1,0,7);
  outtextxy(10,1,'Slavomir Hudak');
  delay(600);
  setcolor(blue);
  outtextxy(10,200,'present...');
  delay(100);
  sound(200);delay(550);
  sound(300);delay(550);
  sound(400);delay(550);
  sound(350);delay(450);
  sound(300);delay(450);
  sound(250);delay(450);
  sound(200);delay(450);
  sound(150);delay(450);
  sound(100);delay(450);
  sound(50);delay(450);
  sound(0);delay(400);
  nosound;
  delay(700);
  setcolor(14);
  cleardevice;
  settextstyle(2,0,7);
  outtextxy(1,1,'Jeden z prvych najlepsich GRAFICKYCH programov pre PC:');
  delay(200);
  settextstyle(1,0,7);
  outtextxy(1,200,'Projekt  ver. 1.0');
  delay(200);
  cleardevice;
  outtextxy(65,250,'*** Loading ***');
  delay(100);
  settextstyle(0,0,0);
  setcolor(15);
  cleardevice;
  outtextxy(1,450,'Stlac lubovolnu klavesu,ked chces skoncit kreslenie hviezd.');
  outtextxy(1,460,'Okrem klavesy Enter,BackSpace,znaku M a N.');
  randomize;
  repeat
  xh:=random(640);yh:=random(480);
  line(xh,yh,xh,yh);
  delay(200);
  h:=h+1;
  until (keypressed);
  setcolor(white);
   if (v=#13) then begin
   line(1,1,400,400);
  end;
  outtextxy(1,1,'Znak ESC znamena KONIEC.');
  outtextxy(1,10,'Enter-palicka vodorovne.Mazanie-klaves 1.');
  outtextxy(1,20,'Medzera-palicka zvisle.Mazanie-klaves 2.');
  outtextxy(1,30,'Znak N-palicka /.Mazanie-klaves Z.');
  outtextxy(1,40,'Znak M-palicka \.Mazanie-klaves X.');
  setlinestyle(5,5,5);
  repeat;
   setcolor(14);
    if (v=#13) then begin
     line(x+2,y+2,x+20,y+2);
    end;
     if (v=#32) then begin
     line(x+2,y+2,x+2,y+20);
    end;
    if (v=#110) then begin
     line(x+1,y+1,x+20,y-18);
    end;
     if (v=#109) then begin
     line(x+1,y+1,x-17,y-17);
    end;
    setcolor(0);
    if (v=#49) then begin
     line(x+2,y+2,x+20,y+2);
    end;
    if (v=#50) then begin
    line(x+2,y+2,x+2,y+20);
   end;
    if (v=#122) then begin
     line(x+1,y+1,x+20,y-18);
    end;
     if (v=#120) then begin
     line(x+1,y+1,x-17,y-17);
    end;
  v:=readkey;
   if (v=#0) then begin
   v:=readkey;
   setcolor(0);
   line(x+5,y+5,x+5,y+10);
    if (v='K') then x:=x-20;      {KMHP}
    if (v='M') then x:=x+20;
    if (v='H') then y:=y-20;
    if (v='P') then y:=y+20;
   setcolor(2);
   line(x+5,y+5,x+5,y+10);
   repeat until keypressed;
  end;
 until (v=#27);
 closegraph;
 end;
end.