VPF::Протестите пожалуйста программу!?!

Fighter

Дата 28.1.2006, 00:30 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 810
Регистрация: 5.1.2005

Репутация: нет
Всего: 2

Задание. Ввести в одну строчку ФИО, а в другую должность. Сформировать новую строчку в которой первое слово - это фамилия, затем идут инициалы с точками и затем через "-" идет должность. Вот текст.

Код


Uses crt;

function _Upcase(ch: char): char;
begin
  if (ord(ch) >= 160) and (ord(ch) <= 175) then
  begin
    ch := chr(ord(ch) - 32);
  end
  else if (ord(ch) >= 224) and (ord(ch) <= 239) then
  begin
    ch := chr(ord(ch) - 80);
  end
  else if ord(ch) = 241 then
    ch := chr(240)
  else
    ch := UpCase(ch);
  _Upcase := ch;
end;

var
  fio: string;
  work: string;
  resultString: string;
  startIndex: integer;
  i: integer;
  c: integer;
  j: integer;
  option: char;
  hasNumbers: boolean;
  tempStr: string;
  probels: integer;

begin
  clrscr;
  repeat
    clrscr;
    repeat
      write('‚¢¥¤¨â¥ ”ˆŽ: '); {Vvedito FIO}
      readln(fio);
      while fio[1] = ' ' do
        delete(fio, 1, 1);
      while fio[Length(fio)] = ' ' do
        delete(fio, Length(fio), 1);
      hasNumbers := false;
      fio[1] := _Upcase(fio[1]);
      probels := 0;
      for i := 1 to Length(fio) do
      begin
        if fio[i] = ' ' then
        begin
          while (fio[i+1] = ' ') do
            delete(fio, i, 1);
        end;
        if fio[i] in ['0'..'9'] then
          delete(fio, i, 1);
      end;
      for i := 1 to Length(fio) do
      begin
        if fio[i] = ' ' then
        begin
          fio[i+1] := _UpCase(fio[i+1]);
          inc(probels);
        end;
        if probels > 2 then
        begin
          fio := copy(fio, 1, i-1);
          dec(probels);
          break;
        end;
      end;
      if probels <> 2 then
      begin  {Oshibka vvoda. Povtorite vvod zanovo}
        writeln('Žè¨¡ª  ¢¢®¤ . ®¢â®à¨â¥ ¢¢®¤ § ®¢®.');
      end;
    until probels = 2;
    write('‚¢¥¤¨â¥ ¤®«¦®áâì: '); {Vvedite dolzhnosti}
    readln(work);
    while work[1] = ' ' do
      delete(work, 1, 1);
    while work[Length(work)] = ' ' do
      delete(work, Length(work), 1);
    i := 1;
    while fio[i] <> ' ' do
      inc(i);
    writeln('Source string: ', fio);
    resultString := copy(fio, 1, i - 1);
    resultString := resultString + ' ' + fio[i+1] + '.';
    inc(i);
    while fio[i] <> ' ' do
      inc(i);
    resultString := resultString + ' ' + fio[i+1] + '.';
    resultString := resultString + ' - ' + work;
    writeln(resultString);
    writeln;
    writeln(' ¦¬¨â¥ Enter ¤«ï ¯®¢â®à®£® ¢¢®¤ .  ¦¬¨â¥ Esc ¤«ï ¢ëå®¤ ');
    {Nazhmite Enter dlya povtornogo vvoda. Nazhmite Esc dlya vihoda}
    repeat
      option := readkey;
    until (ord(option) = 27) or (ord(option) = 13);
  until ord(option) = 27;
end.

Сообщите пожалуйста об ошибках, которые найдете.

armageddon

Дата 31.1.2006, 17:04 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 117
Регистрация: 9.11.2005
Где: 239

Репутация: нет
Всего: нет

постарайся набирать в write латинецей , а то ничего не разобрать

Fighter

Дата 2.2.2006, 00:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 810
Регистрация: 5.1.2005

Репутация: нет
Всего: 2

Цитата(armageddon @ 31.1.2006, 17:04

)

постарайся набирать в write латинецей , а то ничего не разобрать

Я в комментариях писал что там выводится

Guedda

Дата 2.2.2006, 10:56 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: нет
Всего: 78

Ну, в общем, через Сахалин это сделал. Можно гораздо быстрее.

--------------------

Ll 2

armageddon

Дата 2.2.2006, 18:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 117
Регистрация: 9.11.2005
Где: 239

Репутация: нет
Всего: нет

извиняюсь, не заметил, а так в общем прога работает, еще раз извиняюсь

Zero

Дата 2.2.2006, 22:16 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24

Цитата(armageddon @ 31.1.2006, 18:04

)

постарайся набирать в write латинецей , а то ничего не разобрать

Нет. Лучше, прежде чем копировать текст в буфер обмена, чтобы затем вставить текст в сообщение, переключите раскладку клавиатуры на русский язык.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »