Помощь - Поиск - Пользователи - Календарь
Полная версия: Движущееся цветное изображение
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
18192123
Написать программу, результатом работы которой будет движущееся по экрану монитора цветное изображение настольной лампы.

У меня ооочень глупый вопрос: не представляю, каким способом нарисовать, чтоб было более менее похоже на лампу!
мисс_граффити
а можешь нарисовать (в пэйнте, на листике - не важно) свое видение лампы?
18192123
Что-то такое.....

(см картинку в следующем посте)
Bokul
У кого проблемы с инетом и не в силах качать 1.5 мега вот jpg вариант:
Нажмите для просмотра прикрепленного файла

PS красиво вышло good.gif
18192123
Цитата(Bokul @ 3.03.2007 21:45) *

У кого проблемы с инетом и не в силах качать 1.5 мега вот jpg вариант:
Нажмите для просмотра прикрепленного файла

PS красиво вышло good.gif

Спасибо! Теперь осталось мне реализовать что-то подобное...
volvo
18192123, на форуме есть процедура, которая выводит BMP файл в определенное место экрана... Выведи изображение один раз с ее помощью, потом "захвати" изображение с помощью GetImage, и просто в цикле используй PutImage (с предварительной очисткой изображения, выведенного на предыдущем шаге)...

Примеры использования GetImage/PutImage были на форуме, посмотри в поиске...
мисс_граффити
если не bmp-шку двигать, а именно лампочку рисовать....
у меня как-то так получилось (процедура, рисующая лампу в заданном месте):
procedure lamp(const x,y: integer);
begin
setcolor(5);
ellipse(x+200,y+200,0,360,20,10);
setfillstyle(1,5);
floodfill(x+200,y+200,5);
setcolor(13);
ellipse(x+200,y+185,0,360,10,5);
setfillstyle(1,13);
floodfill(x+200,y+185,13);
ellipse(x+180,y+240,0,360,30,15);
floodfill(x+180,y+240,13);
setcolor(15);
ellipse(x+185,y+180,0,180,15,10);
moveto(x+170,y+180);
lineto(x+170,y+240);
ellipse(x+185,y+245,0,360,5,2);
setfillstyle(1,15);
floodfill(x+185,y+245,15);
readkey;
end;
18192123
volvo , спасибо за информацию, буду знать и о таком способе!
Но мне больше подходит вариант мисс_граффити (именно с рисованием)

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

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


Uses Graph, Crt;
procedure lamp( x,y: integer);
begin
setcolor(5);
ellipse(x+200,y+200,0,360,20,10);
setfillstyle(1,5);
floodfill(x+200,y+200,5);
setcolor(13);
ellipse(x+200,y+185,0,360,10,5);
setfillstyle(1,13);
floodfill(x+200,y+185,13);
ellipse(x+180,y+240,0,360,30,15);
floodfill(x+180,y+240,13);
setcolor(15);
ellipse(x+185,y+180,0,180,15,10);
moveto(x+170,y+180);
lineto(x+170,y+240);
ellipse(x+185,y+245,0,360,5,2);
setfillstyle(1,15);
floodfill(x+185,y+245,15);
readkey;
end;
var
DriverVar, ModeVar, ErrCode, x, y: integer;
dx, dt : integer;
begin
clrscr;
DriverVar := Detect; ModeVar := VGAHi;
InitGraph (DriverVar, ModeVar,'');
ErrCode := GraphResult;
if ErrCode = grOk then begin
dx := 15;
dt := 70;
while x < 600 do begin

lamp (x,y);
Delay(dt);
SetColor(0);
lamp(x,y);
x := x+dx;
end;
end else
closegraph;
end.




P.S.
мисс_граффити, твоя лампа - просто супер!


volvo
Вот так должна выглядеть основная программа:
begin
DriverVar := Detect; ModeVar := VGAHi;
InitGraph (DriverVar, ModeVar,'');
ErrCode := GraphResult;
if ErrCode = grOk then begin
dx := 15; dt := 70;
while x < 600 do begin
lamp (x,y);
Delay(dt);
cleardevice;
x := x+dx;
end;
readln;
closegraph;
end
end.
Только учти, что перерисовывается лампа дольше, чем выводится через PutImage... Запусти программу, узнаешь, к чему это я... Только ReadKey из процедуры отрисовки лампы убери...
мисс_граффити
ой... сорри за readkeу
забыла убрать.
18192123
Цитата(volvo @ 4.03.2007 18:23) *

Только учти, что перерисовывается лампа дольше, чем выводится через PutImage... Запусти программу, узнаешь, к чему это я... Только ReadKey из процедуры отрисовки лампы убери...

у меня до сих пор ничего не вырисовалось....(минут 5 ждала...)
об этом шла речь?

а если вырисовать процедурой lamp изображение, потом нельзя использовать GetImage/PutImage для его движения?
volvo
Цитата
а если вырисовать процедурой lamp изображение, потом нельзя использовать GetImage/PutImage для его движения?
Можно... Разницы нет, КАК ты будешь первоначально выводить изображение на экран.
мисс_граффити
поставь dt побольше (несколько тысяч) - ты просто не успеваешь заметить smile.gif
18192123
Цитата(мисс_граффити @ 4.03.2007 18:54) *

поставь dt побольше (несколько тысяч) - ты просто не успеваешь заметить smile.gif

ой! и правда!

Всем огромное спасибо за помощь!
Артемий
ClearDevice.
volvo
Артемий2, а ты в программе ClearDevice не заметил?

Или берешь пример с Time? Тогда не удивляйся, если результат получишь такой же! Устное предупреждение за флуд...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.