Другие языки программирования и технологии
Помогите, плиз, с паскалем!!!!
1. Задан текст, в котором группы букв и знаков отделены друг от друга символом пробел. Найти число таких групп букв, которые начинаются и заканчиваются одним и тем же буквой. 2. Описать процедуру AddLeftDigit (D, К), что добавляет к целого положительного числа К слева цифру D (D - входной параметр целого типа, лежит в диапазоне 1-9, К - параметр целого типа, являющийся одновременно входным и выходным). С помощью этой процедуры последовательно добавить к данному числу К слева данные цифры D1 и D2, выводя результат каждого добавления. 3. Описать функцию Even (K) логического типа, возвращает True, если целый параметр К является четным, и False иначе. С ее помощью найти количество четных чисел в наборе из 10 целых чисел.
2) procedure AddLeftDigit(D : Byte; var K : Longint); var R : Word; begin R := 1; while R <= K do R := R * 10; K := D * R + K; end;
var K : Word; D1, D2 : Byte;
begin
Write('Введите К (0 < K < 10000000) : '); ReadLn(K); K := Abs(K) mod 10000000;
Write('Введите D1 (от 1 до 9) : '); ReadLn(D1); D1 := D1 mod 10;
Write('Введите D2 (от 1 до 9) : '); ReadLn(D2); D2 := D2 mod 10;
Write('Добавли к ', K, ' цифру ', D1, '.'); AddLeftDigit(D1, K); WriteLn('Получилось ', K);
Write('Добавли к ', K, ' цифру ', D2, '.'); AddLeftDigit(D2, K); WriteLn('Получилось ', K);
end.
3) function Even(K : Integer) : Boolean; begin Even := Not Odd(K); end;
var A : array [1..10] of Integer; N, K : Byte;
begin
for N := 1 to 10 do begin Write('Введите ', N, ' число: '); ReadLn(A[N]); end;
K := 0; for N := 1 to 10 do if Even(A[N]) then Inc(K);
WriteLn('Количество чётных чисел = ', K);
end.
var K : Word; D1, D2 : Byte;
begin
Write('Введите К (0 < K < 10000000) : '); ReadLn(K); K := Abs(K) mod 10000000;
Write('Введите D1 (от 1 до 9) : '); ReadLn(D1); D1 := D1 mod 10;
Write('Введите D2 (от 1 до 9) : '); ReadLn(D2); D2 := D2 mod 10;
Write('Добавли к ', K, ' цифру ', D1, '.'); AddLeftDigit(D1, K); WriteLn('Получилось ', K);
Write('Добавли к ', K, ' цифру ', D2, '.'); AddLeftDigit(D2, K); WriteLn('Получилось ', K);
end.
3) function Even(K : Integer) : Boolean; begin Even := Not Odd(K); end;
var A : array [1..10] of Integer; N, K : Byte;
begin
for N := 1 to 10 do begin Write('Введите ', N, ' число: '); ReadLn(A[N]); end;
K := 0; for N := 1 to 10 do if Even(A[N]) then Inc(K);
WriteLn('Количество чётных чисел = ', K);
end.
не силен- иди учи, потом сдашь, как силен станешь.
1 копируй блок copy() и смотри- на что начинается и заканчивается. используй copy(), pos(), length(), delete()
2 пиши процедуру. передавай параметры и юзай
3 функция Even (K) :boolean; используй mod или div для определения четности
1 копируй блок copy() и смотри- на что начинается и заканчивается. используй copy(), pos(), length(), delete()
2 пиши процедуру. передавай параметры и юзай
3 функция Even (K) :boolean; используй mod или div для определения четности
Все работает.
program Project13;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
s,w:string;
p1,p2,r:integer;
function getword:string;
begin
p2:=0;
repeat
inc(p2);
until (s[p1+p2]=' ') or ((p2+p1)>(length(s)));
result:=copy(s,p1,p2);
p1:=p1+p2+1;
end;
begin
writeln('enter text');
readln(s);
p1:=1;
r:=0;
if s<>'' then
repeat
w:=getword;
if w<>' ' then
if w[1]=w[length(w)] then
begin
inc(r);
writeln(w);
end;
until p1>=length(s);
writeln('vsego slov ',r);
readln;
end.
program Project14;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
d1,d2:byte;
c:integer;
procedure AddLeftDigit (d:integer; k:integer) ;
begin
c:=strtoint(inttostr(d)+inttostr(k));
end;
begin
write('k=');
readln(c);
write('d1=');
readln(d1);
write('d12=');
readln(d2);
AddLeftDigit(d1,c);
writeln(c);
readln;
AddLeftDigit(d2,c);
writeln(c);
readln;
end.
program Project15;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
a:array[1..10]of integer;
j,n: integer;
function Even(k:integer):boolean;
begin
if (k mod 2)=0 then result:=true
else result:=false;
end;
begin
n:=n xor n;
for j := 1 to 10 do
begin
write('a[',j,']=');
readln(a[j]);
if even(a[j]) then inc(n);
end;
write('4etnih 4isel: ',n);
readln;
end.
program Project13;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
s,w:string;
p1,p2,r:integer;
function getword:string;
begin
p2:=0;
repeat
inc(p2);
until (s[p1+p2]=' ') or ((p2+p1)>(length(s)));
result:=copy(s,p1,p2);
p1:=p1+p2+1;
end;
begin
writeln('enter text');
readln(s);
p1:=1;
r:=0;
if s<>'' then
repeat
w:=getword;
if w<>' ' then
if w[1]=w[length(w)] then
begin
inc(r);
writeln(w);
end;
until p1>=length(s);
writeln('vsego slov ',r);
readln;
end.
program Project14;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
d1,d2:byte;
c:integer;
procedure AddLeftDigit (d:integer; k:integer) ;
begin
c:=strtoint(inttostr(d)+inttostr(k));
end;
begin
write('k=');
readln(c);
write('d1=');
readln(d1);
write('d12=');
readln(d2);
AddLeftDigit(d1,c);
writeln(c);
readln;
AddLeftDigit(d2,c);
writeln(c);
readln;
end.
program Project15;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
a:array[1..10]of integer;
j,n: integer;
function Even(k:integer):boolean;
begin
if (k mod 2)=0 then result:=true
else result:=false;
end;
begin
n:=n xor n;
for j := 1 to 10 do
begin
write('a[',j,']=');
readln(a[j]);
if even(a[j]) then inc(n);
end;
write('4etnih 4isel: ',n);
readln;
end.
Похожие вопросы
- Помогите плиз в паскале!!!!
- Помогите плиз с паскалем!
- помогите плиз по паскалю....
- Помогите плиз!!Задача в Паскале
- помогите плиз написать программу на паскале...тема массивы...нужно использовать поиск деления пополам!!!нужно срочно!
- Помогите плиз с массивом по паскалю!!))никак не могу решить(((
- Помогите плиз!Определяет какой из двух символ встречается чаще в данной строке? Паскаль
- Помогите плиз, язык программирования паскаль
- Помогите студентке с Паскаль
- Помогите с решением. Паскаль.