[tristan]

Дано натуральное число. Найти сколько раз в нем встречается каждая цифра.

[ChinYan]

Код:

Var
S:string;
i,k:integer;
c: array [0..9] of integer;
begin
{Ввести строку}
for i:=1 to Length(S) do
 begin
  for k:=0 to 9 do
    if S[i] = IntToStr(k) then inc(c[i]);
 end;
for i:=0 to 9 do
 writeln(i,' = ',c[i]);
readln;
end.

[tristan]

Как в книге было написано, я так и переписал свой вариант. А число наверно можно поставить любое.

[stil]

Код:

const c='0123456789';
var i,j,k:integer;
    s:string;
begin
write('s=');readln(s);
for i:=1 to length(c) do begin
  k:=0;
  for j:=1 to length(s) do
    if c[i]=s[j] then Inc(k);
  if k<>0 then writeln(c[i],'=',k);
end;
readln;

[tristan]

Stil и ChinYan вам огромное спасибо за помощь. А можно ли эту прогу сделать не под DOS, а под графический режим. Например кидаем на форму одну Edit1 и Memo1, потом вводим числа, нажимаем Enter и результаты выводятся на Memo1. Заранее низский поклон за помощь.

[stil]

Код:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
const c='0123456789';
var i,j,k:integer;
    s:string;
begin
if Key=#13 then begin
  s:=Edit1.Text;
  memo1.Clear;
  for i:=1 to length(c) do begin
    k:=0;
    for j:=1 to length(s) do
      if c[i]=s[j] then Inc(k);
    if k<>0 then Memo1.Lines.Add(c[i]+'='+IntToStr(k));
  end;
end;
end;

[tristan]

Stil, большое спасибо за помощь.

[Asinkrit]

Я думаю так покрасивее будет.

Код:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var 
  a:array[0..9]of byte;
  i:byte;
begin
if Key=#13 then 
  begin
  for i:=0 to 9 do a[i]:=0;
  for i:=1 ot length(edit1.text) do
    inc(a[ord(Edit1.text[i])]);
  memo1.Clear;
  for i:=0 to 9 do 
    if a[i] <> 0 then
      memo1.lines.add(inttostr(i)+' = '+inttostr(a[i]));
  end;
end;

[tristan]

Он ругается на, то что я подчеркнул:

for i:=1 ot length(edit1.text) do

я думал сперва, что вы не на ту кнопку нажали и исправил на to, но как не исправляй всеравно ругается.

[Asinkrit]

Теперь точно правильно.

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  a:array[0..9]of byte;
  i:byte;
begin
  for i:=0 to 9 do a[i]:=0;
  for i:=1 to length(Edit1.Text) do
    Inc(a[strtoint(Edit1.Text[i])]);
  memo1.Clear;
  for i:=0 to 9 do
    if a[i] <> 0 then
      memo1.lines.add(inttostr(i)+' = '+inttostr(a[i]));
end;

[tristan]

Asinkrit, все теперь заработала программа. Спасибо