Помощь - Поиск - Пользователи - Календарь
Полная версия: Набор строки и выход из неё в любой момент
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
4epenOK
Здравствуйте!
У меня возникла проблемка, надеюсь на вашу помощь. Пишу я программу по вычислению среднего балла учеников. Нужно чтобы можно было выйти из программы в любой момент времени сразу после нажатия Esc. Проблема заключается в том, что при вводе имени ученика я не могу это реализовать. Пробовал сделать вводить-выводить посимвольно каждую букву, но появились какие-то глюки. Дело в том, что нужно ещё реализовать поддержку клавиш Del, Backspace, end, home. Имя ученика может состоять из любых символов.
Компилятор Turbo Pascal 7.0
volvo
Проверка наличия файла.
Это?
klem4
Типа этого ?
procedure ReadWord;
var
  s: String;
  i: Byte;
  ch: Char;
begin
  s := '';
  i := 1;

  repeat
    ch := readkey;

    case ch of

      'A'..'Z', 'a'..'z': begin
        Insert(ch, s, i);
        inc(i);
      end;

      #8: Delete(s, Length(s), 1);

      #0: case readkey of
        #83: begin
          s := ''; i := 1;
        end;
        #71: i := 1;
        #79: i := Length(s) + 1;
      end;

    end;

    clrscr;
    writeln(s);
  until ch = #27;
end;
T i m e
Просто используй readkey. Знаешь как она работает?

 ! 
Флейм?
begin end.
решает ЛЮБУЮ задачу, правда? Надо только что-то добавить, вот весь вопрос и состоит в том, ЧТО добавлять... Так что впредь я бы попросил пустые сообщения не оставлять...

4epenOK
Признаю свою ошибку. Я не указал, что длина имени должна быть не более 25 символов и при вводе наряду с клавишами Del, End, Home, Space, нужно чтоб работали клавиши стрелки (влево и вправо), а клавиши F1-F12 не работали. Символы могут быть любые (русские-английские буквы, цифры, знаки и т.д.) Коды, которые вы привели , работают, но это не совсем то, что нужно. Как работать с байтами я не знаю.
Вот часть моей программы, которая, понятное дело, глючит.

uses crt;
label 1, 2;
type
spisok = record
name:string[25];
end;
ldp=array[1..40] of spisok;
var nomer:ldp; a, i, n:0..1001; symbol:char; c:string;
begin
1:clrscr; textcolor(7); i:=0; n:=0;
writeln('Имя':5,'Текущие оценки':40,'Средний бал':35); 2:textcolor(9);
inc(n); nomer[n].name:='';  repeat
symbol:=readkey;
if (symbol<>#0) and (symbol<>#8) and (symbol<>#27) then
if length(nomer[n].name)<25 then begin  a:=wherex+1;
insert(symbol, nomer[n].name, wherex); gotoxy(1, wherey); clreol;
write(nomer[n].name); gotoxy(a, wherey) end;
case symbol of
#27:exit;
#0:begin symbol:=readkey; case symbol of
          #75:gotoxy(wherex-1, wherey);
          #77:if wherex<length(nomer[n].name) then gotoxy(wherex+1, wherey);
            end; end;
#8:begin a:=wherex-1; if a>=1 then begin delete(nomer[n].name,a,1);
Gotoxy(1,wherey); clreol; write(nomer[n].name); gotoxy(a, wherey); end end
end;
until symbol=#13; textcolor(7);
if length(nomer[n].name)=0 then begin inc(i); str(i, c);
nomer[n].name:='Неизвестный № '+c; textcolor(9); write(nomer[n].name);
textcolor(7); end; gotoxy(length(nomer[n].name), wherey); write(': '); end.


{ name - имя учащегося
n - номер ученика по счёту
a - счётчик
i - количество "неизвестных"
symbol - запоминает нажатую клавишу }
volvo
Тогда вот так (не стал привязывать функцию к твоему интерфейсу, нехорошо это; функция должна вводить строку, интерфейс здесь ни при чем - не надо перемешивать его с логикой программы):
uses crt;

function get_str(start, max_len: byte): string;

  function my_delete(var s: string; p: integer): boolean;
  begin
    delete(s, p, 1);
    s := s + ' ';
    my_delete := true;
  end;

var
  s: string;
  ch: char;
  p: integer;
  clear: boolean;
begin
  s := ''; p := 0;
  clear := false;
  repeat
    gotoxy(start + p, wherey);

    ch := readkey;
    if length(s) <= max_len then
      case ch of
        #0:
          case readkey of
            #75: { left }
              if p > 0 then dec(p);

            #77: { right }
              if p < length(s) then inc(p);

            #71: { home }
              p := 0;

            #79: { end }
              p := length(s);

            #83: { delete }
              begin

                if (p >= 0) and (p < length(s)) then begin
                  clear := my_delete(s, p + 1);
                end;

              end;
          end; { case }

         #27:
           begin
             get_str := '';
             exit;
           end;

         #8: { backspace }
           begin
             if p > 0 then begin

               clear := my_delete(s, p);
               dec(p);

             end;
           end

        else begin { any char }

          if length(s) <> max_len then begin

            if p < length(s) then insert(ch, s, p + 1)
            else s := s + ch;
            inc(p);

          end;

        end;
      end; { case }

    gotoxy(start, wherey);
    write(s);

    if clear then begin
      delete(s, length(s), 1);
      clear := false;
    end;

  until ch = #13;
  get_str := s
end;

{
  Это пример вызова:
  первый параметр - позиция по X, с которой начинать ввод строки;
  второй - макс. возможная ее длина

  Начальная позиция по Y не задается, для этого ПЕРЕД вызовом get_str
  надо перейти с помощью GotoXY в нужную строку...
}
var s: string;
begin
  s := get_str(10, 25);

  writeln('s = ', s);
end.


Тестируй как следует - глюки могут проявиться, ибо я проверял под 32-битным компилером, хотя и в режиме совместимости с TP...
4epenOK
всё идёт норм, но эта строка в любом случае не будет пустой, после нажатия Enter. Даже если ты ничего не ввёл.
Если ты после запуска проги сразу жмёшь enter, то lenght(s) будет равно 1, а команда ord(s[1]) выдаст 1.
А ведь должно быть lenght(s)=0. Кроме того после выполнения программы координата x почему-то устанавливается на 1. То есть, если дополнить прогу так:
убрать в конце writeln('s = ', s);
и написать write(':'); readln;;
то двоеточие выведется в начале строки, а по идее должен вывестись сразу после строки. Почему так? Или это я что-то не так делаю wacko.gif
volvo
Я же говорил, что возможны недоработки... Исправление будет совсем небольшое: перед
         #27:
           begin
             get_str := '';
             exit;
           end;


добавить
#13: ; { <--- То есть, если нажат Enter - его НЕ обрабатывать, а выходить сразу }
Тогда будет работать, как ты и сказал...
4epenOK
Сделал я как ты сказал. Поначалу всё пошло. Но потом, когда я начал подстраивать её под себя, опять появились траблы. Я повставлял write(lenght(s)) в нескольких местах и прога начала мне выдавать самые разные цифры. От 78 до 224. Склоняюсь к мысли, что у меня Паскаль левый какой-то. В общем я поковырялся в программе и остановился на следующем варианте.
uses crt;

procedure get_str;

  function my_delete(var s: string; p: integer): boolean;
  begin
    delete(s, p, 1);
    s := s + ' ';
    my_delete := true;
  end;

var
  s,c: string;
  ch: char;
  p: integer;
  clear: boolean;
  i:byte;
begin
  s := ''; p := 0;
  clear := false;
  repeat
    gotoxy(p+1, wherey);

    ch := readkey;
    if length(s) <= 25 then
      case ch of
        #0:
          case readkey of
            #75: { left }
              if p > 0 then dec(p);

            #77: { right }
              if p < length(s) then inc(p);

            #71: { home }
              p := 0;

            #79: { end }
              p := length(s);

            #83: { delete }
              begin

                if (p >= 0) and (p < length(s)) then begin
                  clear := my_delete(s, p + 1);
                end;

              end;
          end; { case }

         #13:;

         #27:   { begin s:='';  }
             halt;{ end;}

         #8: { backspace }
           begin
             if p > 0 then begin

               clear := my_delete(s, p);
               dec(p);

             end;
           end

        else begin { any char }

          if length(s) <> 25 then begin

            if (p < length(s)) and (ch<>#13) then insert(ch, s, p + 1)
            else s := s + ch;
            inc(p);

          end;

        end;
      end; { case }

    gotoxy(1, wherey);
    write(s);

    if clear then begin
      delete(s, length(s), 1);
      clear := false;
    end;

  until ch = #13;

  if s='' then begin inc(i); str(i, c); s:='Неизвестный № '+c; textcolor(9);
  write(s); end; textcolor(7); write(': ');
end;

begin get_str; readln;
end.


Поскольку все ученики без исключения имеют ограничения на имена в 25 символов и должны начинаться сначала строки, то я переделал твою функцию в процедуру. Вроде всё работает good.gif
Спасибо за помощь yes2.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.