Здравствуйте! У меня возникла проблемка, надеюсь на вашу помощь. Пишу я программу по вычислению среднего балла учеников. Нужно чтобы можно было выйти из программы в любой момент времени сразу после нажатия Esc. Проблема заключается в том, что при вводе имени ученика я не могу это реализовать. Пробовал сделать вводить-выводить посимвольно каждую букву, но появились какие-то глюки. Дело в том, что нужно ещё реализовать поддержку клавиш Del, Backspace, end, home. Имя ученика может состоять из любых символов. Компилятор Turbo Pascal 7.0
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
1.03.2007 23:22
Просто используй readkey. Знаешь как она работает?
!
Флейм?
beginend.
решает ЛЮБУЮ задачу, правда? Надо только что-то добавить, вот весь вопрос и состоит в том, ЧТО добавлять... Так что впредь я бы попросил пустые сообщения не оставлять...
4epenOK
2.03.2007 0:20
Признаю свою ошибку. Я не указал, что длина имени должна быть не более 25 символов и при вводе наряду с клавишами Del, End, Home, Space, нужно чтоб работали клавиши стрелки (влево и вправо), а клавиши F1-F12 не работали. Символы могут быть любые (русские-английские буквы, цифры, знаки и т.д.) Коды, которые вы привели , работают, но это не совсем то, что нужно. Как работать с байтами я не знаю. Вот часть моей программы, которая, понятное дело, глючит.
uses crt;
label1, 2;
type
spisok = recordname:string[25];
end;
ldp=array[1..40] of spisok;
var nomer:ldp; a, i, n:0..1001; symbol:char; c:string;
begin1: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) thenif length(nomer[n].name)<25thenbegin 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>=1thenbegin delete(nomer[n].name,a,1);
Gotoxy(1,wherey); clreol; write(nomer[n].name); gotoxy(a, wherey); endendend;
until symbol=#13; textcolor(7);
if length(nomer[n].name)=0thenbegin 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
2.03.2007 1:43
Тогда вот так (не стал привязывать функцию к твоему интерфейсу, нехорошо это; функция должна вводить строку, интерфейс здесь ни при чем - не надо перемешивать его с логикой программы):
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 thencase ch of#0:
case readkey of#75: { left }if p > 0then dec(p);
#77: { right }if p < length(s) then inc(p);
#71: { home }
p := 0;
#79: { end }
p := length(s);
#83: { delete }beginif (p >= 0) and (p < length(s)) thenbegin
clear := my_delete(s, p + 1);
end;
end;
end; { case }#27:
begin
get_str := '';
exit;
end;
#8: { backspace }beginif p > 0thenbegin
clear := my_delete(s, p);
dec(p);
end;
endelsebegin{ any char }if length(s) <> max_len thenbeginif 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 thenbegin
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
3.03.2007 3:11
всё идёт норм, но эта строка в любом случае не будет пустой, после нажатия Enter. Даже если ты ничего не ввёл. Если ты после запуска проги сразу жмёшь enter, то lenght(s) будет равно 1, а команда ord(s[1]) выдаст 1. А ведь должно быть lenght(s)=0. Кроме того после выполнения программы координата x почему-то устанавливается на 1. То есть, если дополнить прогу так: убрать в конце writeln('s = ', s); и написать write(':'); readln;; то двоеточие выведется в начале строки, а по идее должен вывестись сразу после строки. Почему так? Или это я что-то не так делаю
volvo
3.03.2007 3:49
Я же говорил, что возможны недоработки... Исправление будет совсем небольшое: перед
#27:
begin
get_str := '';
exit;
end;
добавить
#13: ; { <--- То есть, если нажат Enter - его НЕ обрабатывать, а выходить сразу }
Тогда будет работать, как ты и сказал...
4epenOK
4.03.2007 0:52
Сделал я как ты сказал. Поначалу всё пошло. Но потом, когда я начал подстраивать её под себя, опять появились траблы. Я повставлял 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) <= 25thencase ch of#0:
case readkey of#75: { left }if p > 0then dec(p);
#77: { right }if p < length(s) then inc(p);
#71: { home }
p := 0;
#79: { end }
p := length(s);
#83: { delete }beginif (p >= 0) and (p < length(s)) thenbegin
clear := my_delete(s, p + 1);
end;
end;
end; { case }#13:;
#27: { begin s:=''; }
halt;{ end;}#8: { backspace }beginif p > 0thenbegin
clear := my_delete(s, p);
dec(p);
end;
endelsebegin{ any char }if length(s) <> 25thenbeginif (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 thenbegin
delete(s, length(s), 1);
clear := false;
end;
until ch = #13;
if s=''thenbegin inc(i); str(i, c); s:='Неизвестный № '+c; textcolor(9);
write(s); end; textcolor(7); write(': ');
end;
begin get_str; readln;
end.
Поскольку все ученики без исключения имеют ограничения на имена в 25 символов и должны начинаться сначала строки, то я переделал твою функцию в процедуру. Вроде всё работает Спасибо за помощь
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.