Сложите программу, которая поможет работникам милиции.

[SINISTER]

Люди помогите решить задачу. Она, наверно, очень легкая, но я не шарю как ее и прочие задач делать. Очень хочу научится! Времени мало и некогда читать книги.

Так от, задача:
1. Три товариша были свидетелями дорожно-транспортного проишествия. Один из них запомнил что 4-значимый номер автомобиля делится без остатка на 2, 7 и 11. Второй подчеркнул что в записи номера есть две одинаковые цифры, а третий вспомнил что сума цифр номера 30.
Сложите программу, которая поможет работникам милиции.

P.S. Распишите пожалуйста все что нужно вводить и куда. Заранее спасибо.

[puporev]

Задача как раз не самая легкая и, если Вы не прикидываетесь и действительно ничего до этого не решали, то эта задача не для Вас.
Но я дам Вам решение, вдруг чему-нибудь научитесь.

uses crt;
var i:integer;
function SumCif(x:integer):integer;//функция подсчета суммы цифр числа
var t,sum:integer;
begin
sum:=0;
while x>0 do //пока число больше 0
  begin
   t:=x mod 10; //отделяем последнюю цифру
   sum:=sum+t;  //прибавляем ее
   x:=x div 10; //записываем число без последней цифры
  end;
SumCif:=sum; //присваиваем значение функции (запоминаем результат)
end;
function RavCif(x:integer):boolean; //функция определения есть ли 2 или больше одинаковых цифр
var t,k:integer;
    m:set of byte;//множество цифр
begin
m:=[];k:=0; //сначала множество пустое
while x>0 do //разбираем число на цифры как в предыдущей функции
  begin
    t:=x mod 10;
    if not (t in m) then //если цифры нет в множестве
      begin
       m:=m+[t]; //добавляем
       inc(k); //считаем (увеличиваем к на +1)
      end;
    x:=x div 10;
  end;
RavCif:=(k<3); //если в множестве меньше 3 цифр, то по крайней мере 2 одинаковые = истина
end;
begin
clrscr;
for i:=1010 to 9999 do //проверяем все 4-х значные числа от 1010, меньшие не содержат 
                       // одинаковых цифр или нечетные
if (i mod 2=0)and(i mod 7=0)and(i mod 11=0)and(SumCif(i)=30)and RavCif(i) //проверяем все условия
then writeln(i); //если выполняются, выводим число (8778)
readln
end.

[Serge_Bliznykov]

for i:=1000 to 9999 do
  if ((i mod 2)=0) and ((i mod 7)=0) and ((i mod 11)=0) then begin
    D4 := i mod 10;
    D3 := (i div 10) mod 10;
    D2 := (i div 100) mod 10;
    D1 := (i div 1000) mod 10;

    if ((D1=D2) or (D1=D3) or (D1=D4) or (D2=D3) or (D2=D4) or (D3=D4)) and ( (D1+D2+D3+D4)=30) then 
     WriteLn('Podhodit nomer ',I:4)
  end;

  end;

Добавлено
puporev, пока читал-писал Вы уже успели ответить... сорри...
увидел бы Ваш ответ - не писал бы... ;-)

[puporev]

1234 mod 10=4
1234 mod 100 =34
1234 mod 1000=234
1234 mod 10000=1234
нужно
D4 := i mod 10;
D3 := i mod 100 div 10;
D2 := i mod 1000 div 100;
D1 := i div 1000;
Я чего-то с перепугу сделал почти на все случаи жизни, надо только в функции одинаковых цифр поменять 3 на переменную количества одинаковых цифр-1

[Serge_Bliznykov]

puporev, ага.
Полностью согласен с приведённым замечанием.
но заметьте, я успел исправить это на 4 минуты раньше, чем Вы написали об этой ошибке ;-P

[puporev]

Как мне один товарищ сказал на форуме, puporev, ночью нужно спать.

[Serge_Bliznykov]

ну, конечно, он прав!.. :-D
Но, половина двенадцатого — какая же это ночь? :-D

[puporev]

Это я про себя писал, а у меня было половина второго.