Program ako náhrada skicára vo windows pre prostredie DOSu

{ SKICAR.PAS                                                        }
{ Program ako nahrada skicara vo windows pre prostredie DOSu.       }
{                                                                   }
{ Author: (c) Milan Martiniak                                       }
{ Datum: 18.10.2006                           http://www.trsek.com  }
 
program skicar;
uses crt,dos,graph;
 
type sub=file of word;
     Ma=array[1..100,1..75] of word;
 
 
{***********************Inicializacne proc**************************}
function inicializuj:boolean;
Var driver, mode, code:Integer;
 Begin
   driver:=detect;
   initgraph(driver,mode,'');
   code:=GraphResult;
   If code=grok then begin
                       inicializuj:=true;
                     end
                Else Begin
                       WriteLn('Chyba grafiky:',GraphErrorMsg(code));
                       ReadLn;
                       inicializuj:=false;
                     End;
 End;
 
 
function gminit:boolean;
var reg:registers;
    but:integer;
begin
 reg.ax:=$0000;
 intr($33,reg);
 if reg.ax=$0000 then
  begin
    writeln('Pravdepodobne bude problem s mysou ');
    readln;gminit:=false;
  end
 else
  gminit:=true;
 
 but:=reg.bx;
end;
 
 
procedure zobrazmys;
 var reg:registers;
 begin
   reg.ax:=$0001;
   intr($33,reg);
 end;
 
 
procedure zhaskurzor;
 var reg:registers;
 begin
   reg.ax:=$0002;
   intr($33,reg);
 end;
 
 
procedure testmys(var x,y,but:integer);
var reg:registers;
begin
 reg.ax:=$0003;
 intr($33,reg);
 x:=reg.cx;
 y:=reg.dx;
 but:=reg.bx;
end;
 
 
function kde(x,y,VELK:integer):byte;
 begin
   kde:=20;
   if (x>25)and(x<100)and(y>70)and(y<170) then kde:=1;
   if (x>25)and(x<100)and(y>300)and(y<430) then kde:=2;
   if (x>122+velk)and(x<615)and(y>71+velk)and(y<431) then kde:=3;
   if (x>10)and(x<630)and(y>35)and(y<65) then kde:=4;  {y je posunute o 5 dole aby neblbly tie farby}
   if (x>10)and(x<630)and(y>20)and(y<35) then kde:=5;
   if (x>25)and(x<100)and(y>171)and(y<235) then kde:=6;
 end;
 
 
function hlaska(a,b:string):boolean;
 var x,y,but:integer;
    ano:boolean;z:char;
 begin
   ano:=false;    zhaskurzor;  z:='q';
   setfillstyle(1,8);bar(245,165,485,295);setlinestyle(0,0,2);
   setcolor(0);setfillstyle(1,7);
   bar3d(240,160,480,290,0,topon);
   setfillstyle(1,9);bar3d(240,160,480,175,0,topon);
   setfillstyle(1,4);bar3d(465,160,480,175,0,topon);
   setcolor(14);line(468,163,477,172);line(468,172,477,163);
   outtextxy(244,165,a);
   setcolor(0);outtextxy(245,210,b);
   setfillstyle(1,8);
   bar3d(305,245,350,265,0,topon); bar3d(375,245,420,265,0,topon);
   setcolor(15);outtextxy(318,252,'ANO');outtextxy(386,252,'NIE');zobrazmys;
   repeat
     testmys(x,y,but);
     if keypressed then z:=readkey;
     if (x>305)and(x<351)and(y>245)and(y<265)and(but=1) then begin hlaska:=true;ano:=true;end;
     if (x>375)and(x<420)and(y>245)and(y<265)and(but=1) then begin hlaska:=false;ano:=true; end;
     if (x>465)and(x<480)and(y>160)and(y<175)and(but=1) then begin hlaska:=false;ano:=true;end;
     if z=#27 then begin hlaska:=false; ano:=true;end;
     if z=#13 then begin hlaska:=true; ano:=true;end;
   until ano;
 end;
 
 
{*******************************************************************}
{***********procedura na vypisovanie textu na obrazovku*************}
{*******************************************************************}
procedure pis(x,y:integer;var a:string;b:string);
 var z:char;
     f,vz,sz:word;
 begin
   a:=b;
   sz:=textwidth('A');
   outtextxy(x,y,b);
   x:=x+length(b)*sz;
   repeat
     outtextxy(x,y,'_');
     vz:=textheight(z);
     sz:=textwidth(z);
     f:=getpixel(x+sz,y+round(vz/2));
     setfillstyle(1,f);
     z:=readkey;
     bar(x,y,x+textwidth('_'),y+textheight('a'));
     if (ord(z) in [32..170])and(x<615-sz-4) then
        begin
          outtextxy(x,y,z);
          x:=x+sz;a:=a+z;
        end;
     if (ord(z)=8) and (length(a)>0) then
        begin
          a[0]:=char(length(a)-1);
          bar(x-sz,y,x,y+vz);
          x:=x-sz;
        end;
     if z=#27 then a:='';
   until (z=#13)or(z=#27);
 end;
 
 
{*******************************************************************}
{*************************Subory/adresare***************************}
{*******************************************************************}
function skusksub(nazov:string):boolean;
 var a:file;
 begin
   {$I-}
   assign(a,nazov); reset(a);
   if ioresult=0 then begin skusksub:=true; close(a); end
                 else skusksub:=false;
   {$I+}
 end;
 
 
function skuskadres(nazov:string):boolean;
 begin
   {$I-}
   chdir(nazov);
   if ioresult=0 then skuskadres:=true
                 else skuskadres:=false;
   {$I+}
 end;
 
 
procedure ulozsub(a:string);
 var i,j:integer;
     s:sub;
     f:word;
 begin
   zhaskurzor;
   assign(s,a);
   rewrite(s);
   for i:=120 to 615 do
       for j:=70to 430 do
           begin
             f:=getpixel(i,j);
             write(s,f);
           end;
   close(s);zobrazmys;
 end;
 
 
procedure vykreslio(a:string);
 var i,j:integer;
     s:sub;
     f:word;
 begin
   zhaskurzor;
   if skusksub(a) then
      begin
        assign(s,a); reset(s);
        for i:=120 to 615 do
            for j:=70 to 430 do
                begin
                  read(s,f);
                  putpixel(i,j,f);
                end;
        close(s);
      end;
   zobrazmys;
 end;
 
 
procedure vadresary;
  var Sr:SearchRec;
      i,kde:integer;
      z:byte;
  begin
    FindFirst('*.mmp',AnyFile,Sr);
    i:=0;
    z:=textheight('A')+2;
    kde:=145;setcolor(8);
    While DosError = 0 do
      Begin
        outtextxy(233,kde,sr.name);
        FindNext(Sr);
        kde:=kde+z;
        i:=i+1;
        if i=15 then begin
                       readln;
                       setfillstyle(1,3);bar(230,140,450,300);
                       kde:=145;
                     end;
     End;
  end;
 
 
{*******************************************************************}
{**********************Ukladanie/otvaranie**************************}
{*******************************************************************}
procedure okno;
  begin
    setfillstyle(1,8);bar(225,125,520,355);
    setfillstyle(1,7);setcolor(0);setlinestyle(0,0,1);
    bar3d(220,120,515,350,0,topoff);setfillstyle(1,9);
    bar3d(220,120,515,135,0,topoff);
    setfillstyle(1,4);bar3d(500,120,515,135,0,topoff);
    setcolor(14); line(502,122,512,132);line(502,132,512,122);
    setfillstyle(1,3);bar(230,140,450,300);bar(230,320,450,340);
    setcolor(0);setfillstyle(1,8);
    bar3d(455,320,508,340,1,topon);bar3d(455,140,508,160,1,topon);
    setcolor(15);outtextxy(462,147,'SUBOR');setlinestyle(0,0,0);
    outtextxy(233,310,'Nezadavajte priponu!!!');
  end;
 
 
procedure subor;
 var na:string;
     ano,je:boolean;
     x,y,but,size:integer;
     pom,sk:sub;
     f:word;
     adr:string;
     ulo:pointer;
     z:char;
 begin zhaskurzor;
   setfillstyle(1,7);setcolor(0); setlinestyle(0,0,1);
   bar3d(225,190,510,250,0,topoff);
   setfillstyle(1,9);
   bar3d(225,190,510,205,0,topoff);
   setfillstyle(1,4);bar3d(495,190,510,205,0,topoff);
   setcolor(14);line(498,194,506,202);line(498,202,506,194);
   outtextxy(228,194,'Otvorit adresar');
   setlinestyle(0,0,1);setfillstyle(1,8);setcolor(0);
   bar3d(460,220,500,235,1,topon);
   outtextxy(230,210,'Zadajte cestu k suborom:');
   setfillstyle(1,2); bar(230,220,450,235);
   setcolor(15);outtextxy(473,225,'OK');
   getdir(0,adr); outtextxy(230,240,adr);setcolor(15);
   pis(230,225,na,adr);ano:=false;
   zobrazmys;
 
   repeat
     z:='q';
     if keypressed then z:=readkey;
     testmys(x,y,but);
     if (x>230)and(x<450)and(y>220)and(y<235)and(but=1) then
        begin
          zhaskurzor;
          setfillstyle(1,2); bar(230,220,450,235);
          pis(230,225,na,adr);zobrazmys;
        end;
     if (x>230)and(x<450)and(y>220)and(y<235)and(but=2) then
        begin
          zhaskurzor;
          setfillstyle(1,2); bar(230,220,450,235);
          pis(230,225,na,'');zobrazmys;
        end;
     if (x>495)and(x<509)and(y>191)and(y<205)and(but=1) then ano:=true;
     if (x>460)and(x<500)and(y>220)and(y<235)and(but=1) then
        begin
          if skuskadres(na) then begin chdir(na); ano:=true;end
                            else begin
                                   zhaskurzor;
                                   size:=imagesize(240,160,485,295);
                                   getmem(ulo,size);getimage(240,160,485,295,ulo^);
                                   zobrazmys;
                                   je:=hlaska('Adresar neexistuje!!!','   Prajete si ho vytvorit?');
                                   zhaskurzor;
                                   if je then begin mkdir(na);chdir(na);ano:=true; end
                                         else putimage(240,160,ulo^,normalput);
                                   freemem(ulo,size);
                                   zobrazmys;
                                 end;
 
        end;
     if z=#27 then ano:=true;
   until ano;
 
 end;
 
 
procedure otvor;
 var x,y,but,size:integer;
     na:string;
     ano,je:boolean;
     poin,ulo:pointer;
     z:char;
 begin
   zhaskurzor; size:=imagesize(215,115,520,355);
   getmem(poin,size);
   getimage(215,115,520,355,poin^); okno;
   setcolor(14); outtextxy(224,124,'Otvorit obrazok');
   setcolor(15); outtextxy(462,327,'OTVOR');
   vadresary; pis(233,325,na,''); na:=na+'.mmp';
   zobrazmys; ano:=false; z:='q';
   repeat z:='q';
     testmys(x,y,but);
     if (x>500)and(x<514)and(y>121)and(y<134)and(but=1) then
        begin
          zhaskurzor;
          putimage(215,115,poin^,normalput);
          ano:=true; zobrazmys;
        end;
     if keypressed then z:=readkey;
     if z=#27 then
        begin
          zhaskurzor;
          putimage(215,115,poin^,normalput);
          ano:=true; zobrazmys;
        end;
     if ((x>455)and(x<508)and(y>320)and(y<340)and(but=1))or(z=#13) then
        begin
          if skusksub(na) then
             begin
               setcolor(15);outtextxy(270,465,'Obrazok sa otvara');
               vykreslio(na);
               ano:=true;
               setfillstyle(1,1);bar(70,23,180,34); setcolor(14);
               outtextxy(75,25,na);
               setfillstyle(1,0);bar(269,465,450,480);
             end
            else
             begin
               zhaskurzor;
               size:=imagesize(240,160,485,295);
               getmem(ulo,size);getimage(240,160,485,295,ulo^);
               zobrazmys;
               je:=hlaska('V adresary sa nenachadza!!!','  Prajete si zmenit adresar?');
               if je then begin
                            zhaskurzor;
                            putimage(240,160,ulo^,normalput);zobrazmys;
                            subor;zhaskurzor;
                            okno;vadresary;
                            setcolor(15);
                            outtextxy(462,327,'OTVOR');
                            setcolor(14);outtextxy(224,124,'Otvorit obrazok');
                            pis(233,325,na,'');
                            na:=na+'.mmp';zobrazmys;
                          end
                     else begin
                            ano:=true;zhaskurzor;
                            putimage(215,115,poin^,normalput);;
                            zobrazmys;
                          end;
               freemem(ulo,size);
             end;
        end;
     if (x>230)and(x<450)and(y>320)and(y<340)and(but=1) then
        begin
          zhaskurzor;
          setfillstyle(1,3);bar(230,320,450,340);
          pis(233,325,na,'');zobrazmys;na:=na+'.mmp';
        end;
     if ((x>455)and(X<508)and(y>140)and(y<160)and(but=1))or(z='s') then
        begin
          subor;zhaskurzor;
          okno;vadresary;
          setcolor(15);
          outtextxy(462,327,'OTVOR');
          setcolor(14);outtextxy(224,124,'Otvorit obrazok');
          pis(233,325,na,'');
          na:=na+'.mmp';zobrazmys;
        end;
   until ano;
   freemem(poin,size);
 end;
 
 
procedure uloz;
 var
 x,y,but,i,size:integer;
 na,s:string;
 ano:boolean;
 poin:pointer;
 c,z:char;
 begin
   zhaskurzor;size:=imagesize(215,115,520,355);
   getmem(poin,size);z:='q';
   getimage(215,115,520,355,poin^);
   okno;vadresary;
   setcolor(14);outtextxy(224,124,'Ulozit obrazok');
   setcolor(15);outtextxy(465,327,'ULOZ');
   pis(233,325,na,'');
   zobrazmys;ano:=false;
   repeat z:='q';
     testmys(x,y,but);
     if (x>500)and(x<514)and(y>121)and(y<134)and(but=1) then
        begin
          zhaskurzor;
          putimage(215,115,poin^,normalput);
          ano:=true; zobrazmys;
        end;
     if keypressed then z:=readkey;
     if z=#27 then
        begin
          zhaskurzor;
          putimage(215,115,poin^,normalput);
          ano:=true; zobrazmys;
        end;
     if (x>230)and(x<450)and(y>320)and(y<340)and(but=1) then
        begin
          zhaskurzor;
          setfillstyle(1,3);bar(230,320,450,340);
          pis(233,325,na,'');zobrazmys;
        end;
     if ((x>455)and(x<508)and(y>320)and(y<340)and(but=1))or(z=#13) then
        begin
          if not skusksub(na+'.mmp') then
             begin         na:=na+'.mmp';
               zhaskurzor;
               setcolor(15);outtextxy(225,0,'Obrazok sa uklada');
               getdir(0,s);s:=s+'\'+na;outtextxy(225,10,s);
               putimage(215,115,poin^,normalput);zobrazmys;
               ulozsub(na);  ano:=true; setfillstyle(1,0);
               bar(224,0,500,18);
             end
            else
             begin
               if hlaska('Subor uz existuje','  Prajete si ho prepisat?') then
                  begin    na:=na+'.mmp';
                    zhaskurzor;
                    setcolor(15);outtextxy(225,0,'Obrazok sa uklada');
                    getdir(0,s);s:=s+'\'+na;outtextxy(225,10,s);
                    putimage(215,115,poin^,normalput);zobrazmys;
                    ulozsub(na);  ano:=true; setfillstyle(1,0);
                    bar(224,0,500,18);
                  end
                 else
                  begin
                    i:=1;
                    repeat
                      case i of
                           1:c:='1';2:c:='2';
                           3:c:='3';4:c:='4';
                           5:c:='5';6:c:='6';
                           7:c:='7';8:c:='8';
                           9:c:='9';
                      end;
                      na:=na+c;
                      i:=i+1;
                    until not skusksub(na);
                    zhaskurzor;na:=na+'.mmp';
                    setcolor(15);outtextxy(225,0,'Obrazok sa uklada');
                    getdir(0,s);s:=s+'\'+na;outtextxy(225,10,s);
                    putimage(215,115,poin^,normalput);zobrazmys;
                    ulozsub(na);  ano:=true; setfillstyle(1,0);
                    bar(224,0,500,18);
                  end;
             end;
        end;
     if ((x>455)and(X<508)and(y>140)and(y<160)and(but=1))or(z='s') then
        begin
          subor;zhaskurzor;
          okno;vadresary;
          setcolor(15);
          outtextxy(462,327,'ULOZ');
          setcolor(14);outtextxy(224,124,'Ulozit obrazok');
          pis(233,325,na,'');
          zobrazmys;
        end;
   until ano;
   freemem(poin,size);
 end;
 
 
{*******************************************************************}
{*************************Okna/listy/menu...************************}
{*******************************************************************}
procedure nastroje;
 procedure tex;
  begin
    setcolor(15);
  end;
 
 
 procedure ciar;
  begin
    setcolor(8)
  end;
 begin
   setfillstyle(1,7);ciar; setlinestyle(0,1,3);
   bar3d(24,70,100,236,3,topon);
   ciar;setlinestyle(0,1,1);bar3d(25,71,62,91,0,topoff);tex;
   outtextxy(27,78,'Pero');ciar; bar3d(62,71,99,91,0,topoff);
   tex;outtextxy(64,78,'Stet');ciar; bar3d(25,91,62,111,0,topoff);
   tex;outtextxy(27,98,'Guma');ciar;bar3d(62,91,99,111,0,topoff);
   tex;outtextxy(64,98,'Vypl');ciar;bar3d(25,111,62,131,0,topoff);
   tex;line(27,126,58,113);ciar;bar3d(62,111,99,131,0,topoff);
   tex;circle(80,121,6);ciar;bar3d(25,131,62,151,0,topoff);
   tex;bar3d(30,135,56,147,0,topoff);ciar;bar3d(62,131,99,151,0,topoff);
   tex;outtextxy(64,138,'Spre');ciar;bar3d(25,151,62,171,0,topoff);
   tex;outtextxy(27,158,'Kvap');ciar;bar3d(62,151,99,171,0,topoff);
   tex;outtextxy(64,158,'Text');ciar;bar3d(25,171,99,186,0,topoff);
   ciar; bar3d(25,215,99,235,0,topoff);tex;outtextxy(46,222,'Lupa');
   setfillstyle(1,0);bar(50,178,52,180);tex;outtextxy(60,175,'2x');
   setfillstyle(1,7);ciar;bar3d(25,186,99,201,0,topoff);
   setfillstyle(1,0);bar(49,192,52,195);tex;outtextxy(60,190,'3x');
   setfillstyle(1,7);ciar;bar3d(25,201,99,216,0,topoff);
   setfillstyle(1,0);bar(48,206,52,210);tex;outtextxy(60,205,'4x');
 end;
 
 
procedure Upozorni(a:string);{ dokonci mas  to rozrobene }
 begin
   setfillstyle(1,7);setcolor(8);setlinestyle(0,1,3);
   bar3d(24,70,100,236,3,topon);
   setlinestyle(0,1,1);
   settextstyle(2,1,1);setcolor(red);outtextxy(60,100,' Na Zrusenie ');
   outtextxy(70,100,a);
 end;
 
 
procedure skic;
 begin
   setfillstyle(9,7);setcolor(7);bar3d(10,20,630,460,1,topon);
   setfillstyle(1,1);bar3d(11,21,629,35,1,topon);
   setfillstyle(1,4);bar3d(615,21,629,35,1,topon);
   setcolor(14);line(618,24,626,32);line(618,32,626,24);
   setfillstyle(1,15); outtextxy(14,25,'Skicar-Bez nazvu');
   setlinestyle(0,0,0);
   setfillstyle(1,7);setcolor(7);
   bar3d(11,35,629,50,1,topon);
   nastroje;
   setlinestyle(0,0,3); setfillstyle(1,7);setcolor(8);
   bar3d(24,300,100,430,3,topon);setfillstyle(1,0);
   bar3d(25,301,50,326,0,topoff);setfillstyle(1,1);bar3d(50,301,75,326,0,topoff);
   setfillstyle(1,2);bar3d(75,301,100,326,0,topoff);
   setfillstyle(1,3);bar3d(25,326,50,352,0,topoff);
   setfillstyle(1,4);bar3d(50,326,75,352,0,topoff);
   setfillstyle(1,5);bar3d(75,326,100,352,0,topoff);
   setfillstyle(1,6);bar3d(25,352,50,378,0,topoff);
   setfillstyle(1,7);bar3d(50,352,75,378,0,topoff);
   setfillstyle(1,8);bar3d(75,352,100,378,0,topoff);
   setfillstyle(1,9);bar3d(25,378,50,404,0,topoff);
   setfillstyle(1,10);bar3d(50,378,75,404,0,topoff);
   setfillstyle(1,15);bar3d(75,378,100,404,0,topoff);
   setfillstyle(1,12);bar3d(25,404,50,430,0,topoff);
   setfillstyle(1,13);bar3d(50,404,75,430,0,topoff);
   setfillstyle(1,14);bar3d(75,404,100,430,0,topoff);
   setfillstyle(1,15);bar(120,70,615,430);
   setfillstyle(1,7);setcolor(7);setlinestyle(0,0,0);
   bar3d(11,35,629,50,1,topon);
   setcolor(0);bar3d(98,35,141,50,0,topoff);outtextxy(104,39,'ULOZ');
   bar3d(55,35,98,50,0,topoff);outtextxy(57,39,'OTVOR');
   bar3d(12,35,55,50,0,topoff);outtextxy(18,39,'NOVY');
   bar3d(141,35,184,50,0,topoff);outtextxy(147,39,'HELP')
 end;
 
 
procedure Help;
 procedure Okno;
  begin
    setcolor(8);setfillstyle(1,8);
    setlinestyle(0,0,1);
    bar(185,80,550,420);
    setcolor(0);setfillstyle(1,7);
    bar3d(180,75,545,415,0,topoff);
    setfillstyle(1,1);
    bar3d(180,75,545,90,0,topoff);setfillstyle(1,4);
    bar3d(530,75,545,90,0,topoff);setcolor(14);
    line(533,78,542,87);line(533,87,542,78);
  end;
 var ul:pointer;
     size:integer;
     help:text;
     ret:string[30];
 begin
   zhaskurzor;
   size:=imagesize(180,75,550,420);
   getmem(ul,size);
   getimage(180,75,550,420,ul^);zobrazmys;
   okno;
   assign(help,'help.txt');reset(help);setcolor(0);
   read(help,ret);outtextxy(190,95,ret);
   readln;
   zhaskurzor;                          close(help);
   putimage(180,75,ul^,normalput);
   freemem(ul,size);zobrazmys;
 end;
 
 
procedure lista(x,y,but:integer);
 var farb:word;
     akt:boolean;i,j:integer;
 procedure nov(akt:boolean);
  begin
    if akt then begin farb:=15; setfillstyle(0,1); end
           else begin farb:=0;  setfillstyle(1,7); end;
  setcolor(0);bar3d(12,35,55,50,0,topoff);
  setcolor(farb);outtextxy(18,39,'NOVY');
  end;
 
 
 procedure ot(akt:boolean);
  begin
    if akt then begin farb:=15; setfillstyle(0,1); end
           else begin farb:=0;  setfillstyle(1,7); end;
    setcolor(0);bar3d(55,35,98,50,0,topoff);
    setcolor(farb);outtextxy(57,39,'OTVOR');
  end;
 
 
 procedure ul(akt:boolean);
  begin
    if akt then begin farb:=15; setfillstyle(0,1); end
           else begin farb:=0;  setfillstyle(1,7); end;
    setcolor(0);bar3d(98,35,141,50,0,topoff);
    setcolor(farb);outtextxy(104,39,'ULOZ')
  end;
 
 
 procedure hl(akt:boolean);
  begin
    if akt then begin farb:=15; setfillstyle(0,1); end
           else begin farb:=0;  setfillstyle(1,7); end;
    setcolor(0);bar3d(141,35,184,50,0,topoff);
    setcolor(farb);outtextxy(147,39,'HELP')
  end;
 begin
   setlinestyle(0,0,0);
   nov(false);ot(false);ul(false);hl(false);
   if (x>12)and(x<54)and(y>36)and(y<49) then
    begin
      nov(true);
      if but=1then
       begin
         setfillstyle(1,15);zhaskurzor;
         bar(120,70,615,430);zobrazmys;
         setfillstyle(1,1);bar(70,23,180,34); setcolor(14);
         outtextxy(75,25,'Bez nazvu');
       end;
    end;
 
   if (x>56)and(x<98)and(y>36)and(y<49) then
    begin
      ot(true);
      if but=1 then otvor;
    end;
 
   if (x>100)and(x<138)and(y>36)and(y<49)then
    begin
      ul(true);
      if but=1 then uloz;
    end;
 
   if (x>140)and(x<184)and(y>36)and(y<49)then
    begin
      hl(true);
      if but=1 then help;
    end;
 end;
 
 
procedure aktfarb(farb:word);
 begin
   setlinestyle(0,0,3);setcolor(8);
   setfillstyle(1,farb);bar3d(33,260,93,285,0,topon);
   setlinestyle(0,0,0);
 end;
 
 
function farba(x,y,but:integer;farb:word):word;
 begin
   if but=1 then begin
      if (x>25)and(x<50)and(y>301)and(y<326) then farba:=0;
      if (x>50)and(x<75)and(y>301)and(y<326) then farba:=1;
      if (x>75)and(x<100)and(y>301)and(y<326) then farba:=2;
      if (x>25)and(x<50)and(y>326)and(y<352) then farba:=3;
      if (x>50)and(x<75)and(y>326)and(y<352) then farba:=4;
      if (x>75)and(x<100)and(y>326)and(y<352) then farba:=5;
      if (x>25)and(x<50)and(y>352)and(y<378) then farba:=6;
      if (x>50)and(x<75)and(y>352)and(y<378) then farba:=7;
      if (x>75)and(x<100)and(y>352)and(y<378) then farba:=8;
      if (x>25)and(x<50)and(y>378)and(y<404) then farba:=9;
      if (x>50)and(x<75)and(y>378)and(y<404) then farba:=10;
      if (x>75)and(x<100)and(y>378)and(y<404) then farba:=15;
      if (x>25)and(x<50)and(y>404)and(y<430) then farba:=12;
      if (x>50)and(x<75)and(y>404)and(y<430) then farba:=13;
      if (x>75)and(x<100)and(y>404)and(y<430) then farba:=14;
      aktfarb(farb)
    end
   else farba:=farb;
 end;
 
 
procedure aktnast(nast:byte);
 var pom:string;
 begin
   case nast of
        1:pom:='pero';
        2:pom:='stetec';
        3:pom:='guma';
        4:pom:='vypln';
        5:pom:='ciara';
        6:pom:='kruh';
        7:pom:='stvorec';
        8:pom:='sprej';
        9:pom:='kvapkadlo';
        10:pom:='text';
   end;
   setfillstyle(9,7);  setcolor(15);
   bar(25,240,105,255);outtextxy(33,244,pom);
   setfillstyle(1,7);
 end;
 
 
function nastroj(x,y,but,nast:integer):byte;
 procedure per(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(25,71,62,91,0,topoff);
    setcolor(15);outtextxy(27,78,'Pero');
  end;
  procedure stet(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(62,71,99,91,0,topoff);
    setcolor(15);outtextxy(64,78,'Stet');
  end;
  procedure gum(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(25,91,62,111,0,topoff);
    setcolor(15);outtextxy(27,98,'Guma');
  end;
  procedure vyl(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(62,91,99,111,0,topoff);
    setcolor(15);outtextxy(64,98,'Vypl');
  end;
  procedure ciar(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(25,111,62,131,0,topoff);
    setcolor(15);line(27,126,58,113);
  end;
  procedure kru(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(62,111,99,131,0,topoff);
    setcolor(15);circle(80,121,6);
  end;
  procedure stv(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(25,131,62,151,0,topoff);
    setcolor(15);bar3d(30,135,56,147,0,topoff);
  end;
  procedure spr(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(62,131,99,151,0,topoff);
    setcolor(15);outtextxy(64,138,'Spre');
  end;
  procedure kva(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(25,151,62,171,0,topoff);
    setcolor(15);outtextxy(27,158,'Kvap');
  end;
 
  procedure tex(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);bar3d(62,151,99,171,0,topoff);
    setcolor(15);outtextxy(64,158,'Text');
  end;
 
 
procedure vsetko;
 begin
   setcolor(8);setlinestyle(0,0,3);setfillstyle(1,7);
   setlinestyle(0,0,0);
   setcolor(15);per(false);stet(false);gum(false);vyl(false);
   ciar(false);kru(false);stv(false);kva(false);spr(false);
   tex(false);aktnast(nast);
 end;
 begin
   nastroj:=nast;
   if (x>25)and(x<62)and(y>71)and(y<91)and(but=1) then
    begin
      zhaskurzor;
      vsetko;
      per(true);
      nastroj:=1;
      zobrazmys;
    end;
 
   if (x>62)and(x<99)and(y>71)and(y<91)and(but=1) then
    begin
      zhaskurzor;
      vsetko;
      stet(true);
      nastroj:=2;
      zobrazmys;
    end;
 
   if (x>25)and(x<62)and(y>91)and(y<111)and(but=1) then
    begin
      zhaskurzor;
      vsetko;
      gum(true);
      nastroj:=3;
      zobrazmys;
    end;
 
   if (x>62)and(x<99)and(y>91)and(y<111)and(but=1) then
    begin
      zhaskurzor;
      vsetko;
      vyl(true);
      nastroj:=4;
      zobrazmys;
    end;
 
   if (x>25)and(x<62)and(y>111)and(y<131)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       ciar(true);
       nastroj:=5;
       zobrazmys;
    end;
 
   if (x>62)and(x<99)and(y>111)and(y<131)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       kru(true);
       nastroj:=6;
       zobrazmys;
    end;
 
   if (x>25)and(x<62)and(y>131)and(y<151)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       stv(true);
       nastroj:=7;
       zobrazmys;
    end;
 
   if (x>62)and(x<99)and(y>131)and(y<151)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       spr(true);
       nastroj:=8;
       zobrazmys;
    end;
 
   if (x>25)and(x<62)and(y>151)and(y<171)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       kva(true);
       nastroj:=9;
       zobrazmys;
    end;
 
   if (x>62)and(x<99)and(y>151)and(y<171)and(but=1) then
    begin
       zhaskurzor;
       vsetko;
       tex(true);
       nastroj:=10;
       zobrazmys;
    end;
 end;
 
 
procedure lupa(farb:word);
 var ul1,ul2:pointer;
     i,j,i1,j1,but,size1,size2,x1,x2,y1,y2,x,y:integer;
     mat:ma;
     z:char;
     ano:boolean;
 begin
   zobrazmys;  ano:=false;
   repeat
     testmys(x,y,but);
     if but=1
        then begin
               if (x>170)and(x<566)and(y>106)and(y<394) then
                  begin
                    x1:=x-50;x2:=x+49;
                    y1:=y-36;y2:=y+36;
                  end;
               if (x<170)and(y>106)and(y<394) then
                  begin
                    y1:=y-36;y2:=y+36;
                    x1:=120;x2:=219;
                  end;
                if (x>170)and(x<566)and(y<106) then
                   begin
                     x1:=x-50;x2:=x+49;
                     y1:=70;y2:=142;
                   end;
                if (x<170)and(y<106) then
                   begin
                     x1:=120;x2:=219;
                     y1:=70;y2:=142;
                   end;
                if (x>566)and(y>106)and(y<394) then
                   begin
                     y1:=y-36;y2:=y+36;
                     x1:=516;x2:=615;
                   end;
                if (x>170)and(x<566)and(y>394) then
                   begin
                     x1:=x-50;x2:=x+49;
                     y1:=358;y2:=430;
                   end;
                if (x>566)and(y>394) then
                   begin
                     x1:=516;x2:=615;
                     y1:=358;y2:=430;
                   end;
                if (x>566)and(y<106) then
                   begin
                     x1:=516;x2:=615;
                     y1:=70;y2:=142;
                   end;
                if (x<170)and(y>394) then
                   begin
                     x1:=120;x2:=219;
                     y1:=358;y2:=430;
                   end;
               i:=kde(x,y,but);
               if i<>6 then ano:=true;
             end;
 
   until ano;
 
   zhaskurzor;
   i:=kde(x,y,but);
   if i=3  then
     begin
      i1:=1;j1:=1;
      size1:=imagesize(120,70,350,430);
      size2:=imagesize(350,70,615,430);
      getmem(ul1,size1);
      getmem(ul2,size2);
      getimage(120,70,350,430,ul1^);
      getimage(350,70,615,430,ul2^);
      i:=x1;j:=y1;
      repeat
        repeat
          mat[i1,j1]:=getpixel(i,j);
          j1:=j1+1;
          j:=j+1;
        until j=y2;
        i1:=i1+1;j1:=1;j:=y1;
        i:=i+1;
      until i=x2;
      i:=120;
      j:=70;setcolor(black);i1:=1;j1:=1;
      repeat
        repeat
          setfillstyle(1,mat[i1,j1]);
          bar3d(i,j,i+5,j+5,0,topoff);
          j:=j+5;j1:=j1+1;
        until j>425;
        i:=i+5;i1:=i1+1;
        j:=70;j1:=1;
      until i>610;
      upozorni('Stlac ESC  ');
      setcolor(black);
      setfillstyle(1,farb);
      zobrazmys; z:='v';
      repeat
        testmys(x,y,but);
        i:=kde(x,y,but);
        case i of
             3:if but=1 then
                  begin
                    i1:=120;j:=70;
                    x:=x-5;y:=y-5;
                    repeat
                      if i1<x then i1:=i1+5;
                      if j<y then j:=j+5;
                    until (i1>=x)and(j>=y);
                    zhaskurzor;
                    bar3d(i1,j,i1+5,j+5,0,topoff);
                    zobrazmys;
                  end;
             2:begin farb:=farba(x,y,but,farb);setcolor(black);end;
        end;
        if keypressed then z:=readkey;
      until z=#27;zhaskurzor;
      j1:=1;i1:=1;
      i:=122;j:=72;
      repeat
        repeat
          mat[i1,j1]:=getpixel(i,j);
          j:=j+5;j1:=j1+1;
        until j>427;
        i:=i+5;i1:=i1+1;
        j:=72;j1:=1;
      until i>612;
      setfillstyle(1,farb);
      setcolor(farb);
      putimAGE(120,70,ul1^,normalput);
      putimage(350,70,ul2^,normalput);
      freemem(ul1,size1);
      freemem(ul2,size2);
      i1:=1;j1:=1;
      for i:=x1 to x2-1 do
        begin
          for j:=y1 to y2-1 do
            begin
              putpixel(i,j,mat[i1,j1]);
              j1:=j1+1;
            end;
            j1:=1;i1:=i1+1;
        end;
   end;
 end;
 
 
function velkost(x,y,but,velk:integer;farb:word):byte;
 procedure x2(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);
    bar3d(25,171,99,186,0,topoff);
    setcolor(15);
    setfillstyle(1,0);
    bar(50,178,52,180);
    outtextxy(60,175,'2x');
  end;
 
  procedure x3(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);
    bar3d(25,186,99,201,0,topoff);
    setcolor(15);
    setfillstyle(1,0);
    bar(49,192,52,195);
    outtextxy(60,190,'3x');
  end;
 
  procedure x4(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);
    bar3d(25,201,99,216,0,topoff);
    setcolor(15);
    setfillstyle(1,0);
    bar(48,206,52,210);
    outtextxy(60,205,'4x');
  end;
 
  procedure lup(akt:boolean);
  begin
    if akt then setfillstyle(1,8)
           else setfillstyle(1,7);
    setcolor(8);
    bar3d(25,215,99,235,0,topoff);
    setcolor(15);
    outtextxy(46,222,'Lupa')
  end;
 
 procedure vsetko;
 begin
   setcolor(15);
   x2(false);
   x3(false);
   x4(false);
   lup(false);
 end;
 begin
  velkost:=velk;
  setlinestyle(0,0,1);
  if (x>25)and(x<99)and(y>171)and(y<186)and(but=1) then
   begin
     zhaskurzor;
     vsetko;
     x2(true);
     velkost:=2;
     zobrazmys;
    end;
 
  if (x>25)and(x<99)and(y>186)and(y<201)and(but=1) then
   begin
     zhaskurzor;
     vsetko;
     x3(true);
     velkost:=3;
     zobrazmys;
   end;
 
  if (x>25)and(x<99)and(y>201)and(y<216)and(but=1) then
   begin
     zhaskurzor;
     vsetko;
     x4(true);
     velkost:=4;
     zobrazmys;
   end;
 
  if (x>25)and(x<99)and(y>216)and(y<235)and(but=1) then
   begin
     zhaskurzor;
     vsetko;
     lup(true);
     lupa(farb);setfillstyle(1,farb);
     setcolor(farb);settextstyle(1,0,1);lup(false);
     nastroje;
     zobrazmys;
   end;
 end;
 
 
{*******************************************************************}
{*****************************Ostatne*******************************}
{*******************************************************************}
procedure sprej(xm,ym:integer;farb:word);
 begin
   putpixel(xm,ym-5,farb);
   putpixel(xm-2,ym-5,farb);
   putpixel(xm+2,ym-5,farb);
   putpixel(xm-5,ym-4,farb);
   putpixel(xm-2,ym-4,farb);
   putpixel(xm+2,ym-4,farb);
   putpixel(xm-2,ym+1,farb);
   putpixel(xm-1,ym-4,farb);
   putpixel(xm-2,ym-4,farb);
   putpixel(xm-2,ym-1,farb);
   putpixel(xm-2,ym-3,farb);
   putpixel(xm-2,ym-5,farb);
 end;
 
 
procedure cas(var min2:WORD);
 var hod,min,sec,sec100:word;
     Shod,Smin,ssmin:string;
 begin
   setfillstyle(1,0);
   gettime(hod,min,sec,sec100);
   if min<>min2 then
      begin
        bar(590,462,640,480);
        gettime(hod,min2,sec,sec100);
        str(hod,shod);str(min,smin);
        if min<10 then begin ssmin:='0'+smin;smin:=ssmin;end;
        setcolor(15);
        outtextxy(591,467,shod);
        outtextxy(607,467,':');
        outtextxy(615,467,smin);
      end;
 end;
 
 
{*******************************************************************}
{**************************Hlavny program***************************}
{*******************************************************************}
var xm,ym,but,sx,sy,pol1,pol2,pol,zna,size:integer;
    cor,velk,nastr:byte;
    tex:string;
    farb,min:word;
    koniec,koniecH,ano:boolean;
    ulo:pointer;
    pom:sub;
    z:char;
begin
  clrscr;
  if inicializuj and gminit
     then begin
            setrgbpalette(3,45,40,55);skic;
            zobrazmys;farb:=0;aktfarb(farb);
            nastr:=1;setcolor(15);aktnast(nastr);
            velk:=2;min:=69; outtextxy(480,467,'Aktualny cas:');
            outtextxy(10,465,'(c) Milan Martiniak');cas(min);
            vykreslio('logo.log');koniecH:=false;koniec:=false;
            repeat
              testmys(xm,ym,but);
              if (xm>529)and(xm<575)and(ym>266)and(ym<287)and(but=1) then
                 begin
                   zhaskurzor;setfillstyle(1,15);
                   bar(120,70,615,430);zobrazmys;
                 end;
            until but<>0;
            repeat cas(min);z:='q';
              testmys(xm,ym,but);cor:=kde(xm,ym,velk);
              setlinestyle(0,0,velk);
              setcolor(farb); setfillstyle(1,farb);
              if keypressed then begin
                                   z:=readkey;
                                   if z=#0 then z:=readkey;
                                 end;
              case z of
                   #59:lista(14,40,1);
                   #60:lista(110,40,1);
                   #61:lista(60,40,1);
                   #27:koniec:=true;
              end;
              case cor of
                   1:nastr:=nastroj(xm,ym,but,nastr);
                   2:farb:=farba(xm,ym,but,farb);
                   3:case nastr of
                          1:if but=1 then pieslice(xm-velk,ym-velk,0,360,velk);
                          2:if but=1 then bar(xm-velk-3,ym-velk-3,xm,ym);
                          3:begin
                              setfillstyle(1,15);
                              if but=1 then bar(xm-5,ym-5,xm+2,ym+2);
                              setfillstyle(1,farb);
                            end;
                          5:if but=1 then begin
                                            upozorni('Klikni Pravym');ano:=false;
                                            moveto(xm,ym);
                                            setcolor(farb); setfillstyle(1,farb);
                                            repeat
                                              testmys(xm,ym,but);
                                              cor:=kde(xm,ym,velk);
                                              if cor=3 then
                                                 begin
                                                   if but=1 then lineto(xm,ym);
                                                   if but=2 then ano:=true;
                                                 end;
                                            until ano;
                                            settextstyle(1,0,1);nastroje;
                                            setcolor(farb); setfillstyle(1,farb);
                                          end;
                          4:if but=1 then
                               begin
                                 zhaskurzor;
                                 setlinestyle(0,0,1);rectangle(120,70,615,430);
                                 floodfill(xm,ym,farb);zobrazmys;
                               end;
                          6:if but=1 then
                               begin
                                 ano:=false;zhaskurzor;
                                 testmys(sx,sy,but);
                                 upozorni('Klikni Pravym');
                                 setcolor(farb); setfillstyle(1,farb);
                                 repeat
                                   testmys(xm,ym,but);
                                   pol1:=abs(sx-xm);pol2:=abs(sy-ym);
                                   if pol1>pol2 then pol:=pol1
                                                else pol:=pol2;
                                   cor:=kde(xm,ym,but);
                                   if (cor=3)and(pol+sx<615)and(abs(pol-sx)>120)
                                      and(pol+sy<430)and(abs(pol-sy)>70)
                                      then pieslice(sx,sy,0,360,pol);
                                   if but=2 then ano:=true;
                                 until ano;
                                 settextstyle(1,0,1);
                                 nastroje;
                                 setcolor(farb); setfillstyle(1,farb);
                                 zobrazmys;
                               end;
                          7:if but=1 then
                               begin
                                 zhaskurzor;ano:=false;
                                 testmys(sx,sy,but);
                                 Upozorni('Klikni Pravym');
                                 setcolor(farb); setfillstyle(1,farb);
                                 repeat
                                   testmys(xm,ym,but);
                                   cor:=kde(xm,ym,but);
                                   if cor=3 then bar(sx,sy,xm,ym);
                                   if but=2 then ano:=true;
                                 until ano;
                                 settextstyle(1,0,1);
                                 nastroje;setcolor(farb); setfillstyle(1,farb);
                                 zobrazmys;
                               end;
                          8:if but=1 then sprej(xm,ym,farb);
                          9:if but=1 then begin farb:=getpixel(xm-1,ym-1);aktfarb(farb)end;
                          10:if but=1 then begin
                                             upozorni('Stlac Enter ');
                                             zhaskurzor;SETTEXTSTYLE(1,0,1);
                                             setcolor(farb); setfillstyle(1,farb);
                                             pis(xm,ym,tex,'');settextstyle(1,0,1);
                                             nastroje;zobrazmys;
                                             setcolor(farb); setfillstyle(1,farb);
                                           end;
                     end;
                   4:begin lista(xm,ym,but);delay(50);end;
                   5:if (xm>615)and(xm<629)and(but=1) then koniec:=true;
                   6:velk:=velkost(xm,ym,but,velk,farb);
                end;
                if koniec then
                   begin
                     zhaskurzor;
                     size:=imagesize(240,160,485,295);
                     getmem(ulo,size);getimage(240,160,485,295,ulo^);zobrazmys;
                     koniec:=hlaska('Koniec?','    Chcete ukoncit program?');
                     if koniec then begin koniecH:=true;freemem(ulo,size);end
                               else begin
                                      zhaskurzor;
                                      putimage(240,160,ulo^,normalput);
                                      freemem(ulo,size);
                                      zobrazmys;
                                    end;
                   end;
            until koniecH;
            closegraph;
          end;
 
end.