Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by Conteo ( 16 years ago )
program lab3;
uses crt;
const
menu_igr: array [1..4] of string=('Add','Delete', 'Change places', 'Continue');
menu_ch: array [1..3] of string=('Siva-Iva','Yagodka', 'Eniki');
Type
Pn = ^Note;
Note = Record
info: string[6];
next: pn;
End;
var
p: pointer;
B, C, E, tmp: pn;
i,j,k,k1,k2,count,l,kurs,shift:longint;
ch:char;
x,y,vid,kol_ch,g:byte;
add,temp1,temp2:string[6];
name:string[6];
flag, flag_menu, flag_scroll,bool:boolean;
schit: array [1..20] of string;
procedure help;
begin
Window(55,39,79,44);
Textbackground(1);
ClrScr;
gotoxy(10,1);
Textcolor(2);
Writeln('Help');
Write(#24,#25);
Textcolor(15);
Writeln(' - press to use scroll');
Textcolor(2);
Write('Delete');
Textcolor(15);
Writeln(' - press to delete the element');
Textcolor(2);
Write('Insert');
Textcolor(15);
Writeln(' - press to add theelement');
end;
procedure output;
begin
C:=B;
Window(5,5,25,35);
clrscr;
while C<>nil do
begin
writeln(C^.info);
C:=C^.next;
end;
gotoxy(1,kurs);
end;
procedure memav;
begin
window(1,1,80,55);
Window(71,1,79,2);
ClrScr;
Writeln(count);
Write(memavail);
window(1,1,80,50);
end;
procedure scrolling;
begin
begin
textbackground(1);
Window(5,5,25,35);
clrscr;
C:=B;
i:=0;
while i<30 do
begin
write(C^.info);
writeln;
C:=C^.next;
inc(i);
end;
C:=nil;
kurs:=1;
gotoxy(1,kurs);
shift:=0;
repeat
ch:=readkey;
if ch=#0 then ch:=readkey;
case ch of
#80:begin
if (kurs>=count) then continue;
if (kurs+shift)>count then continue;
if kurs<30
then
begin
inc(kurs);
gotoxy(1,kurs);
end
else
begin
inc(shift);
if kurs+shift>count
then
begin
dec(shift);
continue;
end;
textbackground(1);
clrscr;
C:=B;
i:=0;
for i:=1 to 30+shift do
begin
if C=nil then break;
if i>=shift
then
write(C^.info);
writeln;
C:=C^.next;
end;
end;
gotoxy(1,kurs);
end;
#72:begin
textbackground(1);
if (kurs<=30) and (kurs>1)
then
begin
dec(kurs);
gotoxy(1,kurs);
continue;
end;
if (kurs=1) and (shift>0)
then
begin
dec(shift);
textbackground(1);
clrscr;
C:=B;
for i:=1 to 30+shift do
begin
if C=nil then break;
if i>=shift
then
write(C^.info);
writeln;
C:=C^.next;
end;
gotoxy(1,kurs);
end;
end;
#83:If count>1 then
begin
ClrScr;
if (shift=0) and (kurs<=32)
then
begin
if (kurs=1)
then
begin
tmp:=B;
B:=B^.next;
dispose(tmp);
dec(count);
memav;
Window(5,5,25,35);
clrscr;
C:=B;
i:=0;
while (i<32) and (C<>nil) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
i:=0;
kurs:=1;
gotoxy(1,kurs);
end
else
begin
C:=B;
i:=0;
while i<kurs do
begin
C:=C^.next;
inc(i);
end;
tmp:=C^.next;
C^.next:=C^.next^.next;
dispose(tmp);
dec(count);
memav;
Window(5,5,25,35);
clrscr;
i:=0;
C:=B;
while (i<32) and (i<count) and (C<>nil) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
gotoxy(1,kurs);
end;
end;
if (shift>0)
then
begin
k:=shift+kurs;
if k=count
then
begin
i:=0;
C:=B;
while count-2<>i do
begin
C:=C^.next;
inc(i);
end;
dispose(C^.next);
C^.next:=nil;
dec(count);
dec(shift);
if shift<0 then shift:=0;
memav;
output;
gotoxy(1,kurs);
continue;
end
else
begin
i:=0;
C:=B;
while k-2<>i do
begin
C:=C^.next;
inc(i);
end;
i:=0;
tmp:=C^.next;
C^.next:=C^.next^.next;
dispose(tmp);
dec(count);
shift:=1;
kurs:=1;
memav;
Window(5,5,25,35);
clrscr;
C:=B;
while (C<>nil) and (i<32) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
gotoxy(1,kurs);
end;
end;
end;
#82:If maxavail>15 then
begin
C:=B;
while C^.next<>nil do
begin
C:=C^.next;
end;
new(E);
C^.next:=E;
E^.next:=nil;
inc(count);
window(1,1,80,50);
window(30,30,50,32);
clrscr;
add:='';
For g:=1 to 6 do
begin
ch:=readkey;
if ch in ['a'..'z'] then
begin
add:=add+ch;
write(ch);
end
else
g:=g-1;
If g>1 then
If ch=#13 then g:=6;
end;
E^.info:=add;;
textbackground(0);
clrscr;
window(1,1,80,50);
textbackground(1);
Window(5,5,25,35);
clrscr;
memav;
kurs:=30;
shift:=(count-30);
output;
end;
End;
until (ch=#27);
end;
end;
begin
mark(p);
textmode(c80+font8x8);
Window(1,1,80,50);
Textbackground(0);
ClrScr;
gotoxy(25,20);
Textcolor(4);
Write('Press any key to start');
Readkey;
ClrScr;
count:=0;
textbackground(0);
clrscr;
memav;
Randomize;
B:=nil;
C:=nil;
Window(5,5,25,35);
Textbackground(1);
ClrScr;
Repeat
memav;
window(5,5,25,35);
clrscr;
name:='';
i:=random(10)+1;
Case i of
1: name:='Maksim';
2: name:='Sasha';
3: name:='Sergey';
4: name:='Vadim';
5: name:='Misha';
6: name:='Dima';
7: name:='Rinat';
8: name:='Klava';
9: name:='Nikita';
10: name:='Olga';
End;
Textbackground(1);
Textcolor(15);
New(E);
E^.next:= nil;
if (count>32) and (count<36) then E^.info:='Mbugoga' else E^.info:= name;
If C=nil then
Begin
B:=E;
C:=B;
End
else
C^.next:=E;
C:=B;
While C<>nil do
Begin
Writeln(C^.info);
C:=C^.next;
End;
C:=E;
inc(count);
Until (maxavail<15) or (keypressed);
help;
scrolling;
help;
Repeat
Window(40,12,49,14);
Textbackground(1);
ClrScr;
x:=2;
y:=1;
For i:= 1 to 3 do
Begin
If i=1 then TextAttr:=$2F
else
TextAttr:=$1F;
gotoxy(x,y);
Write(menu_ch[i]);
inc(y);
End;
ch:=#0;
y:=1;
While ch<>#13 do
Begin
ch:=readkey;
If ch=#0 then ch:=readkey;
Case ch of
#72: Begin
gotoxy(x,y);
TextAttr:=$1F;
Write( menu_ch[y]);
If y=1 then y:=3
else dec(y);
End;
#80: Begin
gotoxy(x,y);
TextAttr:=$1F;
Write( menu_ch[y]);
If y=3 then y:=1
else inc(y);
End;
End;
gotoxy(x,y);
TextAttr:=$2F;
Write(menu_ch[y]);
End;
Case y of
1: Begin
schit[1]:='Siva'; schit[2]:=', '; schit[3]:='iva'; schit[4]:=', ';
schit[5]:='Duba'; schit[6]:=', '; schit[7]:='klen'; schit[8]:=', ';
schit[9]:='Shuga'; schit[10]:='-'; schit[11]:='Uga'; schit[12]:=', ';
schit[13]:='Vushel'; schit[14]:=', '; schit[15]:='von'; schit[16]:='.';
kol_ch:=16;
End;
2: Begin
schit[1]:='Yagodka'; schit[2]:=' '; schit[3]:='malinka'; schit[4]:=' ';
schit[5]:='Medok'; schit[6]:=' '; schit[7]:='saxarok'; schit[8]:=' ';
schit[9]:='Vushel'; schit[10]:=' '; schit[11]:='Ivanuska'; schit[12]:=' ';
schit[13]:='Sam'; schit[14]:=' '; schit[15]:='korolek'; schit[16]:='.';
kol_ch:=16;
End;
3: Begin
schit[1]:='Eniki'; schit[2]:='-'; schit[3]:='beniki'; schit[4]:=' ';
schit[5]:='eli'; schit[6]:=' '; schit[7]:='vareniki'; schit[8]:=' ';
schit[9]:='Eniki'; schit[10]:='-'; schit[11]:='beniki'; schit[12]:=' ';
schit[13]:='klez'; schit[14]:=' '; schit[15]:='Vushel'; schit[16]:=' ';
schit[17]:='sovetskiy'; schit[18]:=' '; schit[19]:='matros'; schit[20]:='.';
kol_ch:=20;
End;
End;
Until true;
Window(1,1,70,1);
Textbackground(1);
ClrScr;
For i:= 1 to kol_ch do
Write(schit[i]);
Readkey;
Window(5,5,25,35);
clrscr;
C:=B;
i:=0;
while i<30 do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
C:=nil;
kurs:=1;
gotoxy(1,kurs);
shift:=0;
vid:=0;
Repeat
Window(5,5,25,35);
bool:=keypressed;
If count>30 then
begin
if (kurs>=count) then continue;
if (kurs+shift)>count then continue;
if kurs<30 then
begin
inc(kurs);
gotoxy(1,kurs);
end
else
begin
inc(shift);
if kurs+shift>count then
begin
dec(shift);
continue;
end;
textbackground(1);
clrscr;
C:=B;
i:=0;
for i:=1 to 30+shift do
begin
If C=nil then break;
if i>=shift then write(C^.info);
Writeln;
C:=C^.next;
end;
End;
End
else
begin
for i:=1 to count do
begin
If C=nil then break;
write(C^.info);
Writeln;
C:=C^.next;
end;
If kurs=count then
begin
kurs:=1;
C:=B;
break;
end;
end;
gotoxy(1,kurs);
Window(1,1,70,1);
Textbackground(1);
inc(vid);
For x:= 1 to kol_ch do
Begin
If (x=vid) and (length(schit[x])>=3) then
Begin
Textbackground(4);
Write(schit[x]);
Delay(3000);
End
else
Write(schit[x]);
Textbackground(1);
If x=kol_ch then break;
C:=C^.next;
If kurs<30 then inc(kurs)
else inc(shift);
If C=nil then
begin
kurs:=1;
shift:=0;
C:=B;
end;
End;
If (vid=kol_ch) and (length(C^.info)<8) then
Begin;
Window(1,1,80,50);
Textbackground(0);
Textcolor(2);
gotoxy(40,25);
ClrEol;
Write(C^.info, ' is the winner');
Textbackground(1);
Textcolor(15);
End;
If (vid=kol_ch) and (count<>5) then
Begin
if (shift=0) and (kurs<=32)
then
begin
if (kurs=1)
then
begin
tmp:=B;
B:=B^.next;
dispose(tmp);
dec(count);
memav;
Window(5,5,25,35);
clrscr;
C:=B;
i:=0;
while (i<32) and (C<>nil) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
i:=0;
kurs:=1;
gotoxy(1,kurs);
end
else
begin
C:=B;
i:=0;
while i<kurs do
begin
C:=C^.next;
inc(i);
end;
tmp:=C^.next;
C^.next:=C^.next^.next;
dispose(tmp);
dec(count);
memav;
Window(5,5,25,35);
clrscr;
i:=0;
C:=B;
while (i<32) and (i<count) and (C<>nil) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
gotoxy(1,kurs);
end;
end;
if (shift>0)
then
begin
k:=shift+kurs;
if k=count
then
begin
i:=0;
C:=B;
while count-2<>i do
begin
C:=C^.next;
inc(i);
end;
dispose(C^.next);
C^.next:=nil;
dec(count);
dec(shift);
if shift<0 then shift:=0;
memav;
output;
gotoxy(1,kurs);
continue;
end
else
begin
i:=0;
C:=B;
while k-2<>i do
begin
C:=C^.next;
inc(i);
end;
i:=0;
tmp:=C^.next;
C^.next:=C^.next^.next;
dispose(tmp);
dec(count);
shift:=1;
kurs:=1;
memav;
Window(5,5,25,35);
clrscr;
C:=B;
while (C<>nil) and (i<32) do
begin
writeln(C^.info);
C:=C^.next;
inc(i);
end;
gotoxy(1,kurs);
end;
end;
End;
If vid>=kol_ch then vid:=0;
Delay(1000);
If (count<=30) then
Begin
shift:=0;
output;
gotoxy(1,kurs);
End;
Until (count=5) or (bool=true);
Window(1,1,80,50);
Textbackground(0);
Textcolor(4);
gotoxy(40,25);
ClrEol;
Write(C^.info, ' is the loser');
Readkey;
Readkey;
Release(p);
end.
Revise this Paste