Добавил:
korayakov
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:SALAST / HOAR
.PASuses crt,dos;
const
up = #72;
down = #80;
left = #75;
right = #77;
enter = #13;
Type PMas = ^TMas;
TMas = Array [1..30002] Of Word;
var
mas : PMas;
i : byte;
LengthW : word;
Diap : word;
direct : byte;
{==============================}
procedure cursor_off;
begin
asm
mov ch,4
mov cl,0
mov ah,01h
int 10h
end;
end;
{=========================================}
procedure cursor_on;
begin
asm
mov ch,4
mov cl,4
mov ah,01h
int 10h
end;
end;
{=========================================}
procedure background(x1,y1,x2,y2,color:byte;top:string);
var
x,y,i:byte;
begin
x:=x2-x1+1;
y:=y2-y1+2;
window(x1,y1,x2,y2);
textbackground(color);
clrscr;
textcolor(white);
gotoxy(2,1);
write('Й');
gotoxy(x-1,y-1);
write('ј');
gotoxy(x-1,1);
write('»');
gotoxy(2,y-1);
write('И');
for i:=3 to x-2 do
begin
gotoxy(i,1);
write('Н');
gotoxy(i,y-1);
write('Н');
end;
for i:=2 to y-2 do
begin
gotoxy(2,i);
write('є');
gotoxy(x-1,i);
write('є');
end;
gotoxy((x-length(top)) div 2+1,1);
write(top);
end;
{========================================}
procedure main_menu(pos:byte);
var
c1,c2,c3,c4,c5:byte;
begin
c1:=blue;
c2:=blue;
c3:=blue;
c4:=blue;
c5:=blue;
case pos of
1:c1:=red;
2:c2:=red;
3:c3:=red;
4:c4:=red;
5:c5:=red;
end;
gotoxy(26,5);
textbackground(c1);
write(' ‡Ђ„ЂЌ€… ЏЂђЂЊ…’ђЋ‚ ЊЂ‘‘€‚Ђ ');
gotoxy(27,8);
textbackground(c2);
write(' ѓ…Ќ…ђЂ–€џ ЌЋ‚ЋѓЋ ЊЂ‘‘€‚Ђ ');
gotoxy(31,11);
textbackground(c3);
write(' ЏђЋ‘ЊЋ’ђ ЊЂ‘‘€‚Ђ ');
gotoxy(24,14);
textbackground(c4);
write(' ‡Ђ„ЂЌ€… ЏЂђЂЊ…’ђЋ‚ ‘Ћђ’€ђЋ‚Љ€ ');
gotoxy(34,17);
textbackground(c5);
write(' ‘Ћђ’€ђЋ‚ЉЂ ');
gotoxy(33,24);
textbackground(blue);
write('‚л室 - <ESC>');
end;
{=========================================}
function main_menu_work(p:byte):byte;
var
pos,i:byte;
c:char;
begin
background(1,1,80,25,blue,' Ћ‘ЌЋ‚ЌЋ… Њ…Ќћ ');
main_menu(p);
pos:=p;
repeat
c:=readkey;
if c=#0 then c:=readkey;
case c of
up: begin
dec(pos);
if pos = 0 then pos:=5;
main_menu(pos);
end;
down:begin
inc(pos);
if pos = 6 then pos:=1;
main_menu(pos);
end;
#27:begin
pos:=22;
c:=#13;
end;
end;
until c=#13;
main_menu_work:=pos;
end;
{================================}
procedure param_menu(pos:byte);
var
c1,c2:byte;
begin
c1:=green;
c2:=c1;
case pos of
1:c1:=red;
2:c2:=red;
end;
gotoxy(5,3);
textbackground(green);
write('Љ®«-ў® н«Ґ¬Ґв®ў (<30000) : ');
textbackground(c1);
write(LengthW:5);
gotoxy(8,5);
textbackground(green);
write('„Ё Ї §® (1..65000) : 1..');
textbackground(c2);
write(diap:5);
gotoxy(15,10);
textbackground(green);
write('‚л室 - <ESC>');
gotoxy(11,9);
write('‚лЎ®а/‚лў®¤ - <Enter>');
end;
{================================}
procedure param_work;
var
pos,i:byte;
c:char;
begin
pos:=1;
background(20,4,60,14,green,' ‡Ђ„ЂЌ€… ЏЂђЂЊ…’ђЋ‚ ');
param_menu(pos);
repeat
c:=readkey;
if c=#0 then c:=readkey;
case c of
up: begin
case pos of
1:pos:=2;
2:pos:=1;
end;
param_menu(pos);
end;
down:begin
case pos of
1:pos:=2;
2:pos:=1;
end;
param_menu(pos);
end;
enter:case pos of
1:begin
gotoxy(33,3);
textbackground(red);
write(' ');
gotoxy(33,3);
cursor_on;
readln(LengthW);
cursor_off;
param_menu(pos);
end;
2:begin
gotoxy(33,5);
textbackground(red);
write(' ');
gotoxy(33,5);
cursor_on;
readln(diap);
cursor_off;
param_menu(pos);
end;
end;
end;
until c=#27;
end;
{================================}
procedure generation;
var
i:word;
begin
randomize;
for i:=1 to LengthW do
mas^[i]:=random(diap);
background(25,6,55,18,brown,' ѓ…Ќ…ђЂ–€џ ЊЂ‘‘€‚Ђ ');
textcolor(white);
gotoxy(4,3);
write('Ќ®ўл© ¬ ббЁў бЈҐҐаЁа®ў ');
gotoxy(5,6);
write('Љ®«-ў® н«Ґ¬Ґв®ў - ',LengthW);
gotoxy(9,8);
write('„Ё Ї §® - ',diap);
gotoxy(9,12);
write('Ќ ¦¬ЁвҐ <Enter>');
readln;
end;
{================================}
procedure prosmotr;
label from,opat;
var
i,j:byte;
s:word;
c:char;
begin
s:=0;
opat:background(1,1,80,25,green,' ЏђЋ‘ЊЋ’ђ ЊЂ‘‘€‚Ђ ');
for i:=2 to 22 do
begin
gotoxy(4,i);
for j:=1 to 12 do
begin
inc(s);
write(mas^[s]:6);
if s=LengthW then goto from;
end;
end;
from:if s=LengthW then
begin
gotoxy(34,24);
write('‚л室 - <ESC>');
repeat
c:=readkey;
if c=#0 then c:=readkey;
until c=#27;
end
else
begin
gotoxy(22,24);
write('Џа®¤®«¦ҐЁҐ - <Enter>,‚л室 - <ESC>');
repeat
c:=readkey;
if c=#0 then c:=readkey;
case c of
#13:goto opat;
end;
until c=#27;
end;
end;
{================================}
procedure param_sort_menu(pos:byte);
var
c1,c2:byte;
begin
c1:=magenta;
c2:=c1;
case pos of
1:c1:=red;
2:c2:=red;
end;
gotoxy(5,4);
textbackground(c1);
write(' Џ® ў®§а бв Ёо ');
textbackground(magenta);
gotoxy(23,4);
write('[ ]');
gotoxy(5,8);
textbackground(c2);
write(' Џ® гЎлў Ёо ');
textbackground(magenta);
gotoxy(23,8);
write('[ ]');
gotoxy(10,14);
textbackground(magenta);
write('‚л室 - <ESC>');
gotoxy(9,13);
write('‚лЎ®а - <Enter>');
textbackground(magenta);
gotoxy(24,4+4*(direct-1));
write('X');
end;
{================================}
procedure param_sort;
var
pos,i:byte;
c:char;
begin
pos:=1;
background(25,4,55,18,magenta,' ЏЂђЂЊ…’ђ› ‘Ћђ’€ђЋ‚Љ€ ');
param_sort_menu(pos);
repeat
c:=readkey;
if c=#0 then c:=readkey;
case c of
up: begin
dec(pos);
if pos=0 then pos:=2;
param_sort_menu(pos);
end;
down:begin
inc(pos);
if pos=3 then pos:=1;
param_sort_menu(pos);
end;
enter:begin
direct:=pos;
param_sort_menu(pos);
end;
end;
until c=#27;
end;
{================================}
function sort_forw(beg,fin:word):integer;
label end1;
var
i,help,k,l:word;
z:shortint;
begin
k:=beg;
l:=fin;
z:=-1;
for i:=1 to fin-beg do
if z=-1 then
if mas^[k]>mas^[l] then
begin
help:=mas^[k];
mas^[k]:=mas^[l];
mas^[l]:=help;
help:=k;
k:=l;
l:=help+1;
z:=z*(-1);
end
else begin dec(l); end
else
if mas^[k]<mas^[l] then
begin
help:=mas^[k];
mas^[k]:=mas^[l];
mas^[l]:=help;
help:=k;
k:=l;
l:=help-1;
z:=z*(-1);
end
else begin inc(l); end;
if (k=beg) and (k<fin-1) then
begin
sort_forw:=1;
goto end1;
end;
if (k=beg+1) and (k<fin-1) then
begin
sort_forw:=2;
goto end1;
end;
if (k=fin) and (k>beg+1) then
begin
sort_forw:=3;
goto end1;
end;
if (k=fin-1) and (k>beg+1) then
begin
sort_forw:=4;
goto end1;
end;
if (k>=fin-1) and (k<=beg+1) then
begin
sort_forw:=0;
goto end1;
end;
l:=k;
repeat
help:=sort_forw(k+1,fin);
case help of
1:inc(k);
2:k:=k+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
k:=l;
repeat
help:=sort_forw(beg,k-1);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(k);
4:k:=k-2;
end;
until help=0;
sort_forw:=0;
end1:
end;
{================================}
function sort_back(beg,fin:word):integer;
label end1;
var
i,k,l,help:word;
z:shortint;
begin
k:=beg;
l:=fin;
z:=-1;
for i:=1 to fin-beg do
if z=-1 then
if mas^[k]<mas^[l] then
begin
help:=mas^[k];
mas^[k]:=mas^[l];
mas^[l]:=help;
help:=k;
k:=l;
l:=help+1;
z:=z*(-1);
end
else begin dec(l); end
else
if mas^[k]>mas^[l] then
begin
help:=mas^[k];
mas^[k]:=mas^[l];
mas^[l]:=help;
help:=k;
k:=l;
l:=help-1;
z:=z*(-1);
end
else begin inc(l); end;
if (k=beg) and (k<fin-1) then
begin
sort_back:=1;
goto end1;
end;
if (k=beg+1) and (k<fin-1) then
begin
sort_back:=2;
goto end1;
end;
if (k=fin) and (k>beg+1) then
begin
sort_back:=3;
goto end1;
end;
if (k=fin-1) and (k>beg+1) then
begin
sort_back:=4;
goto end1;
end;
if (k>=fin-1) and (k<=beg+1) then
begin
sort_back:=0;
goto end1;
end;
l:=k;
repeat
help:=sort_back(k+1,fin);
case help of
1:inc(k);
2:k:=k+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
k:=l;
repeat
help:=sort_back(beg,k-1);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(k);
4:k:=k-2;
end;
until help=0;
sort_back:=0;
end1:
end;
{================================}
procedure sort;
var
h1,m1,s1,s1001,h2,m2,s2,s1002:word;
help:integer;
beg,fin:word;
begin
h1:=0;
m1:=0;
s1:=0;
s1001:=0;
h2:=0;
m2:=0;
s2:=0;
s1002:=0;
background(24,3,57,22,red,' ‘Ћђ’€ђЋ‚ЉЂ ');
gotoxy(6,3);
write('‘®авЁа®ўЄ ¬Ґв®¤®¬ •® а ');
gotoxy(15,6);
textcolor(yellow);
write('ЊЂ‘‘€‚');
gotoxy(6,8);
textcolor(white);
write('Љ®«-ў® н«Ґ¬Ґв®ў - ',LengthW);
gotoxy(9,10);
write('„Ё Ї §® - 1..',diap);
textcolor(yellow);
gotoxy(6,13);
case direct of
1:write('‘Ћђ’€ђЋ‚ЉЂ ЏЋ ‚Ћ‡ђЂ‘’ЂЌ€ћ');
2:write('‘Ћђ’€ђЋ‚ЉЂ ЏЋ “Ѓ›‚ЂЌ€ћ');
end;
textcolor(white);
gotoxy(5,16);
write('‚६п б®авЁа®ўЄЁ - ');
beg:=1;
fin:=LengthW;
case direct of
1:begin
gettime(h1,m1,s1,s1001);
repeat
help:=sort_forw(beg,fin);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
gettime(h2,m2,s2,s1002);
end;
2:begin
gettime(h1,m1,s1,s1001);
repeat
help:=sort_back(beg,fin);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
gettime(h2,m2,s2,s1002);
end;
end;
h2:=h2-h1;
if m2>=m1 then
m2:=m2-m1
else
begin
dec(h2);
m2:=60-(m1-m2);
end;
if s2>=s1 then
s2:=s2-s1
else
begin
dec(m2);
s2:=60-(s1-s2);
end;
if s1002>=s1001 then
s1002:=s1002-s1001
else
begin
dec(s2);
s1002:=100-(s1001-s1002);
end;
write(m2:2,'.');
if s2<10 then write('0',s2,'.')
else write(s2,'.');
if s1002<10 then write('0',s1002)
else write(s1002);
gotoxy(11,19);
write('Ќ ¦¬ЁвҐ <Enter>');
readln;
end;
{================================}
begin
New(Mas);
LengthW:=1000;
diap:=10000;
direct:=1;
i:=1;
cursor_off;
repeat
i:=main_menu_work(i);
case i of
1:param_work;
2:generation;
3:prosmotr;
4:param_sort;
5:sort;
end;
until i=22;
textbackground(black);
clrscr;
Dispose(Mas);
end.
Соседние файлы в папке SALAST