{ TIPOVANI.PAS Copyright (c) Maros Zatko } { } { v programe sa používajú tlacítka: } { A až Z, Escape, šípka hore, šípka dole } { } { Author: Maros Zatko } { Date : 2022 http://www.trsek.com } program na_TIPovanie_v_stavkovych_kancelariach; { PREPINANIE klavesou TAB: p'F' - Tab=1 | '2' - Tab=2 | 'H' - Tab=3 } {A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S-,V-,X-} {$M 16384,0,655360} uses crt,dos; label 0,1; const c2=2; { 2 alebo 3 body za vyhru ? - prepinanie F2/F3 } c48=46; { maximalny pocet lig } c24=24; { maximalny pocet muzstiev } c2212=2630; { c2212=24*(24-1)*4+4 - pre 24 muzstiev & '.'! } c84=84; { maximalny pocet kol: 84 v NHL } c28=28; { copy('Everton Liverp;ool...',1,28) } c16='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ...'; var j,k,l,sto: byte; { l[1..3] pocet Lig } fh,sipka: char; { Fotbal/Hokej } y: string[20]; { Years_.txt } r: string[4]; { Rok } m: array[1..c24] of byte; { pocet Muzstiev } n: array[1..c48] of word; { dlzka dat } p: array[0..c48] of string[c24]; { zaciatocne Pismeno } d: array[1..c48,0..c24] of string[c28]; { Data/nazvy muzstiev } v: array[1..c2212] of char; { Vysledky } t: array[1..c48,1..c24,0..2,1..7] of byte; { Tabulky } s: array[1..25,1..80,1..2] of byte absolute 47104:0; { Screen } ss: array[1..4000] of byte; { ScreenSaver; } z: array[1..c48] of word; { Zaciatok vysledkov } f: text; { File; } procedure Key; label 2; var sk:string[3]; { Shift Keys } m1:byte; begin s[hi(windmin)+wherey,lo(windmin)+wherex,2]:=16*black; { zmizne kurzor } 2:repeat m1:=mem[64:23] { Shift Keys } until KeyPressed; k:=ord(readkey); sk:=' '; if m1 AND 2<>0 then sk[1]:='S'; { Shift } if m1 AND 4<>0 then sk[2]:='C'; { Control } if m1 AND 8<>0 then sk[3]:='A'; { Alt } if k=0 then begin k:=ord(readkey); case k of 72: begin sipka:=''; exit; end; { o rok menej } 80: begin sipka:=''; exit; end; { o rok viacej } else begin sipka:=' '; goto 2; end; end; end; case k of 27: ; { Escape } ord('a')..ord('z'): k:=k AND (255-96); ord('A')..ord('Z'): k:=k AND (255-64) else goto 2; end; end; procedure Pause(sek:real); var h1,m1,s1,n1, h2,m2,s2,n2:word; t1,t2:real; begin gettime(h1,m1,s1,n1); t1:=3600*h1+60*m1+s1+n1/100; repeat gettime(h2,m2,s2,n2); t2:=3600*h2+60*m2+s2+n2/100; until t2-t1>=sek; end; procedure Roky; var DirInfo11: SearchRec; i11,j11,l11: byte; f11,o11,r11: word; c11: integer; li11: longint; v11: string[1]; y11,z11: string; begin y11:=''; FindFirst('Year*.txt',Archive,DirInfo11); while DosError=0 do begin val(copy(DirInfo11.Name,5,4),o11,c11); y11:=concat(y11,chr(o11-1900)); FindNext(DirInfo11); end; l11:=length(y11); for i11:=1 to l11-1 do for j11:=i11+1 to l11 do if y11[i11]>y11[j11] then begin v11[1]:=y11[i11]; y11[i11]:=y11[j11]; y11[j11]:=v11[1]; end; r11:=1900+ord(y11[length(y11)]); li11:=r11; str(li11,r); { r='2010' posledne udaje } { for i11:=1 to length(y11) do begin textattr:=16*lightgray+green; if r11=1900+ord(y11[i11]) then textattr:=16*lightgray+brown; gotoxy(4,wherey); write(1900+ord(y11[i11])); gotoxy(1,wherey); writeln(1899+ord(y11[i11]),'/'); end; pause(2.5); } y:=y11; end; procedure SipkamiHoreDole; var i22,u22: byte; s22: string; begin for i22:=1 to length(y) do begin str(1900+ord(y[i22]),s22); if s22=r then u22:=i22; end; if sipka='' then begin dec(u22); if u22=0 then u22:=length(y); end; if sipka='' then begin inc(u22); if u22>length(y) then u22:=1; end; sipka:=' '; str(1900+ord(y[u22]),r); end; function DownCase(p:char):char; begin downcase:=chr(ord(p) or 32); { if p in ['A'..'Z'] then inc(p,32); } end; procedure Chyba(ch:string); begin window(10,12,70,14); textattr:=16*brown+red; clrscr; gotoxy(8,2); write('ERROR: ',ch); Pause(5.5); { textattr:=16*black+lightgray; } halt; end; procedure Load; var t2:text; i2,j2,p2:byte; r2:string[80]; l2:word; begin CheckBreak:=False; assign(t2,concat('Year',r,'.txt')); reset(t2); if ioresult<>0 then Chyba('subor Year20__.txt sa nenasiel.'); i2:=1; n[1]:=0; j2:=255; while not eof(t2) do begin readln(t2,r2); if r2<>'' then begin if r2[2]=' ' then begin inc(j2); p[i2,j2]:=DownCase(r2[1]); { nech to ostane tak ! } {p2:=pos(';',r2); if p2>0 then r2:=copy(r2,1,pred(p2));} d[i2,j2]:=copy(r2,3,255); end else begin if r2[1]<>'Ä' then begin l2:=length(r2); dec(l2,2); if (l2 mod 4<>0) and (r2[length(r2)]<>'.') then { ** BODKA ** } begin writeln('V riadku ',r2,' je nejaky znak naviac !'); readln; halt; end; inc(n[i2],l2); end else inc(n[i2],4); if n[i2]>c2212 then Chyba('dlzka dat > 2212'); { pre NHL to bude viac } end; end else begin m[i2]:=j2; p[i2,0]:=chr(j2); { pocet muzstiev } inc(i2); n[i2]:=0; j2:=255; end; end; close(t2); m[i2]:=j2; l:=i2; end; procedure Riadky01; var p9:byte; i9:word; r9:string; d9:array[1..15000] of char; begin i9:=0; p9:=0; reset(f); while not eof(f) do begin inc(i9); readln(f,r9); d9[i9]:=r9[1];; if (d9[i9]='0') and (d9[pred(i9)] in ['A'..'z']) then begin if (d9[pred(i9)] in ['A'..'z']) then begin inc(p9); { if p9>c48 then Chyba('je vela napocitanych riadkov 01____ .'); } z[p9]:=i9; end; end; end; end; procedure Vysledky(xb:byte); var jb,nb:word; rb:string; begin jb:=0; nb:=0; reset(f); while not eof(f) do begin inc(jb); readln(f,rb); if jb>=z[xb] then begin if length(rb)=0 then exit; if rb[1]<>'Ä' then delete(rb,1,2) else rb[0]:=chr(4); move(rb[1],v[succ(nb)],length(rb)); inc(nb,length(rb)); end; end; { n[xb]:=nb; } end; procedure Nulovanie(segment,zaciatok,velkost:word); assembler; asm MOV AL,0 MOV ES,segment MOV DI,zaciatok MOV CX,velkost CLD REP STOSB { hodnota AL do ES:DI } end; procedure MemSet(segment,zaciatok,velkost:word); assembler; asm MOV AX,65535 { AL:=255 AH:=255 } MOV ES,segment MOV DI,zaciatok MOV CX,velkost SHR CX,1 CLD REP STOSW end; procedure SciTabulky; { Scitanie Tabulky } label 4; var i4,j4,k4,l4,a4,b4,c4,d4,e4,home,away:byte; w4:word; p4:array[ord('A')..ord('z')] of byte; r4:array[0..255] of byte; s4:string; begin Nulovanie(seg(t),ofs(t),sizeof(t)); MemSet(seg(r4),ofs(r4),sizeof(r4)); s4:=#0#1#2#3#4#5#6#7#8#9; move(s4[1],r4[ord('0')],10); s4:=#10#11#12#13#14#15#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31#32#33#34#35; move(s4[1],r4[ord('A')],26); for i4:=1 to l do begin if n[i4]<4 then begin clrscr; write('n[i4]=',n[i4]); readln; halt; end; Nulovanie(seg(p4),ofs(p4),sizeof(p4)); for j4:=1 to m[i4] do begin p4[ord(DownCase(p[i4,j4]))]:=j4; p4[ord(UpCase(p[i4,j4]))]:=j4; end; Vysledky(i4); w4:=1; repeat home:=0; if v[w4] in ['A'..'Z'] then { v predlzeni vyhrali domaci } home:=1; a4:=p4[ord(v[w4])]; inc(w4); away:=0; if v[w4] in ['A'..'Z'] then { v predlzeni vyhrali hostia } away:=1; b4:=p4[ord(v[w4])]; inc(w4); if home AND away<>0 then chyba('dve pismenka vedla seba su velke'); c4:=r4[ord(v[w4])]; inc(w4); d4:=r4[ord(v[w4])]; inc(w4); if (a4=0) or (b4=0) or (c4=255) or (d4=255) then begin TextAttr:=16*Black+Red; gotoxy(1,25); write('Error: ',d[i4,0],' ',d[i4,a4],' - ',d[i4,b4],' ', c4,':',d4,' (',w4,'/',n[i4],')'); readln; halt; end; if c4>d4 then e4:=2 else if c4=d4 then e4:=1 else e4:=0; inc(t[i4,a4,1,3-e4]); inc(t[i4,a4,1,4],c4); inc(t[i4,a4,1,5],d4); inc(t[i4,b4,2,1+e4]); inc(t[i4,b4,2,4],d4); inc(t[i4,b4,2,5],c4); if home+away=1 then begin if c4<>d4 then begin gotoxy(1,25); textattr:=16*black+red; write('v hokejovom predlzeni nie je rovnake skore.'); readln; halt; end; if home<>0 then { home=1 } begin inc(t[i4,a4,1,4]); inc(t[i4,b4,2,5]); end else { away=1 } begin inc(t[i4,a4,1,5]); inc(t[i4,b4,2,4]); end; end; if v[w4]='Ä' then { * winter / zimna prestavka * } inc(w4,4); if v[w4]='.' then { * BODKA * } begin n[i4]:=pred(w4); goto 4; end; until w4>=n[i4]; 4: for j4:=1 to m[i4] do begin for k4:=1 to 2 do begin t[i4,j4,k4,6]:=t[i4,j4,k4,1]+t[i4,j4,k4,2]+t[i4,j4,k4,3]; { zapasy } t[i4,j4,k4,7]:=c2*t[i4,j4,k4,1]+t[i4,j4,k4,2]; { body } end; for l4:=1 to 7 do t[i4,j4,0,l4]:=t[i4,j4,1,l4]+t[i4,j4,2,l4]; { celkom } end; end; end; procedure FotbalHokej; var i3,j3,f3,h3:byte; x3:word; begin f3:=0; h3:=0; for i3:=1 to l do begin x3:=0; for j3:=1 to m[i3] do inc(x3,t[i3,j3,0,4]); { if n[i3]<48 then - je to len prve kolo } if x3/(n[i3] SHR 2)/2<2.05 then inc(f3) { fotbal: 1.05 - 1.67 } else inc(h3); { hokej: 2.22 - 3.20 } end; TextMode(CO80); { Mem[64:73]:=3; TextMode(BW80); } window(1,1,80,25); clrscr; TextAttr:=16*Black+Cyan; write('Euro'); if f3=l then { h3<>0 } write('.Fotbal') else if h3=l then { f3<>0 } write('p.Hokej') else begin gotoxy(1,1); write('FOT:',f3,' HO:',h3); { v sezone 1996/1997 } end; if f3>=h3 then fh:='F' { treba to uchovat v poli } else fh:='H'; end; procedure KurzorDoprava; begin gotoxy(succ(wherex),wherey); end; procedure k3(rr:real); { kurz sa vypise ako 3 cisla } begin if rr<10 then write(rr:1:2) else write(rr:2:1); end; procedure KurzyRemiz; { priemerne Kurzy na remizu v Ligach } var a5,b5,c5,i5,j5,y5:byte; s5,o5:word; r5:real; code:integer; begin val(r,o5,code); KurzorDoprava; write(pred(o5),'/',copy(r,3,2)); y5:=(26-l) div 2; for i5:=1 to l do begin gotoxy(1,i5+y5); textattr:=16*black+white; write(chr(i5+64),' '); textattr:=16*black+lightgray; write(d[i5,0]); { PORTUGALSKO 2 } gotoxy(15,wherey); { 16,y ! } write(' '); a5:=0; b5:=0; c5:=0; for j5:=1 to m[i5] do begin inc(a5,t[i5,j5,1,1]); inc(b5,t[i5,j5,1,2]); inc(c5,t[i5,j5,1,3]); end; s5:=a5+b5+c5; { write(' (',s5 SHL 1/m[i5]:2:0,') '); je to zle } if b5=0 then write('ÄÄÄÄ') else begin r5:=s5/b5; if (r5<=3.40) or ((fh='H') and (r5<=4.50)) then textattr:=16*black+green; k3(r5); { write('x'); } end end end; {function Datum:string; const mes:array[1..12] of string[3]= ('jan','feb','mar','apr','maj','jun','jul','aug','sep','okt','nov','dec'); var rok,mesiac,den,dow:Word; d6:string[2]; begin GetDate(rok,mesiac,den,dow); Str(den,d6); Datum:=concat('K_',d6,'_',mes[mesiac],'.txt'); end;} function hex(b:byte):char; { Cislo 0..9 Pismeno A..F,Z } var s:string[1]; begin s:=copy(c16,succ(b),1); hex:=s[1]; end; { procedure znak(x,y:byte; z:char; f:byte); begin s[y,x,1]:=ord(z); s[y,x,2]:=16*black+f; end; } procedure znak80x25y(z:char; f:byte); begin MemW[47104:3998]:=ord(z)+(16*black+f) shl 8; end; function DoBodkociarky(aa,bb:byte):string; var pp:byte; { Pomocna Premenna } nm:string; { Nazov Muzstva } begin nm:=d[aa,bb]; pp:=pos(';',nm); if pp=0 then DoBodkociarky:=copy(nm,1,15) else DoBodkociarky:=copy(nm,1,pred(pp)); end; function Seria(jj0,kk0:byte):string; var rr0: string; { Retazec } pp0: word; { Pomocna Premanna } aa0,bb0: byte; mm0: shortint; { Minus } gg0: array[ord('0')..ord('Ä')] of byte; { Goly } begin rr0:=#0#1#2#3#4#5#6#7#8#9':;<=>?@'#10#11#12#13#14#15#16#17#18#19#20; move(rr0[1],gg0,length(rr0)); rr0:=''; Vysledky(jj0); pp0:=1; repeat aa0:=pos(DownCase(v[pp0]),p[jj0]); inc(pp0); bb0:=pos(DownCase(v[pp0]),p[jj0]); inc(pp0); mm0:=gg0[ord(v[pp0])]-gg0[ord(v[succ(pp0)])]; inc(pp0,2); if kk0=aa0 then begin inc(rr0[0]); case mm0 of 1..127: rr0[length(rr0)]:='2'; { þ . - ZNAKY.PAS } 0: rr0[length(rr0)]:='1'; else rr0[length(rr0)]:='0'; end; end; if kk0=bb0 then begin inc(rr0[0]); case mm0 of 1..127: rr0[length(rr0)]:='0'; 0: rr0[length(rr0)]:='1'; else rr0[length(rr0)]:='2'; end; end; until pp0>=n[jj0]; Seria:=rr0; end; procedure Vymen(segm,ofs1,ofs2:word); assembler; { procedure Vymen6bytes } asm MOV DX,DS MOV DS,segm MOV ES,segm MOV SI,ofs1 MOV DI,ofs2 INC SI INC DI CLD MOV CX,3 @1: LODSW MOV BX,[DI] MOV [SI-2],BX STOSW LOOP @1 MOV DS,DX MOV ES,DX end; procedure Tutovky; { klavesou SPACE: muzstva, ktore vyhravaju / prehravaju } label 3; var i0,j0,l0,m0,x0,y0,a0,b0,d0:byte; n0,k0,p0:word; { n0 - pocet vsetkych muzstiev } u0:array[1..1200] of string[6]; t0:text; r0:real; int:integer; s0:string; pa:word; aa,ba,ca,da:char; za:char; xa,ia:byte; procedure QuickSort(l,p:word); { krokovat tento aj obycajny QuickSort } var m,i:word; v:string[6]; begin if l

0) and (t[i0,j0,2,6]<>0) then { t[i0,j0,0,6]>2 } begin int:=t[i0,j0,0,4]-t[i0,j0,0,5]+128; if (int>=0) and (int<=255) then b0:=int else begin if int>255 then b0:=255; if int<0 then b0:=0; end; inc(n0); u0[n0]:=concat(chr(round(t[i0,j0,0,7]/t[i0,j0,0,6]*50)), chr(t[i0,j0,0,6]),chr(b0),chr(t[i0,j0,0,4]),chr(i0),chr(j0)); end; if n0<25 then exit; QuickSort(1,n0); y0:=0; for k0:=n0 downto n0-24 do begin inc(y0); a0:=ord(u0[k0,5]); b0:=ord(u0[k0,6]); d0:=t[a0,b0,0,6]; TextAttr:=16*Black+LightGray; gotoxy(21,y0); { >>> WINDOW(21,1,80,25); <<< } if d0<10 then write(' '); { '0' } write(d0,' ',DoBodkociarky(a0,b0),' - ',d[a0,0,1]); for i0:=2 to length(d[a0,0]) do write(downcase(d[a0,0,i0])); gotoxy(49,y0); { write(' ',abs(t[a0,b0,0,7]/t[a0,b0,0,6]*50-50):2:1); PERCENTA } for m0:=1 to 2 do begin KurzorDoprava; for l0:=1 to 3 do begin case l0 of 1: TextAttr:=16*Black+Yellow; 2: TextAttr:=16*Black+Green; 3: TextAttr:=16*Black+Red; end; if (wherey=25) and (wherex=76) then begin write(' '); if t[a0,b0,m0,l0]<>0 then begin r0:=t[a0,b0,m0,6]/t[a0,b0,m0,l0]; if r0<10 then begin write(r0:1:1); znak80x25y(chr( ord('0')+round(r0)*100 mod 10 ),red); end else begin write(r0:2:0,'.'); znak80x25y('',red); { '' >>> ord('0')+round(r0)*100 mod 10; } end; end else begin write('ÄÄÄ'); znak80x25y('Ä',red); end; end else begin write(' '); if t[a0,b0,m0,l0]<>0 then k3(t[a0,b0,m0,6]/t[a0,b0,m0,l0]) else write('ÄÄÄÄ'); end; end; end; { * VYSVIETENIE * } Vysledky(a0); za:=p[a0,b0]; pa:=n[a0]; repeat da:=v[pa]; dec(pa); ca:=v[pa]; dec(pa); ba:=v[pa]; dec(pa); aa:=v[pa]; dec(pa); if downcase(aa)=za then begin if ca>da then xa:=51; if ca=da then xa:=56; if cada then xa:=77; goto 3; end; until false; 3: for ia:=xa to xa+3 do s[y0,ia,2]:=16*LightGray+Black; { 16*Blue+LightCyan; } end; GotoXY(2,25); s[25,2,2]:=16*black; { procedure SaveInfo: 'INFO2010.txt' } GetDir(0,s0); if s0[1] in ['C'..'D'] then { A:\> C:\> D:\> } begin Assign(t0,concat('Info',r,'.txt')); Rewrite(t0); p0:=0; for k0:=n0 downto 1 do begin inc(p0); a0:=ord(u0[k0,5]); b0:=ord(u0[k0,6]); { Write(t0,' #'); case p0 of 1..9: Write(t0,' #00'); 10..99: Write(t0,' #0'); 100..255: Write(t0,' #'); end; } WriteLn(t0,#13#10' #',p0:3,' ',copy(d[a0,0],1,3),' - ',DoBodkociarky(a0,b0), ' - ',t[a0,b0,0,7]/(t[a0,b0,0,6] SHL 1)*100:2:3,'%'#13#10, ' doma: ',t[a0,b0,1,1],' ',t[a0,b0,1,2],' ',t[a0,b0,1,3],' ',t[a0,b0,1,4],':',t[a0,b0,1,5],#13#10, ' vonku: ',t[a0,b0,2,1],' ',t[a0,b0,2,2],' ',t[a0,b0,2,3],' ',t[a0,b0,2,4],':',t[a0,b0,2,5],#13#10, ' celkom: ',t[a0,b0,0,1],' ',t[a0,b0,0,2],' ',t[a0,b0,0,3],' ',t[a0,b0,0,4],':',t[a0,b0,0,5],#13#10, ' seria: ',seria(a0,b0)); end; Close(t0); end; end; procedure Tabulka2; const f8:array[1..3] of word=(16*black+yellow,16*black+green,16*black+red); var i8,j8:byte; begin clrscr; for i8:=1 to m[k] do begin textattr:=16*black+lightgray; write(i8:2,' ',d[k,i8]); gotoxy(20,wherey); for j8:=1 to 3 do begin textattr:=f8[j8]; write(t[k,i8,1,j8]); KurzorDoprava; end; for j8:=1 to 3 do begin KurzorDoprava; textattr:=f8[j8]; write(t[k,i8,2,j8]); end; KurzorDoprava; KurzorDoprava; textattr:=16*black+lightgray; writeln(t[k,i8,0,4],':',t[k,i8,0,5]); end; end; {procedure Seria(s9:string); ved som to urobil na ATARI ! var a9,b9,i9,p9:byte; begin p9:=length(s9); s9[succ(p9)]:=#0; s9[succ(succ(p9))]:=#0; textattr:=16*black+lightgray; write(' '); for i9:=1 to length(s9) do write(ord(s9[i9])); write(' '); i9:=0; repeat inc(i9); until s9[i9]=#0; a9:=i9; repeat inc(i9); until s9[i9]=#0; b9:=i9; write(' a=',a9,' b=',b9,' '); textattr:=16*black+yellow; case p9 of 1: ... 2: ... end; end;} procedure Tabulka; { >>> Celkom, aj Doma a Vonku <<< zmeni sa 0 na 1 alebo 2 napr. vo Svajciarsku od 23-tieho kola do 35-teho } var a6,b6,c6,d6,e6,h6,i6,j6,p6,r6,u6:byte; s6:shortint; k6:word; m6:string[c84]; z6:char; t6:array[1..c24] of real; v6,w6:real; pm:string[15]; nm6:string; begin p6:=0; h6:=0; for i6:=1 to m[k] do begin if t[k,i6,0,4]>=110 then inc(p6); if t[k,i6,0,5]>=110 then inc(p6); if t[k,i6,0,6]>=47 then { v hokeji ma tym odohratych vyse 47 kol } inc(h6); end; sto:=0; if p6<>0 then sto:=2; { posunutie okna doprava o dve pozicie } textattr:=16*black+lightgray; clrscr; for i6:=1 to m[k] do begin if t[k,i6,0,6]=0 then t6[i6]:=10000 { 255 } else t6[i6]:=t[k,i6,0,7]/t[k,i6,0,6]*5000+t[k,i6,0,4]-t[k,i6,0,5]+t[k,i6,0,4]*0.01 end; { takto: var t6:array[1..c24] of string[3]; } { t6[i6]:=concat( chr(round(50*t[k,i6,0,7)/t[k,i6,0,6))), chr(128+t[k,i6,0,4)-t[k,i6,0,5)), chr(t[k,i6,0,4)); } gotoxy(1,(26-m[k]) div 2); for i6:=1 to m[k] do begin gotoxy(1,succ(wherey)); u6:=1; for j6:=2 to m[k] do if t6[j6]>t6[u6] then u6:=j6; nm6:=DoBodkociarky(k,u6); p6:=pos(upcase(p[k,u6]),nm6); if p6=0 then p6:=pos(p[k,u6],nm6); if p6=0 then begin textattr:=16*black+white; write(upcase(p[k,u6]),' ') end; textattr:=16*black+lightgray; write(nm6); if p6>0 then s[wherey,p6,2]:=16*black+white; gotoxy(17,wherey); write(t[k,u6,0,6]:2); p6:=t[k,u6,0,4]; if sto=0 then begin if (p6>=100) and (p6<=109) then write(' 0',p6-100) else write(p6:3); end else write(p6:4); write(':'); p6:=t[k,u6,0,5]; if sto=0 then begin if (p6>=100) and (p6<=109) then write('0',p6-100) else write(p6); end else write(p6); { pri hokeji: ak je pocet golov > 100:100, tak posunut okno doprava } gotoxy(26+sto,wherey); if t[k,u6,0,6]=0 then write(' 0') { & __ } else begin s6:=round(t[k,u6,0,7]/t[k,u6,0,6]*50-50); if (s6>0) and (s6<10) then write('+',s6) else begin if s6<=-10 then s6:=0-s6; write(s6:2) end; { Seria } Vysledky(k); k6:=n[k]; p6:=0; repeat d6:=pred(pos(v[k6],c16)); { pozri: r4[ ] } dec(k6); c6:=pred(pos(v[k6],c16)); dec(k6); b6:=pos(v[k6],p[k]); dec(k6); a6:=pos(v[k6],p[k]); dec(k6); if (a6=u6) or (b6=u6) then begin if c6>d6 then e6:=2 else if c6=d6 then e6:=1 else e6:=0; if b6=u6 then e6:=2-e6; inc(p6); m6[p6]:=chr(e6); end; until k6=0; m6[0]:=chr(p6); z6:=#0; repeat p6:=pos(z6,m6); if p6=0 then p6:=length(m6) else begin r6:=pos(z6,copy(m6,succ(p6),255)); dec(p6); if r6=0 then r6:=length(m6) else inc(r6,p6); if r6-p6>1 then p6:=r6 end; if z6=#0 then a6:=p6 else b6:=p6; inc(z6,2) until z6=#4; if a6>b6 then begin c6:=a6; textattr:=16*black+yellow; end else begin c6:=b6; textattr:=16*black+red; end; write(' '); if c6<16 then write(hex(c6)) else write('<'); { <® } { nebudu sa ratat posledne zapasy, iba skorsie } v6:=0; p6:=0; j6:=0; repeat inc(j6); inc(p6,ord(m6[j6])); w6:=abs(p6-j6*t[k,u6,0,7]/t[k,u6,0,6]); if w6>v6 then v6:=w6; until j6=c6; { v poslednych kolach body navyse '+++' oproti priemeru } if v6>=3 then { ak je nizky pocet kol, tak: 2,3,4 } begin pm:=copy(c16,2,16); { PlusMinus +/- } if a6>b6 then FillChar(pm,11,'+') else FillChar(pm,11,'-'); pm[0]:=chr(trunc(v6)); write(pm); end; { fotbalisti maju vyse 50% remiz, hokejisti vyse 35% } w6:=t[k,u6,0,2]/t[k,u6,0,6]; if (w6>=0.50) or ((fh='H') and (w6>=0.35)) then begin textattr:=16*black+green; gotoxy(29+sto,wherey); w6:=w6*10; if w6<10 then write(int(w6):1:0) else write('A'); end; { SERIA - ZA TABULKOU VIDITELNE VSETKY ZAPASY } if h6=0 then gotoxy(31+sto,wherey) else gotoxy(19,wherey); { pre hokej: 47 kol a viac } write(' '); nm6:=Seria(k,u6); for j6:=1 to length(nm6) do begin case nm6[j6] of '2': textattr:=16*black+yellow; '1': textattr:=16*black+green; '0': textattr:=16*black+red; end; write(''); end; end; t6[u6]:=-500; end; end; procedure Muzstvo; { prezeranie vysledkov nielen poslednych 20 zapasov } label 7; const f7:array[0..2] of byte=(red,green,yellow); var a7,b7,c7,d7,e7,i7,j7,m7,n7,p7,v7:byte; k7:word; r7:string[c84]; w7:string[28]; { ciara Winter } body:array[1..c24] of byte; begin k:=pos(chr(k+96),p[j]); if (k=0) or (t[j,k,0,6]=0) then exit; window(31+sto,1,80,25); textattr:=16*black+lightgray; clrscr; window(32+sto,1,80,12); clrscr; write(d[j,0]); gotoxy(14-sto,1); if k<10 then KurzorDoprava; write('(',k,'/',m[j],')'); window(53,1,80,3); { BOLO: window(53+sto,1,80,3); } clrscr; write(copy(d[j,k],1,c28)); window(32+sto,1,80,12); { *** NASKOK PRVEHO MUZSTVA *** } { alebo kolko bodov stracaju na prveho v tabulke } for i7:=1 to m[j] do body[i7]:=3*t[j,i7,0,1]+t[j,i7,0,2]; m7:=0; for i7:=1 to m[j] do begin if body[i7]>m7 then begin m7:=body[i7]; p7:=i7; end; end; body[p7]:=0; n7:=0; for i7:=1 to m[j] do begin if body[i7]>n7 then n7:=body[i7]; end; if (fh='F') and (k=p7) and (m7-n7>0) then begin gotoxy(44,1); if m7-n7<10 then KurzorDoprava; textattr:=16*black+brown; write(' n:+',m7-n7); end; gotoxy(1,2); for i7:=0 to 2 do begin writeln; if i7<>0 then begin case i7 of 1: write('Home'); { Ho: Doma_ } 2: write('Away'); { Aw: Vonku } end; for j7:=1 to 3 do begin write(' '); case j7 of 1: textattr:=16*black+yellow; 2: textattr:=16*black+green; 3: textattr:=16*black+red; end; if t[j,k,i7,j7]<>0 then write(t[j,k,i7,j7]) else { textattr:=16*black+lightgray; } write('ð'); end; textattr:=16*black+lightgray; write(' ',t[j,k,i7,4],':',t[j,k,i7,5],#13#10#10); end; Vysledky(j); r7[0]:=chr(0); k7:=1; repeat a7:=pos(DownCase(v[k7]),p[j]); { DownCase kvoli hokeju ! } inc(k7); b7:=pos(DownCase(v[k7]),p[j]); inc(k7); if (a7=k) or (b7=k) then begin c7:=pred(pos(v[k7],c16)); inc(k7); d7:=pred(pos(v[k7],c16)); inc(k7); if c7>d7 then e7:=2 else if c7=d7 then { c72) and (a7=k) or (i7<>1) and (b7=k) then r7:=concat(r7,chr(f7[e7])); end else inc(k7,2); until k7>n[j]; p7:=1; if i7=0 then begin if length(r7)>48-sto then p7:=length(r7)-(47-sto) { o jedno viac !!! } { - radsej aby bolo vidiet vsetky zapasy } { - tabulka bude uzsia } end else begin if length(r7)>(20-sto) then p7:=length(r7)-(19-sto) end; for j7:=p7 to length(r7) do begin textattr:=16*black+ord(r7[j7]); write(''); end; textattr:=16*black+lightgray; writeln; end; window(53,5,80,25); clrscr; Vysledky(j); { pre HOKEJ: DownCase ! } k7:=n[j]-3; p7:=0; repeat if (DownCase(v[k7])=p[j,k]) or (DownCase(v[succ(k7)])=p[j,k]) or (v[k7]='Ä') then begin inc(p7); if p7=21 then { na obrazovku poslednych 21 zapasov } goto 7 end; dec(k7,4); until k7=1; { pole: array[1..46+1] of word; - pozicie 'A' - Ajaxu k7:=1; repeat if (v[k7]=p[j,k]) or (v[succ(k7)]=p[j,k]) or (v[k7]='Ä') then pole[1,2,3,4...]:=k7; inc(k7,4); until k7>n[j]; } k7:=1; 7:p7:=0; repeat inc(p7); if v[k7]='Ä' then begin inc(k7,4); textattr:=16*black+blue; FillChar(w7,29,'Ä'); { zimna prestavka ÄÄÄ WINTER ÄÄÄ } w7[0]:=chr(28); write(w7); { 22 kol vo Svajciarsku a potom je ciara } end; a7:=pos(DownCase(v[k7]),p[j]); inc(k7); b7:=pos(DownCase(v[k7]),p[j]); inc(k7); if (a7=k) or (b7=k) then begin c7:=pred(pos(v[k7],c16)); inc(k7); d7:=pred(pos(v[k7],c16)); inc(k7); if c7>d7 then e7:=2 else if c7=d7 then e7:=1 else e7:=0; if b7=k then e7:=2-e7; textattr:=16*black+f7[e7]; if a7=k then write(DoBodkociarky(j,b7)) else write(' ',DoBodkociarky(j,a7)); gotoxy(18,wherey); textattr:=16*black+lightgray; if a7=k then for j7:=0 to 2 do begin textattr:=16*black+lightgray; if j7=e7 then textattr:=16*black+f7[j7]; write(hex(t[j,b7,2,succ(j7)]),' '); end else for j7:=0 to 2 do begin textattr:=16*black+lightgray; if j7=e7 then textattr:=16*black+f7[j7]; write(hex(t[j,a7,1,succ(j7)]),' ') end; textattr:=16*black+f7[e7]; write(hex(abs(c7-d7)),' '); textattr:=16*black+lightgray; if a7<>k then begin v7:=c7; c7:=d7; d7:=v7; end; write(hex(c7),':'); if wherey<21 then write(hex(d7)) else znak80x25y(hex(d7),lightgray); end else inc(k7,2); until k7>n[j]; window(1,1,80,25); gotoxy(51,25); { aby sa procedura urobila iba raz - pri stlaceni toho isteho pismena predchadzajuce_pismeno:=k; } end; {procedure NovaSezona; var f:text; begin Rok; Load; SciTabulky; c2:=3; assign(f,'Year2006.txt'); rewrite(f); for k:=1 to l do begin writeln(f,' ',d[k,0]); Tabulka2; writeln(f,p[k,u6],' ',d[k,u6]); writeln(f,'01ab00'#13#10); end; close(f); halt; end;} procedure Beep; begin { Write(#7); } Sound(5000); Delay(100); NoSound; end; begin Roky; { Sezony } 0:Load; Assign(f,concat('Year',r,'.txt')); Riadky01; SciTabulky; FotbalHokej; KurzyRemiz; Tutovky; move(s,ss,4000); { prepinanie TABom na: Fotbal 1 - Fotbal 2 - Hokej } 1:Key; if ((sipka='') or (sipka='')) and (length(y)>1) then begin SipkamiHoreDole; Close(f); goto 0; end; if k<>27 then begin if k>l then goto 1 else begin Tabulka; { ukazu sa vysledky posledneho kola s prekvapeniami } j:=k; repeat Key; if k=27 then begin move(ss,s,4000); gotoxy(20,25); goto 1; end; Muzstvo; until false; end; end; Close(f); end. { pouzivat aj asm. instrukcie: NOT AND OR XOR SHL SHR >> rutinu z AMOUSE.COM pre pohyb MYSi v textovom mode << napisat KNIHU "Ako tipujem ja" v Lige Majstrov je 32 muzstiev ! (a..z)&(A..Z) - to je 64 horucich klaves 1. stlacenim F1 - LOAD('readme.txt') - pouzit klavesy SPACE, ... kurzy: MTK - BVCS 1.90 3.25 4.05 fa+2 1X 12 X2 handicap o 1 gol 2. PP: S - Ferencvaros 4:1 ( Slovan ) poharove zapasy 3. Text.mod >>> Gr.mod ukradnut z obrazovky nejeku znakovu sadu cez GEPIXEL pouzit rutinu supertext (z ATARI) & moju znakovu sadu }