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

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

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

 
 Ответить  Открыть новую тему 
> Набор строки и выход из неё в любой момент
сообщение
Сообщение #1





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

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


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


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


Гость






Проверка наличия файла.
Это?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

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

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


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

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



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


--------------------
Time have not meaning. Mind - this is main...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 -


--------------------
Работать и создавать, сражаться и побеждать, расчитывать и не ошибаться,
бороться и искать, найти и переработать!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






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


добавить
#13: ; { <--- То есть, если нажат Enter - его НЕ обрабатывать, а выходить сразу }
Тогда будет работать, как ты и сказал...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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 -


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

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

 





- Текстовая версия 22.09.2020 14:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name