IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Набор строки и выход из неё в любой момент
4epenOK
сообщение 1.03.2007 18:08
Сообщение #1





Группа: Пользователи
Сообщений: 8
Пол: Мужской
Реальное имя: Максим

Репутация: -  0  +


Здравствуйте!
У меня возникла проблемка, надеюсь на вашу помощь. Пишу я программу по вычислению среднего балла учеников. Нужно чтобы можно было выйти из программы в любой момент времени сразу после нажатия Esc. Проблема заключается в том, что при вводе имени ученика я не могу это реализовать. Пробовал сделать вводить-выводить посимвольно каждую букву, но появились какие-то глюки. Дело в том, что нужно ещё реализовать поддержку клавиш Del, Backspace, end, home. Имя ученика может состоять из любых символов.
Компилятор Turbo Pascal 7.0


--------------------
Работать и создавать, сражаться и побеждать, расчитывать и не ошибаться,
бороться и искать, найти и переработать!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 8)
volvo
сообщение 1.03.2007 18:12
Сообщение #2


Гость






Проверка наличия файла.
Это?
 К началу страницы 
+ Ответить 
klem4
сообщение 1.03.2007 18:27
Сообщение #3


Perl. Just code it!
******

Группа: Модераторы
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Типа этого ?
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;


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
T i m e
сообщение 1.03.2007 19:22
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 27
Пол: Мужской

Репутация: -  -1  +


Просто используй readkey. Знаешь как она работает?

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



Сообщение отредактировано: volvo - 1.03.2007 19:29


--------------------
Time have not meaning. Mind - this is main...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
4epenOK
сообщение 1.03.2007 20:20
Сообщение #5





Группа: Пользователи
Сообщений: 8
Пол: Мужской
Реальное имя: Максим

Репутация: -  0  +


Признаю свою ошибку. Я не указал, что длина имени должна быть не более 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 - запоминает нажатую клавишу }

Сообщение отредактировано: 4epenOK - 1.03.2007 20:24


--------------------
Работать и создавать, сражаться и побеждать, расчитывать и не ошибаться,
бороться и искать, найти и переработать!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 1.03.2007 21:43
Сообщение #6


Гость






Тогда вот так (не стал привязывать функцию к твоему интерфейсу, нехорошо это; функция должна вводить строку, интерфейс здесь ни при чем - не надо перемешивать его с логикой программы):
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
сообщение 2.03.2007 23:11
Сообщение #7





Группа: Пользователи
Сообщений: 8
Пол: Мужской
Реальное имя: Максим

Репутация: -  0  +


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


--------------------
Работать и создавать, сражаться и побеждать, расчитывать и не ошибаться,
бороться и искать, найти и переработать!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 2.03.2007 23:49
Сообщение #8


Гость






Я же говорил, что возможны недоработки... Исправление будет совсем небольшое: перед
         #27:
begin
get_str := '';
exit;
end;


добавить
#13: ; { <--- То есть, если нажат Enter - его НЕ обрабатывать, а выходить сразу }
Тогда будет работать, как ты и сказал...
 К началу страницы 
+ Ответить 
4epenOK
сообщение 3.03.2007 20:52
Сообщение #9





Группа: Пользователи
Сообщений: 8
Пол: Мужской
Реальное имя: Максим

Репутация: -  0  +


Сделал я как ты сказал. Поначалу всё пошло. Но потом, когда я начал подстраивать её под себя, опять появились траблы. Я повставлял 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

Сообщение отредактировано: 4epenOK - 3.03.2007 20:53


--------------------
Работать и создавать, сражаться и побеждать, расчитывать и не ошибаться,
бороться и искать, найти и переработать!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.07.2025 10:14
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"