Наложение фигур Опции

[ТОХА]

мышку одолел,

вопрос покажется странным но как сделать так чтобы перерисовка картинки занимала больше времени, я понимаю что все стараются избавляться от перерисовки всего экрана, но мне это нужно для того чтоб человеческий глаз начинал воспринимать весь экран заново а не только появившуюся часть

можно ли рисовать черный прямоугольник на весь экран на секунду а потом убирать его и чтоб на нем сохранилось все что было до его рисования?

[volvo]

можно ли рисовать черный прямоугольник на весь экран на секунду а потом убирать его и чтоб на нем сохранилось все что было до его рисования?

Вообще самым оптимальным было бы использовать граф. режим, в котором есть больше одной видеостраницы. Рисуешь на активной, в это время видимой установлена другая. Когда нужное время прошло - меняешь видимую страницу, у тебя мгновенно отображается рисунок.

Но...

1) чтобы было больше одной страницы, надо чем-то пожертвовать. В твоем случае - придется жертвовать разрешением. Например, вместо VgaHi (640*480) использовать VgaMed (640*350), там есть 2 страницы.
2) я не знаю, как будет вести себя мышь в случае использования нескольких видеостраниц.

[ТОХА]

а с помощью комманд getimage и putimage можно сделать так?:
1 нарисовать появившийся круг
2 сохранить весь экран
3 очистить
4 нарисовать сохраненный фрагмент
и если можно то насколько быстро это будет происходить чтоб не успеть воспринять 1 пункт, а то смысл игры становится не таким интересным

[volvo]

А ты знаешь, мне тут еще один финт в голову пришел. Попробуй, будет оно работать или нет, мне сейчас негде, Турбо Паскаля под рукой нет, а в 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;

[volvo]

Ты б прикрепил весь файл полностью (можно в приват), как только доберусь до TP - посмотрю, что там творится... А то так "глухие телефоны" получаются...

[ТОХА]

ок в приват скину, а то при защите найдут проект мой тута и скажут скачал

[volvo]

Что-то я не понял, чего ты творишь... Вот тут:

   { из основной }
   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;

Опять же, чисто теоретически, проверить будет где в лучшем случае послезавтра...

[ТОХА]

модуль мыши просто из FAQ брал,
как я и предпологал он рисует все круги сразу, как будто buttonpressed=1 это отсутсвие нажатия клавиши

Добавлено через 4 мин.
при изменении buttonpressed=1 -> buttonpressed=5 результат тот же, как будто условия вовсе нет

[ТОХА]

ошибка в buttonpress это 100%, изменил условие начала вместо левой кнопки на ентер с учетом координат мыши, работает

[volvo]

Так... Нашел 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-часть кода.

[ТОХА]

Эврика
все работает, буду до конца вечера тестить на баги)
без вас я бы не справился, это точно))

[andriano]

Предлагаю придумать не потенциально-бесконечный алгоритм.

Действительно, стоит изменить лишь одну константу:
r := Random(k) + 20;
чтобы потенциально бесконечный алгоритм превратился в реально бесконечный.
Действительно, хороший алгоритм должен:
1. Давать правильный результат при корректных данных.
2. Давать предсказуемый результат (в частности, отсутствие деструктивных действий таких как завершение программы по ошибке, зацикливание, порча памяти...) при некорректных данных.
Очевидно, если алгоритм приводит к зацикливанию программы при изменении внешних констант (т.е. таких, которые не являются имманентной частью алгоритма), то это плохой алгоритм.
Желательно также, чтобы он сообщал пользователю о конкретной ошибке.
Предлагаю что-то вроде.

      IntIt := 0;
      repeat
        r := Random(k) + 20;
        X1 := Random(GetMaxX - r*2) + r;
        Y1 := Random(GetMaxY - r*2) + r;

        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 строки листинга).

Сообщение отредактировано: andriano - 2.04.2011 18:20

[volvo]

Действительно, стоит изменить лишь одну константу:

А ты не меняй, и алгоритм бесконечным не будет. Если я этого не сделал - по какому праву это делаешь ты? Языком потрепать захотелось? Ты пришел по неверному адресу: я больше не буду молчать в ответ на всякие бредни. Ответ будет жестким. Не дойдет с первого раза - во второй раз будет еще жестче.

Очевидно, если алгоритм приводит к зацикливанию программы при изменении внешних констант (т.е. таких, которые не являются имманентной частью алгоритма), то это плохой алгоритм.

В таком случае, хороших алгоритмов не существует. В любом случае можно так поменять внешнюю константу, что ЛЮБОЙ алгоритм (вернее, его реализация) перестанет работать.

Еще раз: без изменения констант ни одного зацикливания на миллиарды тестов не наблюдается. Разглагольствования типа "где-то там, у сферического пользователя в вакууме, это может быть не сработает, и программа зависнет" меня не интересуют. Я - практик. Программа зависает? Нет. Еще вопросы будут?

[ТОХА]

защитил проект сегодня удачно
всем спасибо за помощь
кому интересно что получилось прикладываю проект, делимся на скока шариков у кого хватило зрительной памяти)

[Lapp]

кому интересно что получилось прикладываю проект, делимся на скока шариков у кого хватило зрительной памяти)

Мне было интересно, но - увы! у меня уже везде W7 или Vista. Даже и ТР есть, но полноэкранная графика для меня уже недоступна.

Все же это странно - обучать студентов на таком старье, как TP.

[ТОХА]

я не студент
учусь в 10 классе)

[hydroxychloroquine sulfate 200 m]

Cialis Super Actif Plus

[is gabapentin a controlled subst]

Compro Viagra Poco Prezzo Mexico