30a66 Паскаль. P.42. Гнездо задач. Задачи на распознование. Сборник задач по программированию Александра Приходько
 

Сборник задач по программированию. Старая версия

 

 Приходько А. Н.

 
примеры, xml, образование, язык программирования, сборник, java, язык программирования
 

Паскаль. P.42. Гнездо задач. Задачи на распознование



Вопрос к задачам данного гнезда.
Выберите номер пункта, соответствующий назначению данной программы. Это :

1. Текстовый редактор
2. Графический редактор
3. Архиватор (сжатие)
4. Архиватор (разархивирование)
5. Электронная таблица
6. Игра «Перебежать по доскам»
7. Игра «Тир»
8. Объединение 2-х файлов
9. Разбиение файла
10. Поиск в текстовом файле
11. Программа очистки экрана дисплея
12. Резидентная программа очистки экрана дисплея
13. Игра «Гусеница - пожирательница цифр»
14. Сортировка файла чисел
15. Рисование спирали
16. Программа уничтожения всех файлов в текущем подкаталоге
17. Простейшая надстройка над ДОС
18. Программа рисования шахматной доски
19. Игра «Тараканьи бега»
20. Инвертирование цветов на экране дисплея в графическом режиме
21. Программа «Секундомер»
22. Программа «Бегущий человечек»
23. Программа «Подпрыгивающий символ»

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.1    Ответы


Program AA;
uses crt, dos;
var
    r : registers;
    x, y : integer;
    f : file of char;
    Mas : array[1..2000] of char;
    i, j : integer;
    ch1, ch2 : char;
begin
    for i:=1 to 2000 do Mas[i]:=’ ‘;
    clrscr;    x:=1;    y:=1;
    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (y>1) then y:=y-1;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (y<25) then y:=y+1;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (x>1) then x:=x-1;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (x<80) then x:=x+1;
if (lo(r.ax)<>0) and (lo(r.ax)<>8) and (lo(r.ax)<>13) and
(lo(r.ax)<>27) then begin
            write(chr(lo(r.ax)));
            Mas[(y-1)*80+x]:=chr(lo(r.ax));
            x:=x+1;
            if x=81 then begin
                x:=1;    y:=y+1;
            end;
            if y=26 then begin x:=1; y:=1; end;
        end;
        gotoxy(x,y);
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    ch1:=chr($0a);    ch2:=chr($0d);
    assign(f,’aaa.txt’);    rewrite(f);
    for i:=1 to 25 do begin
        for j:=1 to 80 do write(f,Mas[(i-1)*80+j]);
        write(f,ch1);    write(f,ch2);
    end;
    close(f);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.2    Ответы


Program AA;
uses crt, dos, graph;
var
    r : registers;
    xx, yy : integer;
    Gd, Gm : integer;
    MLeft, MRight, MUp, MDown : array[0..6] of integer;
procedure X1;
begin
    SetColor(Black);
    Line(xx-9,yy,xx-3,yy);
    Line(xx+3,yy,xx+9,yy);
    Line(xx,yy-9,xx,yy-3);
    Line(xx,yy+3,xx,yy+9);
end;

procedure X3;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do MLeft[ii-xx+9]:=GetPixel(ii,yy);
    for ii:=xx+3 to xx+9 do MRight[ii-xx-3]:=GetPixel(ii,yy);
    for ii:=yy-9 to yy-3 do MUp[ii-yy+9]:=GetPixel(xx,ii);
    for ii:=yy+3 to yy+9 do MDown[ii-yy-3]:=GetPixel(xx,ii);
end;
procedure X4;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do PutPixel(ii,yy,MLeft[ii-xx+9]);
    for ii:=xx+3 to xx+9 do PutPixel(ii,yy,MRight[ii-xx-3]);
    for ii:=yy-9 to yy-3 do PutPixel(xx,ii,MUp[ii-yy+9]);
    for ii:=yy+3 to yy+9 do PutPixel(xx,ii,MDown[ii-yy-3]);
end;
begin
    Gd:=Detect;    InitGraph(Gd,Gm,’’);
    SetFillStyle(SolidFill,White);
    Bar(0,0,GetMAxX,GetMaxY);
    xx:=GetMaxX div 2;    yy:=GetMaxY div 2;
    X3;    X1;
    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (yy>10) then begin
            X4;    yy:=yy-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (yy             X4;    yy:=yy+1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (xx>10) then begin
            X4;    xx:=xx-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (xx             X4;    xx:=xx+1;    X3;    X1;
        end;
if (lo(r.ax)=32) and (hi(r.ax)=57) then begin
            if GetPixel(xx,yy)<>Black then
                PutPixel(xx,yy,Black)
            else
                PutPixel(xx,yy,White);
        end;
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    closegraph;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.3    Ответы


Program AA;
type
    tt = string[5];
var
    Mas : array[1..255] of tt;
    col, i, j, bb : byte; str : tt; nn1, nn2 : string;
    f1, f2 : file of byte;
function X1(st : tt) : integer;
var
    n, i : integer;
begin
    i:=1;    n:=0;
    while (i<=col) and (n=0) do
        if Mas[i]=st then n:=i
        else i:=i+1;
    X1:=n;
end;
procedure X2(st : tt);
begin
    col:=col+1;
    Mas[col]:=st;
end;

begin
    readln(nn1);    assign(f1,nn1);    reset(f1);
    readln(nn2);    assign(f2,nn2);    rewrite(f2);

    while not eof(f1) do begin
        i:=1;    str:=’’;
        while (i<6) and not eof(f1) do begin
            read(f1,bb);    str:=str+chr(bb);
        end;
        if X1(str)=0 then X2(str);
    end;

    close(f1);
    i:=length(str);
    assign(f1,nn1);    reset(f1);
    write(f2,col);    write(f2,i);
    for i:=1 to col do
        for j:=1 to length(Mas[i]) do begin
            bb:=ord(Mas[i][j]);    write(f2,bb);
        end;
    while not eof(f1) do begin
        i:=1;    str:=’’;
        while (i<6) and not eof(f1) do begin
            read(f1,bb);    str:=str+chr(bb);
        end;
        bb:=X1(str);    write(f2,bb);
    end;
    close(f1);    close(f2);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.4    Ответы


Program AA;
type
    tt = string[5];
var
    Mas : array[1..255] of tt;
    col, i, j, bb, zz, ccc : byte; str : tt; nn1, nn2 : string;
    f1, f2 : file of byte;
function X1(kk : byte) : tt;
begin
    X1:=Mas[kk];
end;
procedure X2(st : tt);
begin
    col:=col+1;
    Mas[col]:=st;
end;

begin
    readln(nn1);    assign(f1,nn1);    reset(f1);
    readln(nn2);    assign(f2,nn2);    rewrite(f2);
    read(f1,ccc);    read(f1,zz);    col:=0;
    for i:=1 to ccc-1 do begin
        str:=’’;
        for j:=1 to 5 do begin
            read(f1,bb);    str:=str+chr(bb);
        end;
        X2(str);
    end;
    str:=’’;
    for j:=1 to zz do begin
        read(f1,bb);    str:=str+chr(bb);
    end;
    X2(str);
    while not eof(f1) do begin
        read(f1,bb);    str:=X1(bb);
        for i:=1 to length(str) do begin
            zz:=ord(str[i]);    write(f2,zz);
        end;
    end;
    close(f1);    close(f2);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.5    Ответы


Program AA;
uses crt, dos;
var
    a94, a95, a96, b94, b95, b96 : integer;
    c94, c95, c96, as, bs, cs, ax, bx, cx : integer;
begin
    clrscr;
    writeln(‘Год Доход Расход Прибыль ‘);
    writeln;    writeln(‘1994’);
    writeln(‘1995’);    writeln(‘1996’);
    writeln;    writeln(‘Сумма’);
    writeln;    writeln(‘Среднее’);
    gotoxy(10,3);    read(a94);
    gotoxy(19,3);    read(b94);
    gotoxy(10,4);    read(a95);
    gotoxy(19,4);    read(b95);
    gotoxy(10,5);    read(a96);
    gotoxy(19,5);    read(b96);
    c94:=a94-b94;    c95:=a95-b95;
    c96:=a96-b96;    as:=a94+a95+a96;
    bs:=b94+b95+b96;    cs:=c94+c95+c96;
    ax:=as div 3;    bx:=bs div 3;    cx:=cs div 3;
    TextBackGround(15);    Textcolor(0);
    gotoxy(28,3);    write(c94);
    gotoxy(28,4);    write(c95);
    gotoxy(28,5);    write(c96);
    gotoxy(10,7);    write(as);
    gotoxy(19,7);    write(bs);
    gotoxy(28,7);    write(cs);
    gotoxy(10,9);    write(ax);
    gotoxy(19,9);    write(bx);
    gotoxy(28,9);    write(cx);
    writeln;    writeln;
    delay(5000);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.6    Ответы

Program AA;
uses crt, dos, graph;
var
r : registers;
xx, yy : integer;
Gd, Gm : integer;
MLeft, MRight, MUp, MDown : array[0..6] of integer;
procedure X1;
begin
SetColor(Black);
Line(xx-9,yy,xx-3,yy);
Line(xx+3,yy,xx+9,yy);
Line(xx,yy-9,xx,yy-3);
Line(xx,yy+3,xx,yy+9);
end;


procedure X3;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do MLeft[ii-xx+9]:=GetPixel(ii,yy);
    for ii:=xx+3 to xx+9 do MRight[ii-xx-3]:=GetPixel(ii,yy);
    for ii:=yy-9 to yy-3 do MUp[ii-yy+9]:=GetPixel(xx,ii);
    for ii:=yy+3 to yy+9 do MDown[ii-yy-3]:=GetPixel(xx,ii);
end;
procedure X4;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do PutPixel(ii,yy,MLeft[ii-xx+9]);
    for ii:=xx+3 to xx+9 do PutPixel(ii,yy,MRight[ii-xx-3]);
    for ii:=yy-9 to yy-3 do PutPixel(xx,ii,MUp[ii-yy+9]);
    for ii:=yy+3 to yy+9 do PutPixel(xx,ii,MDown[ii-yy-3]);
end;
begin
    Gd:=Detect;    InitGraph(Gd,Gm,’’);
    SetFillStyle(SolidFill,White);
    Bar(0,0,GetMAxX,GetMaxY);
    xx:=GetMaxX div 2;    yy:=GetMaxY div 2;
    X3;    X1;

    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (yy>10) then begin
            X4;    yy:=yy-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (yy             X4;    yy:=yy+1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (xx>10) then begin
            X4;    xx:=xx-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (xx             X4;    xx:=xx+1;    X3;    X1;
        end;
if (lo(r.ax)=32) and (hi(r.ax)=57) then begin
            if GetPixel(xx,yy)<>Black then
                PutPixel(xx,yy,Black)
            else
                PutPixel(xx,yy,White);
        end;
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    closegraph;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.7    Ответы


Program AA;
uses crt, dos;
var
    i, j : integer;
procedure Pr(x1,y1,x2, y2 : integer);
var
    xx, yy : integer;
begin
    for xx:=x1 to x2 do begin
        gotoxy(xx,y1);    write(‘*’);    delay(100);
    end;
    for yy:=y1 to y2 do begin
        gotoxy(x2,yy);    write(‘*’);    delay(100);
    end;
    for xx:=x2 downto x1 do begin
        gotoxy(xx,y2);    write(‘*’);delay(100);
    end;
    for yy:=y2 downto y1+3 do begin
        gotoxy(x1,yy);    write(‘*’);    delay(100);
    end;
    for xx:=x1 to x1+3 do begin
        gotoxy(xx,y1+3);    write(‘*’);    delay(100);
    end;
end;
begin
    clrscr;
    for i:=0 to 3 do Pr(1+i*3,1+i*3,79-i*3,24-i*3);
    for j:=13 to 39 do begin
        gotoxy(j,4+3*3); write(‘*’); delay(100);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.8    Ответы


Program AA;
var
    nn1, nn2, nn3 : string;
    f1, f2, f3 : file of byte;
    bb : byte;
begin
    readln(nn1);    assign(f1,nn1);    reset(f1);
    readln(nn2);    assign(f2,nn2);    reset(f2);
    readln(nn3);    assign(f3,nn3);    rewrite(f3);

while not eof(f1) do begin
        read(f1,bb);    write(f3,bb);
    end;

    while not eof(f2) do begin
        read(f2,bb);    write(f3,bb);
    end;

    close(f1);    close(f2);    close(f3);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.9    Ответы


Program AA;
uses
    crt, dos;
const
    FLSizeBlock = 2048;
var
    f1, f2 : file; aa, bb1, bb2 : string;
    Ar : array[1..FLSizeBlock] of byte;
    kk, nn, t1, t2 : longint;
    NumR, NumW : word; i : integer;
begin
    readln(aa);        readln(bb1);
    readln(bb2);    readln(nn);
    kk:=nn-1;
    assign(f1,aa);    reset(f1,1);
    assign(f2,bb1);    rewrite(f2,1);
    t1:=kk div FLSizeBlock;
    t2:=kk mod FLSizeBlock;
    for i:=1 to t1 do begin
        BlockRead(f1,Ar,FLSizeBlock,NumR);
        BlockWrite(f2,Ar,NumR,NumW);
    end;
    BlockRead(f1,Ar,t2,NumR);
    BlockWrite(f2,Ar,NumR,NumW);
    close(f2);
    assign(f2,bb2);    rewrite(f2,1);
    repeat
        BlockRead(f1,Ar,FLSizeBlock,NumR);
        BlockWrite(f2,Ar,NumR,NumW);
    until NumR=0;
    close(f2);    close(f1);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.10    Ответы


Program AA;
uses crt, dos, drivers;
var
    Ev : TEvent;
    Direction : 0..3;
    LengthXX : integer;
    NeedAdd : integer;
    PPDigit : boolean;
    XDig, YDig, ValDig : integer;
    i : integer;
    pr : boolean;
    WhereXX : array[1..2000] of record
        X, Y : integer;
    end;
procedure AAA;
begin
    if NeedAdd=0 then begin
        gotoxy(WhereXX[LengthXX].X,WhereXX[LengthXX].Y);
        write(‘ ‘);
    end;
    for i:=LengthXX downto 1 do begin
        WhereXX[i+1].X:=WhereXX[i].X;
        WhereXX[i+1].Y:=WhereXX[i].Y;
    end;
case Direction of
    0 :
        if WhereXX[1].Y>1 then WhereXX[1].Y:=WhereXX[1].Y-1
        else WhereXX[1].Y:=24;
    1 :
        if WhereXX[1].X<79 then WhereXX[1].X:=WhereXX[1].X+1
        else WhereXX[1].X:=1;
    2 :
        if WhereXX[1].Y<24 then WhereXX[1].Y:=WhereXX[1].Y+1
        else WhereXX[1].Y:=1;
    3 :
        if WhereXX[1].X>1 then WhereXX[1].X:=WhereXX[1].X-1
        else WhereXX[1].X:=79
    end;
    gotoxy(WhereXX[1].X,WhereXX[1].Y);
    write(‘@’);
    gotoxy(WhereXX[2].X,WhereXX[2].Y);
    write(‘#’);
    if NeedAdd>0 then begin
        NeedAdd:=NeedAdd-1;
        LengthXX:=LengthXX+1;
    end;
end;
begin
    Randomize;    clrscr;
    LengthXX:=3;    NeedAdd:=0;
    Direction:=3;    PPDigit:=false;
    WhereXX[1].X:=10;        WhereXX[1].Y:=10;
    WhereXX[2].X:=11;        WhereXX[2].Y:=10;
    WhereXX[3].X:=12;        WhereXX[3].Y:=10;
    gotoxy(WhereXX[1].X,WhereXX[1].Y);    write(‘@’);
    gotoxy(WhereXX[2].X,WhereXX[2].Y);    write(‘#’);
    gotoxy(WhereXX[3].X,WhereXX[3].Y);    write(‘#’);
    repeat
        if not PPDigit then begin
            repeat
                XDig:=RAndom(79)+1;
                YDIg:=RAndom(24)+1;
                pr:=false;
                for i:=1 to LengthXX do
                    pr:=pr or ((XDig=WhereXX[i].X) and
(YDig=WhereXX[i].Y));
            until not pr;
            ValDig:=Random(9)+1;
            gotoxy(XDig,YDig);
            write(chr(ord(‘0’)+ValDig));
            PPDigit:=true;
        end;
        GetKeyEvent(Ev);
        if Ev.What=evKeyDown then
            case Ev.KeyCode of
                KbUp : if Direction<>2 then Direction:=0;
                KbRight : if Direction<>3 then Direction:=1;
                KbDown : if Direction<>0 then Direction:=2;
                KbLeft : if Direction<>1 then Direction:=3
            end;
        AAA;
        if (WhereXX[1].X=XDig) and (WhereXX[1].Y=YDig) then begin
            NeedAdd:=NeedAdd+ValDig;
            PPDigit:=false;
        end;
        delay(80);
        pr:=false;
        for i:=2 to LengthXX do
            pr:=pr or ((WhereXX[1].X=WhereXX[i].X) and
(WhereXX[1].Y=WhereXX[i].Y));
    until pr or ((Ev.What=evKeyDown) and (Ev.KeyCode=KbESC));
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.11    Ответы


Program AA;
uses crt, dos;
begin
    clrscr
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.12    Ответы


Program AA;
uses crt, dos;
var
    i : integer;
begin
    clrscr;
    for i:=3 to 70 do begin
        gotoxy(i-1,10);    write(‘ ‘);
        gotoxy(i-1,11);    write(‘ ‘);
        if i mod 2 = 0 then gotoxy(i,10)
        else gotoxy(i,11);
        write(‘*’);    delay(500);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.13    Ответы


Program AA;
uses crt, dos, drivers;
var
    Ev : TEvent;
    Direction : 0..3;
    LengthXX : integer;
    NeedAdd : integer;
    PPDigit : boolean;
    XDig, YDig, ValDig : integer;
    i : integer;
    pr : boolean;
    WhereXX : array[1..2000] of record
        X, Y : integer;
    end;
procedure AAA;
begin
    if NeedAdd=0 then begin
        gotoxy(WhereXX[LengthXX].X,WhereXX[LengthXX].Y);
        write(‘ ‘);
    end;
    for i:=LengthXX downto 1 do begin
        WhereXX[i+1].X:=WhereXX[i].X;
        WhereXX[i+1].Y:=WhereXX[i].Y;
    end;
case Direction of
    0 :
        if WhereXX[1].Y>1 then WhereXX[1].Y:=WhereXX[1].Y-1
        else WhereXX[1].Y:=24;
    1 :
        if WhereXX[1].X<79 then WhereXX[1].X:=WhereXX[1].X+1
        else WhereXX[1].X:=1;
    2 :
        if WhereXX[1].Y<24 then WhereXX[1].Y:=WhereXX[1].Y+1
        else WhereXX[1].Y:=1;
    3 :
        if WhereXX[1].X>1 then WhereXX[1].X:=WhereXX[1].X-1
        else WhereXX[1].X:=79
    end;
    gotoxy(WhereXX[1].X,WhereXX[1].Y);
    write(‘@’);
    gotoxy(WhereXX[2].X,WhereXX[2].Y);
    write(‘#’);
    if NeedAdd>0 then begin
        NeedAdd:=NeedAdd-1;
        LengthXX:=LengthXX+1;
    end;
end;
begin
    Randomize;    clrscr;
    LengthXX:=3;    NeedAdd:=0;
    Direction:=3;    PPDigit:=false;
    WhereXX[1].X:=10;        WhereXX[1].Y:=10;
    WhereXX[2].X:=11;        WhereXX[2].Y:=10;
    WhereXX[3].X:=12;        WhereXX[3].Y:=10;
    gotoxy(WhereXX[1].X,WhereXX[1].Y);    write(‘@’);
    gotoxy(WhereXX[2].X,WhereXX[2].Y);    write(‘#’);
    gotoxy(WhereXX[3].X,WhereXX[3].Y);    write(‘#’);
    repeat
        if not PPDigit then begin
            repeat
                XDig:=RAndom(79)+1;
                YDIg:=RAndom(24)+1;
                pr:=false;
                for i:=1 to LengthXX do
                    pr:=pr or ((XDig=WhereXX[i].X) and
(YDig=WhereXX[i].Y));
            until not pr;
            ValDig:=Random(9)+1;
            gotoxy(XDig,YDig);
            write(chr(ord(‘0’)+ValDig));
            PPDigit:=true;
        end;
        GetKeyEvent(Ev);
        if Ev.What=evKeyDown then
            case Ev.KeyCode of
                KbUp : if Direction<>2 then Direction:=0;
                KbRight : if Direction<>3 then Direction:=1;
                KbDown : if Direction<>0 then Direction:=2;
                KbLeft : if Direction<>1 then Direction:=3
            end;
        AAA;
        if (WhereXX[1].X=XDig) and (WhereXX[1].Y=YDig) then begin
            NeedAdd:=NeedAdd+ValDig;
            PPDigit:=false;
        end;
        delay(80);
        pr:=false;
        for i:=2 to LengthXX do
            pr:=pr or ((WhereXX[1].X=WhereXX[i].X) and
(WhereXX[1].Y=WhereXX[i].Y));
    until pr or ((Ev.What=evKeyDown) and (Ev.KeyCode=KbESC));
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.14    Ответы


Program AA;
uses crt, dos;
var
    hh : file;
    ff, ffff, gggg : file of integer;
    nnn, kkk : string;
    m1, m2, k, i : integer;
begin
    readln(nnn);    assign(ff,nnn);    reset(ff);

    readln(kkk);    assign(ffff,kkk);    rewrite(ffff);
    close(ffff);

    while not eof(ff) do begin
        read(ff,m1);
        assign(ffff,kkk);        reset(ffff);
        m2:=m1-1;    k:=0;
        while not eof(ffff) and (m1>m2) do begin
            read(ffff,m2);    k:=k+1;
        end;
        close(ffff);
        assign(ffff,kkk);    reset(ffff);
        assign(gggg,’aux.dat’);    rewrite(gggg);
        for i:=1 to k-1 do begin
            read(ffff,m2);    write(gggg,m2);
        end;
        write(gggg,m1);
        while not eof(ffff) do begin
            read(ffff,m2);    write(gggg,m2);
        end;
        close(ffff);    close(gggg);
        assign(hh,’aux.dat’);    rename(hh,kkk);
    end;
    close(ff);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.15    Ответы


Program AA;
uses crt, dos;
var
    i, j : integer;
procedure Pr(x1,y1,x2, y2 : integer);
var
    xx, yy : integer;
begin
    for xx:=x1 to x2 do begin
        gotoxy(xx,y1);    write(‘*’);
        delay(100);
    end;
    for yy:=y1 to y2 do begin
        gotoxy(x2,yy);    write(‘*’);
        delay(100);
    end;
    for xx:=x2 downto x1 do begin
        gotoxy(xx,y2);    write(‘*’);
        delay(100);
    end;
    for yy:=y2 downto y1+3 do begin
        gotoxy(x1,yy);    write(‘*’);
        delay(100);
    end;
    for xx:=x1 to x1+3 do begin
        gotoxy(xx,y1+3);    write(‘*’);
        delay(100);
    end;
end;
begin
    clrscr;
    for i:=0 to 3 do Pr(1+i*3,1+i*3,79-i*3,24-i*3);
    for j:=13 to 39 do begin
        gotoxy(j,4+3*3);    write(‘*’);
        delay(100);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.16    Ответы


Program AA;
uses crt, dos;
var
    DirInfo : SearchRec;
    f : file;
begin
    FindFirst(‘*.*’,Archive,DirInfo);
    while DosError=0 do begin
        assign(f,DirInfo.Name);    erase(f);
        FindNext(DirInfo);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.17    Ответы


Program AA;
uses crt, dos;
var
    i : integer;
begin
    clrscr;
    for i:=3 to 70 do begin
        gotoxy(i-1,10);    write(‘ ‘);
        gotoxy(i-1,11);    write(‘ ‘);
        if i mod 2 = 0 then gotoxy(i,10)
        else gotoxy(i,11);
        write(‘*’);    delay(500);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.18    Ответы


Program AA;
uses crt, dos, graph;
var
    Gd, Gm : integer;
    i, j : integer;
begin
    Gd:=Detect;        initgraph(Gd,Gm,’’);
    for j:=1 to 4 do
        for i:=1 to 4 do begin
            SetFillStyle(SolidFill,Black);
            Bar((2*i-2)*(GetMaxX div 8),(2*j-2)*(GetMaxY div 8),(2*i-
1)*(GetMaxX div 8)-1,(2*j-1)*(GetMaxY div 8)-1);
            SetFillStyle(SolidFill,White);
            Bar((2*i-1)*(GetMaxX div 8),(2*j-2)*(GetMaxY div
8),(2*i)*(GetMaxX div 8)-1,(2*j-1)*(GetMaxY div 8)-1);
            SetFillStyle(SolidFill,White);
            Bar((2*i-2)*(GetMaxX div 8),(2*j-1)*(GetMaxY div 8),(2*i-
1)*(GetMaxX div 8)-1,(2*j)*(GetMaxY div 8)-1);
            SetFillStyle(SolidFill,Black);
            Bar((2*i-1)*(GetMaxX div 8),(2*j-1)*(GetMaxY div
8),(2*i)*(GetMaxX div 8)-1,(2*j)*(GetMaxY div 8)-1);
        end;
    delay(5000);
    closegraph;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.19    Ответы


Program AA;
uses crt, dos;
var
    x1, x2, x3, x4, y1, y2, y3, y4 : integer;
    k : integer;
begin
    Randomize;
    clrscr;
    x1:=10;    x2:=10;    x3:=10;    x4:=10;
    y1:=8;    y2:=10;    y3:=12;    y4:=14;
    gotoxy(x1,y1);    write(‘!’);
    gotoxy(x2,y2);    write(‘@’);
    gotoxy(x3,y3);    write(‘#’);
    gotoxy(x4,y4);    write(‘$’);
    delay(700);
    repeat
        k:=Random(4)+1;
        case k of
        1 : begin
            x1:=x1+1;
            gotoxy(x1-1,y1);    write(‘ ‘);
            gotoxy(x1,y1);    write(‘!’);
        end;
        2 : begin
            x2:=x2+1;
            gotoxy(x2-1,y2);    write(‘ ‘);
            gotoxy(x2,y2);    write(‘@’);
        end;
        3 : begin
            x3:=x3+1;
            gotoxy(x3-1,y3);    write(‘ ‘);
            gotoxy(x3,y3);    write(‘#’);
        end;
        4 : begin
            x4:=x4+1;
            gotoxy(x4-1,y4);    write(‘ ‘);
            gotoxy(x4,y4);    write(‘$’);
        end
end;
        delay(200);
    until (x1=70) or (x2=70) or (x3=70) or (x4=70);
    delay(5000);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.20    Ответы


Program AA;
uses crt, dos;
var
    r : registers;
    x, y : integer;
    f : file of char;
    Mas : array[1..2000] of char;
    i, j : integer;
    ch1, ch2 : char;
begin
    for i:=1 to 2000 do Mas[i]:=’ ‘;
    clrscr;    x:=1;    y:=1;
    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (y>1) then y:=y-1;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (y<25) then y:=y+1;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (x>1) then x:=x-1;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (x<80) then x:=x+1;
if (lo(r.ax)<>0) and (lo(r.ax)<>8) and (lo(r.ax)<>13) and
(lo(r.ax)<>27) then begin
            write(chr(lo(r.ax)));
            Mas[(y-1)*80+x]:=chr(lo(r.ax));
            x:=x+1;
            if x=81 then begin
                x:=1;    y:=y+1;
            end;
            if y=26 then begin x:=1; y:=1; end;
        end;
        gotoxy(x,y);
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    ch1:=chr($0a);    ch2:=chr($0d);
    assign(f,’aaa.txt’);    rewrite(f);
    for i:=1 to 25 do begin
        for j:=1 to 80 do write(f,Mas[(i-1)*80+j]);
        write(f,ch1);    write(f,ch2);
    end;
    close(f);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.21    Ответы


Program AA;
uses crt, dos;
var
    h1, h2, h3, h4, k3, k4, n : word;
begin
    clrscr;
    gotoxy(10,10);    write(‘00.00’);
    repeat
    until KeyPressed;
    ReadKey;
    GetTime(h1,h2,k3,k4);
    repeat
        GetTime(h1,h2,h3,h4);
        n:=h3*100+h4-k3*100-k4;
        gotoxy(10,10);    write(‘ ‘);
        gotoxy(10,10);    write(n div 100,’.’,n mod 100);
    until KeyPressed;
    ReadKey;
    repeat
    until KeyPressed;
    ReadKey;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.22    Ответы


Program AA;
uses crt, dos;
var
    i : integer;
begin
    clrscr;
    for i:=5 to 60 do begin
        gotoxy(i-1,10);    write(‘ ‘);
        gotoxy(i-1,11);    write(‘ ‘);
        gotoxy(i-1,12);    write(‘ ‘);
        gotoxy(i,10);    write(‘ o ‘);
        gotoxy(i,11);    write(‘-$-‘);
        gotoxy(i,12);
        if i mod 2 = 0 then write(‘/ >’)
        else write(‘< \’);
        delay(300);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.23    Ответы


Program AA;
uses crt, dos;
var
    i : integer;
begin
    clrscr;
    for i:=3 to 70 do begin
        gotoxy(i-1,10);    write(‘ ‘);
        gotoxy(i-1,11);    write(‘ ‘);
        if i mod 2 = 0 then gotoxy(i,10)
        else gotoxy(i,11);
        write(‘*’);
        delay(500);
    end;
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.24    Ответы


Program AA;
uses crt, dos;
var
    r : registers;
    x, y : integer;
    f : file of char;
    Mas : array[1..2000] of char;
    i, j : integer;
    ch1, ch2 : char;
begin
    for i:=1 to 2000 do Mas[i]:=’ ‘;
    clrscr;    x:=1;        y:=1;
    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (y>1) then y:=y-1;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (y<25) then y:=y+1;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (x>1) then x:=x-1;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (x<80) then x:=x+1;
if (lo(r.ax)<>0) and (lo(r.ax)<>8) and (lo(r.ax)<>13) and
(lo(r.ax)<>27) then begin
            write(chr(lo(r.ax)));
            Mas[(y-1)*80+x]:=chr(lo(r.ax));
            x:=x+1;
            if x=81 then begin
                x:=1;    y:=y+1;
            end;
            if y=26 then begin x:=1; y:=1; end;
        end;
        gotoxy(x,y);
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    ch1:=chr($0a);    ch2:=chr($0d);
    assign(f,’aaa.txt’);    rewrite(f);
    for i:=1 to 25 do begin
        for j:=1 to 80 do write(f,Mas[(i-1)*80+j]);
        write(f,ch1);    write(f,ch2);
    end;
    close(f);
end.

 

 

Калькулятор

/ - деление

\ - остаток

S - сумма чисел от и до

P - произведение чисел от и до

P.42.25    Ответы


Program AA;
uses crt, dos, graph;
var
    r : registers;
    xx, yy : integer;
    Gd, Gm : integer;
    MLeft, MRight, MUp, MDown : array[0..6] of integer;
procedure X1;
begin
    SetColor(Black);
    Line(xx-9,yy,xx-3,yy);
    Line(xx+3,yy,xx+9,yy);
    Line(xx,yy-9,xx,yy-3);
    Line(xx,yy+3,xx,yy+9);
end;

procedure X3;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do MLeft[ii-xx+9]:=GetPixel(ii,yy);
    for ii:=xx+3 to xx+9 do MRight[ii-xx-3]:=GetPixel(ii,yy);
    for ii:=yy-9 to yy-3 do MUp[ii-yy+9]:=GetPixel(xx,ii);
    for ii:=yy+3 to yy+9 do MDown[ii-yy-3]:=GetPixel(xx,ii);
end;
procedure X4;
var
    ii : integer;
begin
    for ii:=xx-9 to xx-3 do PutPixel(ii,yy,MLeft[ii-xx+9]);
    for ii:=xx+3 to xx+9 do PutPixel(ii,yy,MRight[ii-xx-3]);
    for ii:=yy-9 to yy-3 do PutPixel(xx,ii,MUp[ii-yy+9]);
    for ii:=yy+3 to yy+9 do PutPixel(xx,ii,MDown[ii-yy-3]);
end;
begin
    Gd:=Detect;        InitGraph(Gd,Gm,’’);
    SetFillStyle(SolidFill,White);
    Bar(0,0,GetMAxX,GetMaxY);
    xx:=GetMaxX div 2;    yy:=GetMaxY div 2;
    X3;    X1;

    repeat
        r.ax:=$0000;    Intr($16,r);
if (lo(r.ax)=0) and (hi(r.ax)=72) and (yy>10) then begin
            X4;    yy:=yy-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=80) and (yy             X4;    yy:=yy+1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=75) and (xx>10) then begin
            X4;    xx:=xx-1;    X3;    X1;
        end;
if (lo(r.ax)=0) and (hi(r.ax)=77) and (xx             X4;    xx:=xx+1;    X3;    X1;
        end;
if (lo(r.ax)=32) and (hi(r.ax)=57) then begin
            if GetPixel(xx,yy)<>Black then
                PutPixel(xx,yy,Black)
            else
                PutPixel(xx,yy,White);
        end;
    until (lo(r.ax)=27) and (hi(r.ax)=1);
    closegraph;
end.

 

©   Александр Приходько    1996 - 2006

69 0