{ TRSEK.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Kniznica pouzivana skoro vsetkymi programami. } { Program POUZI.PAS demonstruje vsetky jej funkcie a procedury. } { } { Datum:24.10.1995 http://www.trsek.com } unit TRSEK; interface type win_poin = record { Kvoli oknam } zani : pointer; poradie : byte; xova : byte; yova : byte; x_vel : byte; y_vel : byte; old_x1 : byte; old_y1 : byte; old_x2 : byte; old_y2 : byte; znaky : pointer; farby : pointer; end; type byte_poin = record { Kvoli oknam } byt:array[1..2000] of byte; end; var ctrsek_b,ctrsek_f:byte; tdel:integer; { Pauza pri vytvarani okna} MinWin,MaxWin:integer; pom,win_pointer,wfirst_pointer:^win_poin; { Smerniky na okna } win_pocet:byte; { Udrzuje pocet okien } procedure KurzorZap(ZapVyp:boolean); procedure farba(x,y:integer); procedure set_insert(ins:boolean); function ctrl_akt:boolean; function alt_akt:boolean; function nothing(i:integer):string; function zarovnaj(text:string;i:integer):string; procedure save_win; procedure old_win; procedure writexy(x,y:integer;s:string); {function tread(x,y:integer; d:byte; text:string; sedy,pret:char):string;} function tread(x,y:integer; d:byte; text:string; sedy: char; var pret:char):string; procedure open_win(xl,yl,xp,yp:integer;text:string;ramt:byte); function otazka(x,y:integer;s1,s2,s3:string;color:byte;typ:byte):integer; procedure koniec(naz_prog,rok:string); procedure clear_keyb; function get_znak(x,y:byte;var farba:byte):byte; procedure put_znak(x,y,farba,znak:byte); procedure zarad_okno (var win_pointer:win_poin;x1,y1,x2,y2:byte); function get_window(x1,y1,x2,y2:integer):integer; function put_window(por:integer;xn1,yn1,xn2,yn2:integer):integer; function vyrad_okno (por:integer):integer; procedure rem_all_win; function treadkey:char; procedure priklad; procedure help(str:char); implementation uses crt,dos; procedure KurzorZap(ZapVyp:boolean); var Regs : Registers; begin with Regs do begin AH := $03; BH := $00; Intr($10,Regs); If not (Zapvyp) then CH := CH or $20 else CH := CH and $DF; AH := $01; Intr($10,Regs); end; end; procedure farba(x,y:integer); begin if x<>-1 then begin textbackground(x);ctrsek_b:=x;end; if y<>-1 then begin textcolor(y);ctrsek_f:=y;end; end; procedure set_insert(ins:boolean); var Reg:registers; begin Reg.AH:=$01; Reg.CL:=$1E; if ins then Reg.CH:=$1D else Reg.CH:=$01; Intr($10,Reg); end; function ctrl_akt:boolean; begin if (mem[0:$417] and 4) > 0 then ctrl_akt:=true else ctrl_akt:=false; end; function alt_akt:boolean; begin if (mem[0:$417] and 8) > 0 then alt_akt:=true else alt_akt:=false; end; function nothing(i:integer):string; const prazdny=' '; begin nothing:=copy(prazdny,1,i); end; function zarovnaj(text:string;i:integer):string; begin zarovnaj:=copy(text+nothing(i-length(text)),1,i); end; procedure save_win; begin MinWin:=WindMin;MaxWin:=WindMax; end; procedure old_win; begin window(Lo(MinWin)+1,Hi(MinWin)+1,Lo(MaxWin)+1,Hi(MaxWin)+1); end; procedure writexy(x,y:integer;s:string); begin gotoxy(x,y); write(s); end; function tread(x,y:integer; d:byte; text:string; sedy: char; var pret:char):string; var xp :integer; { Pozicia kurzora } kl :char; ins:boolean; von:boolean; pis:boolean; fir:boolean; old_text:string; begin farba(ctrsek_b,ctrsek_f);kurzorZap(true); ins:=true;set_insert(ins); kurzorZap(false); text:=zarovnaj(text,d); { Priprava !!! } if (x<1) then x:=1; if (y<1) then y:=1; if (x+d > Lo(WindMax)+1 ) then x:=Hi(WindMax)+1-d; if (y > Hi(WindMax)+1 ) then y:=Hi(WindMax)+1; xp:=1;x:=x-1;von:=false;pis:=true;fir:=true; if sedy<>#0 then sedy:=pret;old_text:=text; repeat if pis then begin KurzorZap(false); WriteXY(x+1,y,text); pis:=false; end; KurzorZap(true); gotoxy(x+xp,y); if fir then kl:=sedy else kl:=ReadKey; if ( kl=#0 ) then begin if fir then kl:=pret else kl:=ReadKey; case kl of #77:begin { sipka vpravo } xp:=xp+1; if (xp>d) then xp:=d; end; #75:begin { sipka vlavo } xp:=xp-1; if (xp<1) then xp:=1; end; #83:begin { DEL } delete(text,xp,1); text:=text+' '; pis:=true; end; #80:von:=true; { sipka dole } #72:von:=true; { sipka hore } #59:begin { F1-vrat text } text:=old_text; pis:=true; von:=true; end; #82:begin { Insert } ins:=not(ins); set_insert(ins); end; #71:xp:=1; { HOME } #79:begin { End } xp:=d; while ((xp>1) and (text[xp-1]=' ')) do dec(xp); end; end; { od CASE } end { od IF kl=#0 } else begin case kl of #27:von:=true; #13:von:=true; #08:if (xp>1) then begin delete(text,xp-1,1);text:=zarovnaj(text,d); pis:=true;dec(xp); end; else begin { ELSE ku CASE } if ins then begin insert(kl,text,xp); text:=zarovnaj(text,d); end else text[xp]:=kl; pis:=true;inc(xp); if (xp>d) then von:=true; end; { end od begin pri ELSE ku CASE } end; { od druheho CASE } end; { od ELSE } if fir then begin von:=false; fir:=false; end; until (von); pret:=kl; if (kl=#27) then tread:=old_text else tread:=text; end; procedure open_win(xl,yl,xp,yp:integer;text:string;ramt:byte); const typr:array[1..4,1..6] of char= (('','','','','',''), ('','','','','',''), ('','','','','',''), ('','','','','','')); var i,xs,ys:integer; p:real; begin xs:=(xp-xl) div 2; ys:=(yp-yl) div 2; KurzorZap(false); if (xs>ys) then begin for i:=1 to xs-ys do begin Window(xl+xs-i,yl+ys,xl+xs+i,yl+ys); delay(tdel); clrscr; end; for i:=xs-ys to xs do begin Window(xl+xs-i,yl+xs-i,xl+xs+i,yl+2*ys-xs+i); delay(tdel); clrscr; end; end else begin for i:=1 to ys-xs do begin Window(xl+xs,yl+ys-i,xl+xs,yl+ys+i); delay(tdel); clrscr; end; for i:=ys-xs to ys do begin Window(xl+ys-i,yl+ys-i,xl+2*xs-ys+i,yl+ys+i); delay(tdel); clrscr; end; end; Window(xl,yl,xp,yp); clrscr; Window(1,1,80,25); for i:=xl to xp do WriteXY(i,yl,typr[ramt,1]); WriteXY(xp,yl,typr[ramt,2]); for i:=yl+1 to yp do WriteXY(xp,i,typr[ramt,3]); WriteXY(xp,yp,typr[ramt,4]); for i:=xp-1 downto xl do WriteXY(i,yp,typr[ramt,1]); WriteXY(xl,yp,typr[ramt,5]); for i:=yp-1 downto yl do WriteXY(xl,i,typr[ramt,3]); WriteXY(xl,yl,typr[ramt,6]); if text<>'' then WriteXY(xl+xs-(length(text) div 2),yl,' '+text+' '); Window(xl+1,yl+1,xp-1,yp-1); end; function otazka(x,y:integer;s1,s2,s3:string;color:byte;typ:byte):integer; const otyp:array[0..3,1..2] of byte = ((26,27),(16,17),(62,60),(175,174)); var ch:char; s:array[1..3] of string; pk:array[1..2,0..2] of byte; { Pozicia kurzora } i,odel:integer; otat,otap:byte; begin { Urci typ uvodzoviek } otat:=(typ and 1)+(typ and 2);otap:=((typ and 4)+(typ and 8)) div 4; if (otap and 2)=2 then odel:=1 else odel:=5; { Z akych moznosti si ma vyberat a ich suradnice } s[1]:=s1;pk[2,0]:=0;pk[1,0]:=x; s[2]:=s2;pk[2,1]:=0;pk[1,1]:=x+length(s1)+odel; s[3]:=s3;pk[2,2]:=0;pk[1,2]:=x+length(s1)+length(s2)+2*odel; { Pre CRTL sekvenciu } for i:=length(s1) downto 1 do if UpCase(s1[i])=s1[i] then pk[2,0]:=ord(s1[i]); for i:=length(s2) downto 1 do if UpCase(s2[i])=s2[i] then pk[2,1]:=ord(s2[i]); for i:=length(s3) downto 1 do if UpCase(s3[i])=s3[i] then pk[2,2]:=ord(s3[i]); { Ma to byt spolu,a lebo ma mat rovnake medzery } if (otap and 1)=1 then begin i:=length(s1); if length(s2)>i then i:=length(s2); if length(s3)>i then i:=length(s3); pk[1,1]:=x+i+odel; pk[1,2]:=x+2*(i+odel); end; textbackground(ctrsek_b); WriteXY(pk[1,0],y,chr(otyp[otat,1])+s1+chr(otyp[otat,2])); if s2<>'' then WriteXY(pk[1,1],y,' '+s2+' '); if s3<>'' then WriteXY(pk[1,2],y,' '+s3+' '); i:=0; repeat textbackground(color); WriteXY(pk[1,i],y,chr(otyp[otat,1])+s[i+1]+chr(otyp[otat,2])); ch:=readkey; if ctrl_akt then begin { Stlacil CRTL } textbackground(ctrsek_b); WriteXY(pk[1,i],y,' '+s[i+1]+' '); textbackground(color); if Ord(ch)+64 = pk[2,0] then begin i:=0;ch:=#13;end; if Ord(ch)+64 = pk[2,1] then begin i:=1;ch:=#13;end; if Ord(ch)+64 = pk[2,2] then begin i:=2;ch:=#13;end; if ch=#13 then WriteXY(pk[1,i],y,chr(otyp[otat,1])+s[i+1]+chr(otyp[otat,2])); end; if ch=#0 then begin ch:=readkey; if ch=#77 then begin { Pohyb sipkami } textbackground(ctrsek_b);WriteXY(pk[1,i],y,' '+s[i+1]+' '); i:=i+1; if s[i+1]='' then i:=i-1; if i>2 then i:=2; end; if ch=#75 then begin textbackground(ctrsek_b);WriteXY(pk[1,i],y,' '+s[i+1]+' '); i:=i-1; if i<0 then i:=0; end; end; if ch=#27 then begin otazka:=0;exit;end; until (ch in [#13]); { Koniec } otazka:=i+1; end; procedure koniec(naz_prog,rok:string); begin farba(BLACK,-1); clrscr; farba(BLUE,YELLOW); writeln; writeln(zarovnaj(naz_prog,15)+ ' Software by TRSEK. All right reserved, copyright TRSEK (c) '+rok+'.'); end; procedure clear_keyb; var Reg:Registers; begin Reg.AX:=$C06; Reg.DL:=$FF; intr($21,Reg); end; function get_znak(x,y:byte;var farba:byte):byte; var reg:registers; xo,yo:integer; begin xo:=wherex;yo:=wherey; save_win; window(1,1,80,25); gotoxy(x,y); reg.ah:=8; reg.bh:=0; intr($10,reg); get_znak:=reg.al; farba:=reg.ah; old_win; gotoxy(xo,yo); end; procedure put_znak(x,y,farba,znak:byte); var reg:registers; xo,yo:integer; begin xo:=wherex;yo:=wherey; save_win; window(1,1,80,25); gotoxy(x,y); reg.ah:=$9; reg.bh:=0; reg.al:=znak; reg.bl:=farba; reg.cx:=1; intr($10,reg); old_win; gotoxy(xo,yo); end; procedure zarad_okno (var win_pointer:win_poin;x1,y1,x2,y2:byte); begin inc(win_pocet); win_pointer.poradie:=win_pocet; { Zapis poradie okna } win_pointer.xova:=x1; { Lavy horny roh x-ovej } win_pointer.yova:=y1; win_pointer.x_vel:=(x2-x1); { velkost okna } win_pointer.y_vel:=(y2-y1); win_pointer.old_x1:=Lo(WindMin)+1; { Lavy horny roh aktivneho } win_pointer.old_y1:=Hi(WindMin)+1; win_pointer.old_x2:=Lo(WindMax)+1; { Pravy dolny roh aktivneho } win_pointer.old_y2:=Hi(WindMax)+1; win_pointer.zani:=NIL; if wfirst_pointer=NIL then begin wfirst_pointer:=@win_pointer; end else begin pom:=wfirst_pointer; while (pom^.zani<>NIL) do pom:=pom^.zani; pom^.zani:=pointer(@win_pointer); end; end; function get_window(x1,y1,x2,y2:integer):integer; var x,y,i:integer; reg:registers; pom1,pom2:^byte_poin; velkost:word; begin save_win; get_window:=0; { Ziskaj pamet + 2b pred, 2b zani, 1b poradie okna } { 1b celkova sirka, 1b celkova vyska } velkost:= SizeOf( Win_poin ) + 2*(x2-x1+1)*(y2-y1+1); if velkost>MaxAvail then begin write('Malo pamete, k dispozicii iba ',MaxAvail,' B konvencnej pamete.'); exit; end; GetMem(win_pointer,SizeOf( Win_poin) ); { Rezervuj pamet pre smernik } GetMem(win_pointer^.znaky,(x2-x1+1)*(y2-y1+1) ); { Rezervuj pamet pre znaky } GetMem(win_pointer^.farby,(x2-x1+1)*(y2-y1+1) ); { Rezervuj pamet pre farby } zarad_okno(win_pointer^,x1,y1,x2,y2); pom1:=win_pointer^.znaky; pom2:=win_pointer^.farby; window(1,1,80,25); i:=0; for x:=x1 to x2 do for y:=y1 to y2 do begin gotoxy(x,y); reg.ah:=8; reg.bh:=0; intr($10,reg); inc(i); pom1^.byt[i]:=reg.ah; pom2^.byt[i]:=reg.al; end; old_win; get_window:=win_pocet; end; function put_window(por:integer;xn1,yn1,xn2,yn2:integer):integer; var x,y,i:integer; x1,x2,y1,y2:integer; reg:registers; pom1,pom2:^byte_poin; begin win_pointer:=wfirst_pointer; while ( (win_pointer^.zani<>NIL) and (win_pointer^.poradie<>por) ) do win_pointer:=win_pointer^.zani; if win_pointer^.poradie<>por then begin put_window:=1; exit; end; with win_pointer^ do begin x1:=xova; y1:=yova; x2:=x1+x_vel; y2:=y1+y_vel; pom1:=znaky; pom2:=farby; end; if xn1=0 then xn1:=x1; if yn1=0 then yn1:=y1; if xn2=0 then xn2:=80; if yn2=0 then yn2:=25; xn1:=xn1-x1; yn1:=yn1-y1; window(1,1,80,25); i:=0; for x:=x1 to x2 do for y:=y1 to y2 do begin gotoxy(x+xn1,y+yn1); reg.ah:=$9; reg.bh:=0; inc(i); reg.al:=pom2^.byt[i]; reg.bl:=pom1^.byt[i]; reg.cx:=1; if (y-y1<=yn2) and (x-x1<=xn2) then intr($10,reg); end; with win_pointer^ do window(old_x1,old_y1,old_x2,old_y2); put_window:=0; end; function vyrad_okno (por:integer):integer; var velkost:word; begin win_pointer:=wfirst_pointer; pom:=NIL; while ( (win_pointer^.zani<>NIL) and (win_pointer^.poradie<>por) ) do begin pom:=win_pointer; win_pointer:=win_pointer^.zani; end; if win_pointer^.poradie<>por then begin vyrad_okno:=0; exit; end; with win_pointer^ do begin if (pom<>NIL) then pom^.zani:=win_pointer^.zani else wfirst_pointer:=win_pointer^.zani; if (pom=NIL) and (win_pointer^.zani=NIL) then begin wfirst_pointer:=NIL; win_pocet:=0; end; velkost:=(x_vel+1)*(y_vel+1); end; FreeMem(win_pointer^.farby, velkost ); { Uvolni pamet pre znaky } FreeMem(win_pointer^.znaky, velkost ); { Uvolni pamet pre znaky } FreeMem(win_pointer,SizeOf( win_poin ) ); { Uvolni pamet pre smernik } vyrad_okno:=por; end; procedure rem_all_win; var i,err:integer; begin for i:=win_pocet downto 1 do err:=vyrad_okno(i); end; function treadkey:char; var ch,c:char; begin repeat ch:=readkey; if ch=#0 then c:=readkey; until (ch in [#27,#13,#32,'A'..'z']); treadkey:=ch; end; procedure priklad; begin writeln; writeln('Priklad:'); writeln('--------'); end; procedure help(str:char); var ch:char; i:integer; begin window(1,1,80,25); farba(BLACK,WHITE); clrscr; writeln('Vysvetlenie funkcii v tomto UNITE'); writeln('---------------------------------'); writeln; writeln('Autorom unitu je Zdeno Sekerak alias TRSEK'); writeln('Adresa: Zdeno Sekerak'); writeln(' Trnkov 18'); writeln(' p.Kapusany'); writeln(' 082 12 okr.Presov'); writeln; writeln('Autor si vyhradzuje prava na predaj, alebo inu obchodnu cinnost'); writeln('s tymto unitom. Je chapany ako FREEWARE.'); writeln; writeln('V Presove 24.10.1995'); writeln; writeln('Nabuduce: unit OBRAZ pre zobrazovanie a pracu s obrazkami TIF,BMP,PCX.'); writeln(' unit ASCII pre narodnu znakovu podporu a definovanie klavesnice.'); writeln; writeln('Stlac klaves pre akukolvek pracu.'); ch:=treadkey; repeat writeln(' Zoznam prikazov:'); writeln('------------------'); writeln(' A- procedure KurzorZap (ZapVyp:boolean); '); writeln(' B- procedure Farba (x,y:integer); '); writeln(' C- procedure Insert_Kurzor (ins:boolean); '); writeln(' D- function Ctrl_Akt:boolean; '); writeln(' E- function Alt_Akt:boolean; '); writeln(' F- function Nothing (i:integer): string; '); writeln(' G- function Zarovnaj (text:string;i:integer): string; '); writeln(' H- procedure Save_Win; '); writeln(' I- procedure Old_Win; '); writeln(' J- procedure WriteXY (x,y:integer;s:string); '); writeln(' K- function Tread (x,y:integer; d:byte; text:string; sedy,pret:char): string;'); writeln(' L- procedure Open_Win (xl,yl,xp,yp:integer;text:string;ramt:byte); '); writeln(' M- function Otazka (x,y:integer;s1,s2,s3:string;col:byte;typ:byte): integer;'); writeln(' N- procedure Koniec (naz_prog,rok:string); '); writeln(' O- procedure Clear_Keyb; '); writeln(' P- function Get_Znak (x,y:byte;farba:byte): byte; '); writeln(' R- procedure Put_Znak (x,y,farba,znak:byte); '); writeln(' S- procedure Zarad_Okno (win_pointer:win_poin;x1,y1,x2,y2:byte); '); writeln(' T- function Get_Window (x1,y1,x2,y2:integer): integer; '); writeln(' U- function Put_Window (por:integer;xn1,yn1,xn2,yn2:integer): integer; '); writeln(' V- function Vyrad_Okno (por:integer): integer; '); writeln(' X- procedure Rem_All_Win; '); write('Stlac pismeno pre podrobny help (ESC-Koniec):'); if str<>' ' then begin ch:=str;str:=' ';end else ch:=treadkey; clrscr; case Upcase(ch) of 'A':begin writeln('procedure KurzorZap (ZapVyp:boolean); '); writeln('-------------------------------------'); writeln('Zapina/vypina zobrazenie kurzora na obrazovke'); priklad; writeln('KurzorZap(False);'); writeln('KurzorZap(True);'); end; 'B':begin writeln('procedure Farba (x,y:integer); '); writeln('------------------------------'); writeln('Nastavi farbu podkladu (prve cislo) a farbu pisma (druhe cislo).'); writeln('Pricom ak zadate farbu o hodnote -1 necha aktualnu.'); writeln('Simuluje prikazy TextBackGround + TextColor.'); writeln('Farby takto nastavene pouzivaju ostatne prikazy UNITu pracujuce s obrazovkou.'); writeln('Nastavuje vnutorne premenne CTRSEK_B farbou podkladu a'); writeln(' CTRSEK_F farbou pisma.'); priklad; writeln('Farba(BLUE,YELLOW);'); end; 'C':begin writeln('procedure Insert_Kurzor (ins:boolean); '); writeln('--------------------------------------'); writeln('Zobrazi kurzor ako podciarnik, alebo plne okienko.'); writeln('Pouzitie pre naznacenie uzivatelovi, ze vkladane udaje budu INSERT.'); priklad; writeln('Insert_Kurzor(True);'); end; 'D':begin writeln('function Ctrl_Akt:boolean; '); writeln('---------------------------'); writeln('Testuje aktivitu klavesi CTRL vo chvili ked bola funkcia zavolana.'); writeln('Pozor nie predosle, ale aktualne.'); priklad; writeln('If Crtl_Akt then WriteLn('+chr(39)+'Klaves CRTL aktivny.'+chr(39)+');'); end; 'E':begin writeln('function Alt_Akt:boolean; '); writeln('--------------------------'); writeln('Testuje aktivitu klavesi ALT vo chvili ked bola funkcia zavolana.'); writeln('Pozor nie predosle, ale aktualne.'); priklad; writeln('If Alt_Akt then WriteLn('+chr(39)+'Klaves ALT aktivny.'+chr(39)+');'); end; 'F':begin writeln('function Nothing (i:integer): string; '); writeln('--------------------------------------'); writeln('Funkcia vrati prazdny retazec o I medzerach.'); writeln('Obcas chcete aby to bol zdrojak prehladny.'); writeln('Niet nad taketo rutiny.'); priklad; writeln('s:=Nothing(12);'); end; 'G':begin writeln('function Zarovnaj (text:string;i:integer): string; '); writeln('---------------------------------------------------'); writeln('Funkcia k retazcu prida tolko medzier, aby jeho dlzka bola i znakov.'); priklad; writeln('Write( Zarovnaj('+chr(39)+'Text o 40 znakoch'+chr(39)+',40) );'); end; 'H':begin writeln('procedure Save_Win; '); writeln('-------------------'); writeln('Ulozi si suradnice aktivneho okna do vnutornych premennych MinWin a WinMax.'); writeln('Spatne ich pouzije pri obnoveny suradnic okna v procedure Old_Win.'); writeln('Pozor nepameta si jeho obsah nato je Get_Win.'); priklad; writeln('Save_Win;'); writeln('Window(1,1,80,25);'); writeln('ClrScr;'); writeln('Old_Win'); end; 'I':begin writeln('procedure Old_Win; '); writeln('------------------'); writeln('Obnovi suradnice okna, ktore nastavil Save_win.'); writeln('Pozor nenakresli jeho obsah nato je Put_Win.'); priklad; writeln('Save_Win;'); writeln('Window(1,1,80,25);'); writeln('ClrScr;'); writeln('Old_Win'); end; 'J':begin writeln('procedure WriteXY (x,y:integer;s:string); '); writeln('-----------------------------------------'); writeln('Vypise text S na X,Y poziciu na obrazovke.'); writeln('Kumulovane prikazy GotoXY a Write.'); priklad; writeln('WriteXY (2,3,'+chr(39)+'Text na 2stlpci 3riadku'+chr(39)+');'); end; 'K':begin writeln('function Tread (x,y:integer; d:byte; text:string; sedy,pret:char): string;'); writeln('---------------------------------------------------------------------------'); writeln('Read v okienku s editaciou a funkcnymi sipkami, INS, DEL, BACKSPACE, ECS.'); writeln('x,y - suradnice, kde citat'); writeln('d - dlzka textu aky sa ma nacitat (pohybovat)'); writeln('text- aky text ma poskytnut na editaciu'); writeln('sedy- ak je #0 znamena PRET je seda klavesa'); writeln(' pred vlastnou editaciu vykona pohyb klavesy.'); writeln(' Inac sedy znamena obycajny klaves.'); writeln; writeln('Vrati naeditovany text.'); writeln('Uznava farby nastavene procedurou Farba.'); priklad; writeln('Farba(Blue,Yellow);'); writeln('WriteXY(10,12,'+chr(39)+'Zadaj meno:'+chr(39)+');'); writeln('meno:=Tread(21,12,30,'+chr(39)+'BezMena'+chr(39)+',#0,#0);'); end; 'L':begin writeln('procedure Open_Win (xl,yl,xp,yp:integer;text:string;ramt:byte); '); writeln('---------------------------------------------------------------'); writeln('Efektne otvorenie okna s poziciu.'); writeln('xl,yl - lavy horny roh'); writeln('xp,yp - pravy dolny roh'); writeln('text - nadpis okna'); writeln('ramt - typ ramceka 1..4'); writeln('Uznava farby nastavene procedurou Farba.'); writeln('Vnutornou premennou TDEL sa da nastavit rychlost otvarania'); writeln('okien.'); priklad; writeln('tdel:=30;'); writeln('Farba(Blue,Yellow);'); writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);'); writeln('Farba(Green,Red);'); writeln('open_win(60,12,80,15,'+chr(39)+'Okno 2'+chr(39)+',2);'); writeln('Farba(Red,LightGray);'); writeln('open_win(60,16,80,19,'+chr(39)+'Okno 3'+chr(39)+',3);'); writeln('Farba(Blue,Yellow);'); writeln('open_win(60,20,80,23,'+chr(39)+'Okno 4'+chr(39)+',4);'); farba(blue,yellow); open_win(60,7,80,11,'Okno 1',1); farba(Green,Red); open_win(60,12,80,15,'Okno 2',2); farba(Red,LightGray); open_win(60,16,80,19,'Okno 3',3); farba(blue,yellow); open_win(60,20,80,23,'Okno 4',4); window(1,1,80,25); farba(Black,White);gotoxy(1,23); end; 'M':begin repeat writeln('function Otazka (x,y:integer;s1,s2,s3:string;col:byte;typ:byte): integer;'); writeln('--------------------------------------------------------------------------'); writeln('Polozenie otazky uzivatelovi.'); writeln('x,y - pozicia otazok na obrazovke.'); writeln('s1,s2,s3 - Tri moznosti, pricom ak sa jedna vynecha budu 2, atd.'); writeln('Farba aktualnej odpovede.'); writeln('typ - typ bity 1,2 urcuju aka ma mat uvodzovky'); writeln(' 3 ci ma byt byt zhusteny tvar, alebo rovnaky rozostup.'); writeln(' uvodzovky typ 2, nezhusteny tvar typ 1 potom typ:=2+1*4;'); writeln('Prve velke pismeno urcuje moznost stlacit CRTL+to pismeno.'); writeln('Uznava farby nastavene vo Farba.'); writeln; writeln('Odpoved je 0=ESC, alebo poradove cislo odpovede.'); priklad; writeln('Farba(Blue,Yellow);'); writeln('WriteXY(45,15,'+chr(39)+'Pokracovat ???'+chr(39)+');'); writeln('odpoved:=Otazka(40,17,'+chr(39)+'Ano'+chr(39)+','+chr(39)+'Nie'+chr(39)+ ','+chr(39)+'osTan'+chr(39)+',Green,5);'); Farba(Blue,Yellow); WriteXY(45,15,'Pokracovat ???'); i:=Otazka(40,17,'Ano','Nie','osTan',Green,5); delay(500); Window(1,1,80,25); farba(Black,White);gotoxy(1,23);clrscr; until (i in [0,1]); end; 'N':begin writeln('procedure Koniec (naz_prog,rok:string); '); writeln('---------------------------------------'); writeln('Vypise efektne ako NC Software by atd. s nazvom NAZ_PROG'); writeln('a rokom vyrobi ROK.'); writeln('Pre pouzitie autora.'); priklad; writeln('Koniec('+chr(39)+'Super UNIT'+chr(39)+','+chr(39)+'95'+chr(39)+');'); end; 'O':begin writeln('procedure Clear_Keyb; '); writeln('---------------------'); writeln('Zmaze buffer klavesnice, ak je naplneny znakmi.'); writeln('Moze sa stat, ze chcete, aby pred neakou otazkou na'); writeln('uziavtela bol buffer prazdny pouzite Clear_Keyb;'); priklad; writeln('Farba(Blue,Yellow);'); writeln('WriteXY(45,15,'+chr(39)+'Pokracovat ???'+chr(39)+');'); writeln('Clear_Keyb'); writeln('odpoved:=Otazka(40,17,'+chr(39)+'Ano'+chr(39)+','+chr(39)+'Nie'+chr(39)+ ','+chr(39)+'osTan'+chr(39)+',Green,5);'); end; 'P':begin writeln('function Get_Znak (x,y:byte;farba:byte): byte; '); writeln('---------------------------------------------------'); writeln('Vrati znak, ktory je na pozicii x,y.'); writeln('Jeho farbu v premennej farba.'); writeln('Farba- dolne 4 bity su podklad, horne 4 pismo.'); writeln('farba_pisma:=(Color div 16)/16; farba_podkladu:=Color mod 16;'); writeln('Pozor farba nemoze byt cislo, musi byt premenna.'); priklad; writeln('znak:=Get_Znak(10,10,Color);'); end; 'R':begin writeln('procedure Put_Znak (x,y,farba,znak:byte); '); writeln('-----------------------------------------'); writeln('Inverzna procedure k Get_Znak.'); writeln('x,y je pozicia'); writeln('farba je farba znaku+podklad farba:=Blue*16+Yellow'); writeln('znak je Ord(znaku), ktory ma byt vypisovany.'); priklad; writeln('Put_znak(70,10,Blue*16+Yellow,Ord('+chr(39)+'a'+chr(39)+'));'); Put_znak(70,10,Blue*16+Yellow,Ord('a')); end; 'S':begin writeln('procedure Zarad_Okno (win_pointer:win_poin;x1,y1,x2,y2:byte); '); writeln('-------------------------------------------------------------'); writeln('Vyhradi miesto v pameti pre okno s Win_Pointer pre suradnice'); writeln('x1,y1,x2,y2.'); writeln('Tuto rutinku pouziva Get_Window.'); end; 'T':begin writeln('function Get_Window (x1,y1,x2,y2:integer): integer; '); writeln('----------------------------------------------------'); writeln('Zapamata si aktivne okno a jeho obsah a ulozi do pamate.'); writeln('Rozmeri okna su lavy -horny (x1,y1)'); writeln(' pravy-dolny (x2,y2)'); writeln; writeln('Vrati identifikacne cislo (ICO) ake bolo oknu pridelene.'); writeln('Celkovy pocet okien je vo vnutornej premennej WIN_POCET.'); writeln; writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.'); priklad; writeln('Farba(Blue,Yellow);'); writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);'); writeln('okno:=Get_Window(10,2,70,20);'); writeln('Key:=ReadKey;'); writeln('ClrScr;'); writeln('err:=Put_Window(okno,0,0,0,0);'); farba(Blue,Yellow); open_win(60,7,80,11,'Okno 1',1); i:=Get_Window(10,2,70,20); window(1,1,80,25);farba(Black,White); ch:=tReadKey; ClrScr; i:=Put_Window(i,0,0,0,0); ch:=tReadKey;ch:=#13; window(1,1,80,25);farba(Black,White); gotoxy(1,23); end; 'U':begin writeln('function Put_Window (por:integer;xn1,yn1,xn2,yn2:integer): integer; '); writeln('-----------------------------------------------------------'); writeln('Inverzna k Get_Window.'); writeln('Por - ake okno v roradi vykreslit.'); writeln('xn1,yn1 - su nove suradnice do laveho horneho rohu do ktoreho ma vykreslit.'); writeln('xn2,yn2 - je velkost aku ma zobrazit z osi x,y.'); writeln('0,0,0,0 - znamena v povodnych suradniciach.'); writeln; writeln('Vrati hodnoty 1-nenasiel som take okno'); writeln(' 0-vykreslil som toto okno'); writeln; writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.'); priklad; writeln('Farba(Blue,Yellow);'); writeln('open_win(60,7,80,11,'+chr(39)+'Okno 1'+chr(39)+',1);'); writeln('okno:=Get_Window(10,2,70,20);'); writeln('Key:=ReadKey;'); writeln('ClrScr;'); writeln('err:=Put_Window(okno,1,1,60,10);'); farba(Blue,Yellow); open_win(60,7,80,11,'Okno 1',1); i:=Get_Window(10,2,70,20); window(1,1,80,25);farba(Black,White); ch:=tReadKey; ClrScr; i:=Put_Window(i,1,1,60,10); ch:=tReadKey;ch:=#13; window(1,1,80,25);farba(Black,White); gotoxy(1,23); end; 'V':begin writeln('function Vyrad_Okno (por:integer): integer; '); writeln('--------------------------------------------'); writeln('Vyhodi okno s pamate s poradovim cislom POR.'); writeln('Pozor predtym nez ho vyhodi nevykresli ho.'); writeln('Preto, ak chcete vydiet okno dajte ho najprv vykreslit,'); writeln('az tak vyhodit s pamete.'); writeln('Autor odporuca vyhadzovat v opacnomn poradi ako boli zaradene,'); writeln('pretoze pamet sa uvolni az po VYRADeni posledneho okna.'); writeln; writeln('Ak vrati hodnotu 0-znamena, ze uz bolo vyradene, alebo sa neda vyhodit.'); writeln(' <>0-uspesne vyradene toto okno'); writeln; writeln('Vo vnutornej premennej WIN_POCET je pocet okien ulozenych v pamati.'); priklad; writeln('err:=Vyrad_Okno(1);'); end; 'X':begin writeln('procedure Rem_All_Win; '); writeln('----------------------'); writeln('Procedura vyhodi vsetky okna s pamate a uvolni ju.'); end; end; if ch<>#27 then begin writeln; writeln('Koniec ESC. Spat stlac akukolvek klavesu.'); ch:=treadkey; if ch=#27 then ch:=#13; end; until (ch=#27); end; begin writeln; writeln('Tento program pouziva UNIT od TRSEKa Prikaz help('+chr(39)+' '+chr(39)+'); pre pomoc'); writeln('adresa WORD:\Europe\Slovakia\Presov\Trnkov_18\Zdeno_Sekerak.programator'); delay(500); ctrsek_b:=BLACK; ctrsek_f:=WHITE; save_win; tdel:=30; wfirst_pointer:=NIL; win_pocet:=0; end.