Удалить в файле TWO текст после первой точки.

 

PROGRAM PRG8_8;

VAR F1: FILE OF CHAR; F2: TEXT; X: CHAR; К: INTEGER;

BEGIN

ASSIGN(F1, 'TWO'); RESET(F1); ASSIGN(F2, ' '); REWRITE(F2); K:=-1;

WHILE NOT EOF(F1) DO BEGIN

К:= K+1; READ(F1, X);

IF X<>'.' THEN WRITE(F2, X) ELSE

BEGIN

SEEK(F1, K+1);

WRITE(F2, X); TRUNCATE(FI) END;

END; WRITELN; CLOSE(F1); CLOSE(F2) END.

 

Написать процедуру ввода элементов матрицы Т.

PROGRAM PG9_1;

CONST U = 100;

VAR N, M: INTEGER;

T: ARRAY[1..U, 1..U] OF INTEGER;

PROCEDURE TAB(VAR L, К: INTEGER);

VAR I, J: INTEGER;

BEGIN

FOR I:= 1 TO L DO BEGIN

FOR J:= 1 TO К DO BEGIN

WRITE('T [', I,',', J,'] ='); READ(T[I, J]) END; WRITELN

END

END; BEGIN

WRITELN('BBEAHTE РАЗМЕР МАТРИЦЫ N X M'); WRITE('N ='); READ(N); WRITE('M ='); READ(M); TAB(N, M) END.

 

Написать процедуры ввода и вывода элементов матрицы Т.

PROGRAM PG9_2; CONST U = 100; VAR N, M: INTEGER;

T: ARRAY[1..U, 1..U] OF INTEGER;

PROCEDURE TAB_IN(VAR L, К: INTEGER); VAR I, J: INTEGER;

BEGIN

FOR I:= 1 TO L DO BEGIN

FOR J:= 1 TO К DO BEGIN

WRITE('T [', I, ', J, '] ='); READ(T[I, J]) END;

WRITELN END

END;

PROCEDURE TAB_OUT(VAR L, К: INTEGER); VAR I, J: INTEGER;

BEGIN

FOR I:= 1 TO L DO BEGIN

FOR J:= 1 TO К DO WRITE(T[I, J]: 6);

WRITELN

END

END; BEGIN

WRITELN('BBEAMTE РАЗМЕР МАТРИЦЫ N X M');

WRITE('N = ');

READ(N);

WRITE('M = ');

READ(M);

TAB_IN(N, M);

WRITELN('MATPMU,A', N, X, M); TAB_OUT(N, M) END.

 

Дана строка символов. Написать процедуру удаления из строки всех кратных рядом стоящих символов.

PROGRAM PRG9_3;

VAR S: STRING;

L: INTEGER;

PROCEDURE SIM;

VAR I: INTEGER;

STR: STRING;

BEGIN

STR:= S[1];

FOR I:= 2 TO L DO

IF S[l]OS[M] THEN STR:= STR+S[I]; S:= STR

END; BEGIN

WRITELN('BBEAHTE СТРОКУ СИМВОЛОВ,');

READLN(S);

L:= LENGTH(S);

SIM;

WRITELN(S) END.

 

 

Написать функцию, которая из двух целых чисел выбирает наименьшее число.

 

PROGRAM PG9_4;

VAR I, J: INTEGER; FUNCTION MIN(I, J: INTEGER): INTEGER;

BEGIN

IF KJ THEN MIN:= I ELSE MIN:= J END;

BEGIN

WRITELN('BBEflMTE ДВА ЦЕЛЫХ ЧИСЛА'); READLN(I, J);

WRITELN('MIN = ', MIN(I, J)) eND.

 

Написать функцию, которая из двух целых чисел выбирает наибольшее число.

 

PROGRAM PRG9_3;

VAR S: STRING;

L: INTEGER;

PROCEDURE SIM;

VAR I: INTEGER;

STR: STRING;

BEGIN

STR:= S[1];

FOR I:= 2 TO L DO

IF S[l]OS[l-1] THEN STR:= STR+S[I]; S:= STR

END; BEGIN

WRITELN('BBEAHTE СТРОКУ СИМВОЛОВ,');

READLN(S);

L:= LENGTH(S);

SIM;

WRITELN(S) END.

 

 

Написать функцию, которая из двух целых чисел выбирает наименьшее число.

PROGRAM PG9_4;

VAR I, J: INTEGER; FUNCTION MIN(I, J: INTEGER): INTEGER;

BEGIN

IF KJ THEN MIN:= I ELSE MIN:= J END;

BEGIN

WRITELN('BBEflMTE ДВА ЦЕЛЫХ ЧИСЛА'); READLN(I, J);

WRITELN('MIN = ', MIN(I, J)) eND.

 

Написать функцию, которая из двух целых чисел выбирает наибольшее число.

PROGRAM PG9_5;

VAR I, J: INTEGER; FUNCTION MAX(I, J: INTEGER): INTEGER;

BEGIN

IF l>J THEN MAX:= I

ELSE MAX:= J END;

BEGIN

WRITELNfBBEflklTE ДВА ЦЕЛЫХ ЧИСЛА'); READLN(I, J);

WRITELN('MAX = ', MAX(I, J)) END.

 

Написать функцию, которая находит сумму цифр целого числа.

PROGRAM PG9_6;

VAR N: LONGINT; К: INTEGER;

FUNCTION NUM(I: LONGINT): INTEGER; VAR S: INTEGER;

BEGIN

S:= 0;

REPEAT

S:= S+N MOD 10;

N:= N DIV 10 UNTIL N = 0; NUM:= S END;

BEGIN

WRITE('BBEflMTE ЦЕЛОЕ ЧИСЛО N = ');

READLN(N);

К:= NUM(N);

WRITELN('CyMMA ЕГО ЦИФР РАВНА', К)

eND.

 

Дан прямоугольник со сторонами А и В, где А, В -

натуральные числа. Начинаем отсекать от него квадраты (рис. 9.1). Сколько таких квадратов можно отсечь, если каждый раз отсекается са­мый большой квадрат?

PROGRAM PG9_8B;

VAR А, В, D, К, X, Y: INTEGER; BEGIN

WRITELN('BBEflHTE ДВА НАТУРАЛЬНЫХ ЧИСЛА'); READLN(A, В); К:= 0; IF А>В THEN BEGIN

X:= В;

Y:= A

END ELSE

BEGIN

Y:= B; X:= A END; REPEAT

К:= K+Y DIV X; D:= Y MOD X; Y:= X; X:= D; UNTIL D = 0;

WRITELN('HCKOMOE ЧИСЛО КВАДРАТОВ: ', К) END.

 

Дана строка символов. Дано слово. Удалить из строки это слово.

PROGRAM PRG5_1;

VAR STR, WRD: STRING;

I, L: INTEGER; M: SET OF CHAR;

BEGIN

WRITELN('BBEflHTE СЛОВО');'

READLN(WRD);

WRD:= CONCATC '. WRD);

STR:= ' '+STR;

WRITELNCBBEflMTE ТЕКСТ');

READLN(STR); ^

L:= LENGTH(WRD);

 

Дан целочисленный массив размера N. Вывести вначале все его четные\нечетные элементы, а затем нечетные\четные элементы массива.

 

Решение:

 

Program Den_1;

Uses crt;

Var

i:integer;

N:integer;

K:integer;

Begin

Clrscr;

Textbackground(blue);

Textcolor(white);

Write(‘vvedite N=’);

Readln(N);

Writeln;

Begin

Randomize;

Massiv[i]:=random(100)-50;

Write(Massiv[i]:5);

Begin

For i:=1 to N do

Begin

If Massiv[i] mod 2 =0 then write(Massiv[i]+Massiv[1]);

Else write(Massiv[i]+Massiv[N]);

{For K:=1 to 20 do

Write (Massiv[i]:5);}

End;

End;

End;

End.

Дан файл F, компоненты которого являются целыми числами. Никакая из компонент не равна 0.Файл содержит столько же отрицательных чисел сколько и положительных. Используя вспомогательный файл h, переписать компоненты файла f, в файл g, так, чтобы в файле g шли сначала положительные, потом отрицательные числа.

 

program Den_1;

uses crt;

Type f=text;

var TXTfile: f;

GFile: f;

Nf:f;

fName,gName,name:string[20];

i,n,c:integer;

m:string[100];

s:array[1..100] of integer;

begin

clrscr;

writeln('*** *** Исходник *** ***');

fName:='notes_f.txt';

gName:='notes_g.txt';

Assign(TXTfile,fName);

Reset(TXTfile);

n:=1;

i:=1;

while not EOF(TXTFile) do

begin

readln(TXTFile,m);

write(m:4);

val(m,s[i],c);

i:=i+1;

n:=n+1;

end;

 

Close(TXTfile);

 

writeln;

writeln('*** *** В итоге *** ***');

Assign(GFile,gName);

rewrite(GFile);

for i:=1 to n do

begin

if s[i]>0 then

begin

writeln(GFile,s[i],' ');

write(s[i]:4);

end;

end;

for i:=1 to n do

begin

if s[i]<0 then

begin

writeln(GFile,s[i],' ');

write(s[i]:4);

end;

end;

Close(GFile);

writeln;

writeln('*** ***Задание №2 *** ***');

name:='textNotes.txt';

assign(Nf,name);

reset(Nf);

readln(Nf,m);

Close(Nf);

 

readln;

end.