Delphi & Pascal (česká wiki)
{ MIESTO.PAS Copyright (c) TrSek alias Zdeno Sekerak } { } { Datum:19.06.1995 http://www.trsek.com } function dmiesto(subor:string;var miesto,oblast:string;vyber:boolean;hlada:integer):integer; var err:integer; fme:file of tmiesto; y,i,ir,x,poc:integer; x1,y1,x2,y2:integer; ch:char; index:array[1..vcisla] of integer; pmiesto:tmiesto; s,s1:string; reg:registers; begin case subor[2] of 'i': assign(fme,'miesto'); 'e': assign(fme,'mesto'); 'r': assign(fme,'kraj'); end; {$I-} reset(fme); err:=ioresult; if err<>0 then begin rewrite(fme); err:=ioresult; end; {$I+} if err<>0 then hlaska('Chyba z pisu na disk. Pracovně disk chr neně proti z pisu.',0); { Nasiel co hladal ak bol vstup vyplneny cislom } if (hlada<>0) then for i:=1 to filesize(fme) do begin seek(fme,i-1); read(fme,pmiesto); if not(pmiesto.del) then if hlada=pmiesto.typ_miest then begin miesto:=pmiesto.miesto;oblast:=pmiesto.oblast; dmiesto:=pmiesto.typ_miest; close(fme);exit; end; end; { zoscanuje predoslu obrazovku } if subor<>'miesto' then begin if subor='mesto' then ir:=0 else ir:=2; x1:=xw1;y1:=yw1;x2:=xw2;y2:=yw2; owindow(1,1,80,25); for i:=2 to 80 do for y:=2 to 23 do begin gotoxy(i,y); reg.ah:=8; reg.bh:=0; intr($10,reg); strana[ir+1,i,y]:=reg.ah; strana[ir+2,i,y]:=reg.al; end; end; farba(pomest,fomest); case subor[2] of 'i': okno(2,2,76,23,' Miesto -ulica ÄÄÄÄÄÄÄÄÄ Jeho oblas? ', 'ESC-Opusti ENTER [prvě] Ozna>-ENTER [druhě]-Věber Pohyb-ćĄpkami',pomest); 'e': okno(4,2,78,23,' Mesto ÄÄÄÄÄÄÄÄÄ Jeho oblast ', 'ESC-Opusti ENTER [prvě] Ozna>-ENTER [druhě]-Věber Pohyb-ćĄpkami',pomest); 'r': okno(6,2,80,23,' Kraj - oblast ÄÄÄÄÄÄÄÄÄ Jeho oblast ', 'ESC-Opusti ENTER [prvě] Ozna>-ENTER [druhě]-Věber Pohyb-ćĄpkami',pomest); end; farba(pnmest,fnmest);ir:=1; for i:=1 to vcisla do index[i]:=0; for i:=1 to filesize(fme) do begin seek(fme,i-1); read(fme,pmiesto); if not(pmiesto.del) then if ir<19 then begin index[ir]:=i; gotoxy(2,ir);write(pmiesto.typ_miest:3,'-',pmiesto.miesto,' ',pmiesto.oblast,' '); ir:=ir+1; end; end; poc:=i; if vyber then i:=ir-1 else i:=ir; if i<1 then i:=1; ch:=#1;x:=1;ir:=0;err:=1; repeat if err in [1,2] then begin if err in [1] then err:=0; end else ch:=readkey; if (ch=#0) or (err=2) then begin farba(pnmest,fnmest); gotoxy(2,i);write(pmiesto.typ_miest:3,'-',pmiesto.miesto,' ',pmiesto.oblast); if err=2 then err:=0 else ch:=readkey; case ch of #83:begin pmiesto.del:=not(pmiesto.del); if pmiesto.del then hlaska(' Ozna>eně na vymazanie. ',70) else hlaska(' Vymazanie zruçen,. ',70); seek(fme,index[i+ir]-1);write(fme,pmiesto); end; #72:begin x:=x-1; if x<1 then begin x:=2;i:=i-1;if i<1 then begin gotoxy(1,1);insline;i:=1;ir:=ir-1;end; if ir<0 then begin ir:=0;x:=1;delline;end; end; end; #80:begin x:=x+1;if x>2 then if (pmiesto.oblast=nothing(sizeof(pmiesto.oblast)-1)) or (pmiesto.miesto=nothing(sizeof(pmiesto.miesto)-1)) then hlaska(' Dalej nemozes najprv vypln oblas, pmiesto.',70) else begin x:=1;i:=i+1; if i>19 then begin gotoxy(1,1);delline;i:=19;ir:=ir+1;end; if index[i+ir]=0 then begin index[i+ir]:=filesize(fme)+1; pmiesto.typ_miest:=filesize(fme)+1; pmiesto.oblast:=nothing(sizeof(pmiesto.oblast)); pmiesto.miesto:=nothing(sizeof(pmiesto.miesto)); pmiesto.del:=false; end; end; end; else if x=1 then pmiesto.miesto:=tread(6,i,sizeof(pmiesto.miesto)-1,pmiesto.miesto,'',#13,#13); end; ch:=#0; end; if (index[i+ir]<=filesize(fme)) and (index[i+ir]<>0) then begin seek(fme,index[i+ir]-1);read(fme,pmiesto); end else begin if pmiesto.oblast<>nothing(sizeof(pmiesto.oblast)-1) then begin pmiesto.typ_miest:=filesize(fme)+1; pmiesto.del:=false; pmiesto.oblast:=nothing(sizeof(pmiesto.oblast)-1); pmiesto.miesto:=nothing(sizeof(pmiesto.miesto)-1); end else index[i+ir]:=filesize(fme)+1; end; farba(pnmest,fnmest); gotoxy(2,i);write(pmiesto.typ_miest:3,'-',pmiesto.miesto,' ',pmiesto.oblast); if pmiesto.del then write(' D') else write(' '); if x=1 then begin farba(pvmest,fvmest);gotoxy(6,i);write(pmiesto.miesto);gotoxy(6,i);end else begin farba(pvmest,fvmest);gotoxy(6+sizeof(pmiesto.miesto),i);write(pmiesto.oblast); gotoxy(7+sizeof(pmiesto.miesto),i);end; if (not(vyber) and (ch in ['A'..'z',#13])) or (vyber and (ch in ['A'..'z',#13])) then begin if x=1 then pmiesto.miesto:=tread(6,i,sizeof(pmiesto.miesto)-1,pmiesto.miesto,'',#13,ch) else begin if subor='miesto' then begin pmiesto.cis_obl:=dmiesto('mesto',s1,s,true,0);pmiesto.oblast:=s1;;end; if subor='mesto' then begin pmiesto.cis_obl:=dmiesto( 'kraj',s1,s,true,0);pmiesto.oblast:=s1;;end; if subor='kraj' then begin pmiesto.cis_obl:=1;pmiesto.oblast:='Slovensko';end; end; err:=2; if not(vyber) then ch:=#80; if x=1 then begin farba(pnmest,fvmest);gotoxy(6,i);write(pmiesto.miesto);gotoxy(6,i);end else begin farba(pnmest,fvmest);gotoxy(6+sizeof(pmiesto.miesto),i);write(pmiesto.oblast);end; end; if not(pmiesto.oblast=nothing(sizeof(pmiesto.oblast)-1)) then begin seek(fme,index[i+ir]-1);write(fme,pmiesto); end; miesto:=pmiesto.miesto;oblast:=pmiesto.oblast; until ((ch=#27) or (vyber and (x=1) and (ch in [#13]))); close(fme); dmiesto:=pmiesto.typ_miest; if subor<>'miesto' then begin owindow(1,1,80,25); for i:=2 to 80 do for y:=2 to 23 do begin if subor='mesto' then ir:=0 else ir:=2; gotoxy(i,y); reg.ah:=$9; reg.bh:=0; reg.al:=strana[ir+2,i,y]; reg.bl:=strana[ir+1,i,y]; reg.cx:=1; intr($10,reg); end; end; owindow(x1,y1,x2,y2); end;