Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2006, 17:45   #1
ksu
Новичок
Джуниор
 
Регистрация: 24.12.2006
Сообщений: 2
Злость ПОМОГИТЕ!!!

Есть 2 задачи и некоторые мысли:
1 На [a; b] найти все числа, в записи которых есть цифра «7».
program cikle;
uses crt;
var
a,b,i,j,r,ch:integer;
a1:array[1..10]of integer;
begin
clrscr;
repeat
writeln ('Введите начало отрезка:');
readln (a);
writeln ('Введите конец отрезка:');
readln (b);
until a<b;
i:=2;
for j:=a to b do
begin
while (a<>0) do
begin
a1[i]:=a mod 10;
a:=a div 10;
i:=i+1;
ch:=i;
write (a1[ch]);
end;
for r:=1 to ch do
if a1[r]=7 then
(* for c:=i to 1 do
write (a1[ch]); *)
write ('est');
end;
readln;
end.
2 Все ли слова разной длины в тексте t?
program str;
var i,j,s,c,n,k:integer;
t:string;
ind:byte;
b:array [1..20] of integer;
begin
s:=0;
i:=1;
k:=0;
ind:=1;
n:=0;
j:=0;
writeln ('Введите текст!');
readln (t);
c:=length(t);
while t[i]=' ' do
begin
i:=i+1;
end;
for k:=i to length(t)-1 do
begin
while t[k]<>' ' do
begin
k:=k+1;
s:=s+1;
end;
j:=j+1;
if j>1 then
for n:=1 to j do
if b[n]=s then
ind:=0;
b[j]:=s;
end;
{ for i:=1 to n do
for j:=1 to n-1 do
if b[i]=b[j] then
s:=0
else
s:=1; }
if ind=1 then
writeln ('Нет')
else
writeln ('Да');
for i:=1 to j do
writeln (b[j], ' ');
readln;
end.
скоро сдавать, а мыслей больше нет, последняя надежда на ВАС, ДОБРЫЕ ЛЮДИ!
ksu вне форума Ответить с цитированием
Старый 25.12.2006, 20:47   #2
AVer
Андрей
Форумчанин
 
Аватар для AVer
 
Регистрация: 21.11.2006
Сообщений: 457
По умолчанию

Задача №1

Код:
const N=7;
var Buf,i,a,b,c:Integer;
begin
WriteLn('Otrezok:');
ReadLn(a,b);
If a < b then
 begin
 for i:=a to b do
  begin
  Buf:=i;
  While Buf <> 0 do
   begin
   c:=Buf mod 10;
   Buf:=Buf div 10;
   If c = N then
    begin
    WriteLn(i);
    end;
   end;
  end;
 end else
If b < a then
 begin
 for i:=b to a do
  begin
  Buf:=i;
  While Buf <> 0 do
   begin
   c:=Buf mod 10;
   Buf:=Buf div 10;
   If c = N then
    begin
    WriteLn(i);
    Exit;
    end;
   end;
  end;
 end;
readln;
end.
Задача №2

Код:
Var i,k,Min,Max:Integer;
    S,S1,Buf:String;
    L:Boolean;
Begin
WriteLn('Stroka:');
ReadLn(S);
L:=True;
Min:=100;
S1:=S;
repeat
Buf:=Copy(S,1,Pos(' ',S)-1);
Delete(S,1,Pos(' ',S));
If Length(Buf) > Max then Max:=Length(Buf);
If Length(Buf) < Min then Min:=Length(Buf);
until Pos(' ',S) = 0;
Buf:=S;
If Length(Buf) > Max then Max:=Length(Buf);
If Length(Buf) < Min then Min:=Length(Buf);
For I:=Min to Max do
 begin
 S:=S1;
 repeat
 Buf:=Copy(S,1,Pos(' ',S)-1);
 Delete(S,1,Pos(' ',S));
 If Length(Buf) = I then Inc(K);
 until Pos(' ',S) = 0;
 Buf:=S;
 If Length(Buf) = I then Inc(K);
 If K > 1 then L:=False;
 K:=0;
 end;
If L then WriteLn('Yes') else WriteLn('No');
ReadLn;
end.
ICQ: 5311314
[SIGPIC][/SIGPIC]

Последний раз редактировалось AVer; 25.12.2006 в 21:08.
AVer вне форума Ответить с цитированием
Старый 31.12.2006, 12:31   #3
ksu
Новичок
Джуниор
 
Регистрация: 24.12.2006
Сообщений: 2
По умолчанию

AVer! ОГРОМНОЕ СПОСИБО И 1000 благодарностей!!!
ksu вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск