Удалить в файле 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.