Компьютерный софт и всё, что с ним связано

Firelander

Вот, накидал процедурку. В неё вводишь количество секунд, которое ты хочешь, чтобы комьютер бездействовал. К примеру mdelay(10) задержит программу на 10 секунд. Если надо, могу и всю программулину накидать.

Код:

program timer1;
uses dos,crt;
procedure mdelay(duration:word);
var current,other,saved,dr:word;
begin
dr:=duration;
GetTime(other,other,saved,other);

while dr>0 do
begin
current:=saved;
while current=saved do
GetTime(other,other,saved,other);
dec(dr);
end;
end;

begin
mdelay(10);
writeln('Привет!');
end.

Вот вариант, которые выводит оставшиеся время до конца ожидания.

Код:

program timer1;
uses dos,crt;
procedure mdelay(duration:word);
var current,other,saved,dr:word;
begin
dr:=duration;
GetTime(other,other,saved,other);

while dr>0 do
begin
current:=saved;
while current=saved do
GetTime(other,other,saved,other);
dec(dr);
{Здесь писать что надо делать каждую секунду во время ожидания, в даном случае это вывод на экран оставшегося времени}
clrscr;
write(dr);

end;
end;

begin
mdelay(10);
writeln('Привет!');
end.

Добавлено: Thu Aug 16, 2007 9:07 pm

Фролов

Огромное спасибо!
Буду очень благодарен, если накидаешь прогу.

Добавлено: Thu Aug 16, 2007 9:13 pm

Фролов

Т. е. получается, что первую процедуру надо вводить каждый раз после вычитания единицы, это-ж 7400 раз! А сократить никак низя?

Добавлено: Thu Aug 16, 2007 9:17 pm

Firelander

Можно вызвать процедуру с параметром 7400, так будет лучше, предварительно модифицировав её.
А теперь снова вопросы. Чтобы написать прогу, надо знать ответы на все. Какова длительность длинного сигнала? Какова длительность короткого? Каким образом задавать пароль? Нужно ли задавать длительность тайминга? Как завершать программу? Программа может принимаь пароль раньше чем закончится время?(Это, кстати, очень непросто реализовать)

Добавлено: Thu Aug 16, 2007 9:22 pm

Фролов

так шо ли?

procedure Start (var T:longint);
begin
T:=SystemTimer;
end;
procedure Stop (var T:longint);
begin
T:=SystemTimer-T;
end;

procedure Pause (T:longint; Show:boolean);
var Xn,Xt:longint;
begin
Xt:=0;
Xn:=SystemTimer;
While ((Xt-Xn)/18.2)*1000 < T do
begin
Xt:=SystemTimer;
If Show then
writeln((xt-xn)/18.2:6:4)
end;
end;

Program Time;
uses timer;
Var i : integer;
a :Real;
Time : LongInt;
begin
Randomize;
Start(Time);
For i:=7400 to 1 do
a:=i-1
Stop(Time);
Readln;
Pause(1000, True);
end.

Добавлено: Thu Aug 16, 2007 9:24 pm

Firelander

Мда, ничего не понял в программе. Особенно что такое SystemTimer. Нашёл модуль что ли какой-то?
For нам там не нужны Smile

А delay штука несерьёзная, она зависит от быстродействия компьютера и с временем никак не связана, проверяли уже когда мой друг игрушку написал. Приходилось перепрявлять задержки на разных комапах.

Добавлено: Thu Aug 16, 2007 9:33 pm

Фролов

Длинный сигнал - 10 секунд.
Короткий - 1 секунда
Пароль можно задать цифровой, например if a:= 4 8 15 16 23 42 then - длинный сигнал и запуск таймера опять все по новой else writeln 'ОСТАНОВКА'; end.

Пароль нужно ввести в течении коротких сигналов, желательно, для предупреждения.

Сам мало че соображаю, но буду признателен, если сделаешь.

Добавлено: Thu Aug 16, 2007 9:37 pm

Фролов

SystemTimer:longint absolute $0040:$006C;

адрес аппаратного таймера.

Добавлено: Thu Aug 16, 2007 9:38 pm

Firelander

Слышь, тебе эту прогу когда надо? Я просто ночью спать немножко хочу подмигивает

да и думается днём лучше намного.

Последний раз редактировалось: Firelander (Thu Aug 16, 2007 9:50 pm), всего редактировалось 1 раз
Добавлено: Thu Aug 16, 2007 9:44 pm

Фролов

Особо не горит. Так, до середины сентября надо управится. Но я уже голову свернул! гнев

Желательно, конечно побыстрее, чтоб там согласовать, баги исправить если чё. :wink:

Добавлено: Thu Aug 16, 2007 9:49 pm

Firelander

Отлично, завтра за день постаряюсь управиться. Свяжемся.

Добавлено: Thu Aug 16, 2007 9:50 pm

Фролов

Огромное спасибо! :D

Добавлено: Thu Aug 16, 2007 9:53 pm

Фролов

Ну что? Как дело продвигается? Уменя нихрена не получается. огорчён

Добавлено: Fri Aug 17, 2007 8:45 pm

Фролов

Воть, сварганил конец проги.
program timer1;
uses dos,crt;
procedure mdelay(duration:word);
var current,other,saved,dr:word;
begin
dr:=duration;
GetTime(other,other,saved,other);

while dr>0 do
begin
current:=saved;
while current=saved do
GetTime(other,other,saved,other);
dec(dr);
end;
end;
var a,c:integer;
begin
c:=4
write (' :> ');
read(a);
mdelay (7400);
if c=a then
(запустить прогу снова. КАК?)
else writeln ('STOP');
end;
end.

Вопрос: как сюда еще впиндюрить процедурку звука, как сделать, чтобы отображать время, как задать замкнутый цикл проги?

Добавлено: Sat Aug 18, 2007 12:59 am

Firelander

Хе-хе, всё не так просто, к примеру пароль нельзя считывать через read или через readln. Что же, релиз слегка откладывается(не не надолго), но это явление нормальное. Главное, что я начал. Кинь мыло в личку, пришлю прогу, которая задаёт настройки.

Добавлено: Sat Aug 18, 2007 8:50 am

ZoneRR

я покрайнемере незнаю как реализовать в паскале то,чтобы ты вводиш пароль а он пямо в ето время пиликал и отображал всякую нужную тебе ебень(всмысле обновляя ее), т.к. понятно, что read и readln прерывают цыкл проги. Если нету такой команды в паскале чтобы не прерывала, то на паскале+асмовая вставка или чистый асм(что ессно сложней) самое оно. int 08h в помощь тебе)) (08h это системный таймер что 18.2 раз в секунду вызывается, из него как я счас прочитал вызывается 0Ch но об этом никогда раньш не знал..), а так как дос пашет в реальном режиме проца то кольц защиты тама нету вродеб и мона спакойно сменить вектор прерывания 08h на свою функцию в памяти, есесно незабыв из нее вызывать прежнюю функцию.... (чтото типа сабкласинга в винде). Из той функции в какие-то 2 ячейки памяти(16 бит) писаь число и увеличивать его на нужное число. там же сделать обработчик BEEPов(точней организовать вызов этой функции) и считывание определенной ячейки куда паскаль будет шпарить какоето число при введении пасворда пральном.
Эээх мож все что я тут написал есть бред, так как мои познания в асме лиш какието маааленькие и асмой я ваще не занималцо мона сказать.....

Добавлено: Sat Aug 18, 2007 9:11 am

KaV

В паскале есть функция KeyPressed, которая возвращает false, если какая-то клавиша была нажата.
После подтверждения сего факта функцией ReadKey читаем введённый символ. Иначе - пищим или чего там надо...

Добавлено: Sat Aug 18, 2007 10:09 am

ZoneRR

сорри забыл про функцию - ессно асма ненада вроде тогда)) токо возвращает она то true в случае нажатийа клавиши...

Добавлено: Sat Aug 18, 2007 10:27 am

Firelander

Ассемболером я не слишком хорошо владею, потому буду юзать что-то вроде if keypressed the c:=readkey, как верно заметил KaV Smile

Добавлено: Sat Aug 18, 2007 10:42 am

KaV

ZoneRR писал(а):
сорри забыл про функцию - ессно асма ненада вроде тогда)) токо возвращает она то true в случае нажатийа клавиши...
Действительно, прото в голову пришло только "repeat <> until keypressed", только щас дошло, что repeat в паскале "особый" Smile

Добавлено: Sat Aug 18, 2007 11:44 am

Firelander

Всё, альфа-версия готова, тестируй Smile

Добавлено: Sat Aug 18, 2007 1:24 pm

proga.rar (9.75 Кб)

Фролов

Ну что-ж впринципе все в порядке. Хорошо бы еще сделать так, чтобы при вводе пароля таймер сарзу сбрасывался и запускался снова. И еще, можно сделать так, чтобы когда останется 120 сек,Предупредительный сигнал шел через кажые две секунды, а кокда останентся 10 сек, через каждую секунду? Надо-бы синхронизировать тикание таймера и сигналы.

PS: большое спасибо!!!!!! :D

Добавлено: Sat Aug 18, 2007 7:38 pm

Фролов

Вот еще только что выявил баг: если пароль не ввести в конце выскакивает надпись "пароль не введен, остановка" и беспрерывный сигнал. Этого сигнала быть не должно.
Кстати, если можно кинь исходнег. :wink:

Добавлено: Sat Aug 18, 2007 7:51 pm

Firelander

Сигнала действительно быть не должно... странно. Кидаю исходник. Потом посмотрю, пока некогда.

Добавлено: Sat Aug 18, 2007 10:01 pm

TP7.rar (1.39 Кб)

Firelander

Самый конец программы.

Код:

...
...
...
until not psve;
clrscr;
writeln('Пароль не введён, остановка');
readkey;
end.

после "until not psve;" добавить: "nosound;" Проблема должна решиться.

Добавлено: Sat Aug 18, 2007 10:30 pm