1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Здравствуйте! при написании одного из модулей программы я столкнулся с такой проблемой как наложение фигур друг на друга. Как сделать так чтоб последующая фигура рисовалась на свободном месте экрана и не накладывалась на другие?
uses Crt, Graph; const k=100; var GraphDriver, GraphMode: Integer; X1,y1, r: Integer;ch:char; begin GraphDriver := Detect; InitGraph(GraphDriver, GraphMode, ' '); if GraphResult<> grOk then Halt(1); repeat ch:=readkey; if ch=chr(13) then begin X1 := Random(640-k)+k; y1 := Random(480-k)+k; r:=Random(k)+1; circle(X1,y1,r); end; until ch=chr(27); CloseGraph; end.
вопрос покажется странным но как сделать так чтобы перерисовка картинки занимала больше времени, я понимаю что все стараются избавляться от перерисовки всего экрана, но мне это нужно для того чтоб человеческий глаз начинал воспринимать весь экран заново а не только появившуюся часть
можно ли рисовать черный прямоугольник на весь экран на секунду а потом убирать его и чтоб на нем сохранилось все что было до его рисования?
можно ли рисовать черный прямоугольник на весь экран на секунду а потом убирать его и чтоб на нем сохранилось все что было до его рисования?
Вообще самым оптимальным было бы использовать граф. режим, в котором есть больше одной видеостраницы. Рисуешь на активной, в это время видимой установлена другая. Когда нужное время прошло - меняешь видимую страницу, у тебя мгновенно отображается рисунок.
Но...
1) чтобы было больше одной страницы, надо чем-то пожертвовать. В твоем случае - придется жертвовать разрешением. Например, вместо VgaHi (640*480) использовать VgaMed (640*350), там есть 2 страницы. 2) я не знаю, как будет вести себя мышь в случае использования нескольких видеостраниц.
а с помощью комманд getimage и putimage можно сделать так?: 1 нарисовать появившийся круг 2 сохранить весь экран 3 очистить 4 нарисовать сохраненный фрагмент и если можно то насколько быстро это будет происходить чтоб не успеть воспринять 1 пункт, а то смысл игры становится не таким интересным
А ты знаешь, мне тут еще один финт в голову пришел. Попробуй, будет оно работать или нет, мне сейчас негде, Турбо Паскаля под рукой нет, а в FPC это не отработает.
{ Отрисовал картинку, теперь надо "погасить" на секунду }
{ Гасим. Для этого просто все цвета сделаем "черными" } for i := 1 to 15 do begin setpalette (i, black); { Нулевой цвет я бы не трогал. } end;
readln; { Ждем какое-то время, можешь заменить на Delay }
{ "Проявляем" картинку } for i := 1 to 15 do begin setpalette (i, i); end; { ... и рисуем новую окружность сразу после "проявки"... }
Как тебе такой вариант?
P.S. Еще более наглый вариант - попробовать рисовать вслепую, пока цвета палитры сброшены в черный. То есть, устанавливаешь цвет через SetColor, и рисуешь. В принципе, не вижу причин, чтоб потом, при восстановлении палитры это не "проявилось".
работает, правда белый цвет поменялся на голубой, проверял на самом первом с кругами без меню, но все равно спасибо)))
Добавлено через 4 мин. на основную программу не очень повлияло, там красный используется, курсор голубой только
Добавлено через 19 мин. для окончательного завершения осталось только подправить функцию mousein, у меня 1 из 10 запусков она хоть как-то работает на шариках и то под восьмой сбивается остальные случаи при нахождении курсора внутри она возвращает false, да и способ игры не очень получается, приходится ставить readkey, наводишь мышь и жать энтер, иначе она так быстро рисует и проверяет координаты что я даже навести не успеваю))
Добавлено через 5 мин.
Function MouseIn(KoordX,KoordY,x1,y1,r:word):boolean; var rdx,rcx:word; begin asm mov ax,$03 int $33 mov rdx,dx mov rcx,cx end; MouseIn := (sqr((KoordX-x1)/r) + sqr((KoordY-y1)/r))<=1 end; {из основной} if ButtonPressed=1 then begin GetMouseXY(KoordX,KoordY); if MouseIn(KoordX,KoordY,x1,y1,r) then next_circle:=true else next_circle:=false; end;
Ты б прикрепил весь файл полностью (можно в приват), как только доберусь до TP - посмотрю, что там творится... А то так "глухие телефоны" получаются...
{ из основной } if ButtonPressed = 1 then begin GetMouseXY(KoordX,KoordY); if MouseIn(KoordX,KoordY,x1,y1,r) then next_circle:=true else next_circle:=false; end;
все логично: если нажата мышь, то взять её координаты. Это понятно. А потом проверить, эти координаты находятся ли внутри окружности радиуса R с центром в (X1, Y1)... Это тоже понятно. Но вот зачем ты внутри MouseIn опять получаешь координаты нажатия - это уже непонятно. Я бы сделал так:
{ Заметь, я сделал параметры типа LongInt сразу, чтоб предотвратить переполнение } Function MouseIn (KoordX, KoordY, x1, y1, r : LongInt) : boolean; begin MouseIn := sqr(KoordX - X1) + sqr(KoordY - Y1) <= sqr®; end;
Опять же, чисто теоретически, проверить будет где в лучшем случае послезавтра...
Так... Нашел DosBox с шестым Турбо-Паскалем... Вот это:
Function MouseIn (x1, y1, r : LongInt) : boolean; var C_X, C_Y: word; begin Asm mov ax, $03 int $33 mov C_X, CX mov C_Y, DX end; MouseIn := sqr(C_X - X1) + sqr(C_Y - Y1) <= sqr®; end;
{ и в основном коде: }
repeat { который после mouse_on }
{ ... } repeat until ButtonPressed = 1; { вместо if ButtonPressed=1 then } { Просто ждем, пока будет нажата левая кнопка мыши, а потом - проверяем, где именно она была нажата }
next_circle := MouseIn(x1, y1, r);
until next_circle = false;
работает достаточно стабильно. Но все равно где-то сбоит, попробуй пройтись отладчиком, посмотреть, какие значения функция MouseIn получает через параметры, и какие координаты мыши выдает Asm-часть кода.
Предлагаю придумать не потенциально-бесконечный алгоритм.
Действительно, стоит изменить лишь одну константу: r := Random(k) + 20; чтобы потенциально бесконечный алгоритм превратился в реально бесконечный. Действительно, хороший алгоритм должен: 1. Давать правильный результат при корректных данных. 2. Давать предсказуемый результат (в частности, отсутствие деструктивных действий таких как завершение программы по ошибке, зацикливание, порча памяти...) при некорректных данных. Очевидно, если алгоритм приводит к зацикливанию программы при изменении внешних констант (т.е. таких, которые не являются имманентной частью алгоритма), то это плохой алгоритм. Желательно также, чтобы он сообщал пользователю о конкретной ошибке. Предлагаю что-то вроде.
ok := true; for i := 1 to curr do ok := ok and (sqr(C[i].X - X1) + sqr(C[i].Y - Y1) > sqr(R + C[i].R)); inc(IntIt); until ok or (IntIt > MaxIt); inc(curr); if IntIt > MaxIt then writeln('Ошибка: невозможно разместить ',curr,'-ю окружность');
Да, прошу еще обратить внимание на порядок, в котором определяются характеристики окружностей, и как именно это сделано (3-5 строки листинга).
Действительно, стоит изменить лишь одну константу:
А ты не меняй, и алгоритм бесконечным не будет. Если я этого не сделал - по какому праву это делаешь ты? Языком потрепать захотелось? Ты пришел по неверному адресу: я больше не буду молчать в ответ на всякие бредни. Ответ будет жестким. Не дойдет с первого раза - во второй раз будет еще жестче.
Цитата
Очевидно, если алгоритм приводит к зацикливанию программы при изменении внешних констант (т.е. таких, которые не являются имманентной частью алгоритма), то это плохой алгоритм.
В таком случае, хороших алгоритмов не существует. В любом случае можно так поменять внешнюю константу, что ЛЮБОЙ алгоритм (вернее, его реализация) перестанет работать.
Еще раз: без изменения констант ни одного зацикливания на миллиарды тестов не наблюдается. Разглагольствования типа "где-то там, у сферического пользователя в вакууме, это может быть не сработает, и программа зависнет" меня не интересуют. Я - практик. Программа зависает? Нет. Еще вопросы будут?
защитил проект сегодня удачно всем спасибо за помощь кому интересно что получилось прикладываю проект, делимся на скока шариков у кого хватило зрительной памяти)