VPF::Графика в Паскале - Божья Коровка

AxCx

Дата 26.8.2008, 12:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.6.2008

Репутация: нет
Всего: нет

Итак, задача состоит в следующем: программа одолжна вывести на экран движущуюся божью коровку. Неважно в каком направлении.
Пока я на стадии движущегося красного эллипса :(

Код


Program CATA696;
uses Graph, Crt;
var X,Y:integer;
    U1,U2:integer;
    x1,x2,y1,y2:integer;
    dx,dt,dy:integer;
    grDriver:integer;
    grMode:integer;
    grPath:string;
    ErrCode:integer;
    Key:char;
begin
     grdriver:=VGA;
     grMode:=VGAHi;
     grPath:='D:\Programming\TP_7.1\BGI';
     InitGraph(grDriver,grMode,grPath);
     ErrCode:=GraphResult;
     if ErrCode <> grOk then
      begin
        writeln ('Initialization error of a graphic mode.');
        writeln ('Press <Enter> for exit');
        readln; Halt(1);
      end;
     X:=1;
     Y:=223;
     U1:=78;
     U2:=58;
     dx:=2;
     dt:=900;
     x1:=1;
     x2:=223;
     y1:=150;
     y2:=223;
     while x<639 do
       begin
         SetBkColor(Green);
         SetColor(Black);
         SetFillStyle(1,Red);
         FillEllipse(X,Y,U1,U2);
         SetColor(Blue);
         SetLineStyle(2,0,3);
         Line(1,223,150,223);
          repeat
           Delay(dt);
           Setcolor(0);
           FillEllipse(X,Y,U1,U2);
           x:=x+dx;
          until KeyPressed;
           Key:=Readkey; ClearDevice;
       end;
CloseGraph;
end.

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

Заранее спасибо за ответы.

Это сообщение отредактировал(а) volvo877 - 26.8.2008, 17:32

Virtuals

Дата 26.8.2008, 13:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 476
Регистрация: 27.11.2006

Репутация: нет
Всего: 11

Код


procedure WriteKOROVA(x,y,lx,ly:word;clear:boolean);
begin

SetViewPort(x,y,x+lx,Y+ly ,false);
ClearViewPort;
SetViewPort(0,0,getmaxx,getmaxy,false);
if clear then exit;
FillEllipse(x+lx div 2,y+ly div 2,lx div 2,ly div 2) ;
end;

пользовать так

WriteKOROVA(старые координаты, да)
получить новые координаты
WriteKOROVA(новые координаты, нет)

Sartorius

Дата 26.8.2008, 15:00 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1568
Регистрация: 18.7.2006
Где: Ivory tower

Репутация: нет
Всего: 37

Делай спрайтом. Не мучайся smile

AxCx

Дата 26.8.2008, 15:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.6.2008

Репутация: нет
Всего: нет

Спрайтом?

Sartorius

Дата 26.8.2008, 16:48 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1568
Регистрация: 18.7.2006
Где: Ivory tower

Репутация: нет
Всего: 37

GetImage/PutImage + PCX погугли

AxCx

Дата 26.8.2008, 17:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.6.2008

Репутация: нет
Всего: нет

IntGIF v.1.1 - GIF FIle Interrogator for TP 5.5?
Как я понимаю, она переводит GIF'ы на язык ТП?
Утилита не работает, ссылается на отсутствие PARAM.TPU, хотя он присутствует в этой же папке =/

Sartorius

Дата 26.8.2008, 17:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1568
Регистрация: 18.7.2006
Где: Ivory tower

Репутация: нет
Всего: 37

Цитата

Функция ImageSize(X1,Y1,X2,Y2:Integer):Word; Возвращает размер памяти в байтах, необходимый для размещения прямоугольного фрагмента изображения.  Здесь координаты левого верхнего (Х1, Y1) и правого нижнего (Х2, Y2) углов фрагмента изображения.

Процедура Getimage(X1,Y1,X2,Y2: Integer; var Buf);

Помещает в память копию прямоугольного фрагмента изображения.  Здесь X1...  Y2 - координаты углов фрагмента изображения; Buf - изменение или участок кучи, куда будет помещена копия видеопамяти с фрагментом изображения.

Размер Вuf должен иметь не меньшее значение, что возвращается функцией ImageSize с теми же координатами X1...  Y2.

Процедура Putimage(X,Y: Integer; var Buf; Mode: Word);

Выводит в заданное место екрана копию фрагмента изображения, ранее помещенную в память процедурой Getimage.  Здесь X,Y - координаты левого верхнего углов того места на экране, куда будет скопирован фрагмент изображения; Buf - изменение или участок кучи, откуда берется изображение; Mode - средство копирования.

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

Параметр Mode определяет средство взаимодействия размещаемой копии с уже имеющимся на экране изображением.  Взаимодействие осуществляется путем применения кодируемых этим параметром логических операций к каждому биту копии и изображения.  Для указания применяемой логической операции можно использовать одну из таких предварительно определенных констант:

NormalPut=0 Замена существующего изображения на копию

XorPut   =1 Исключающее ИЛИ

OrPut    =2 Объединяющее ИЛИ

AndPut   =3 Логическое И

NotPut   =4 Инверсия изображения

Больше всего часто используются операции NormalPut, XORPut и NotPut.  Первая из них просто стирает часть екрана и на это место помещает копию из памяти в том виде, как она там сохраняется.  Операция NotPut делает то же самое, но копия выводится в инверсном виде. ;

AxCx

Дата 27.8.2008, 14:42 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.6.2008

Репутация: нет
Всего: нет

Ясно, но мне всё равно надо будет показать исходник программы..

Цитата

Program Korova;
uses Graph, Crt;
var x,y:integer;
procedure GraphInterFace;
Var driver, mode, error:Integer;
    s: String;
begin
     driver:=detect; s:='';
     InitGraph(driver,mode,s);
     error:=GraphResult;
     if error<>GrOk then
     begin
          writeln(GraphErrorMsg(Error));
          Halt(error);
     end;
end;   {GraphInterFace}
begin
     graphinterface;
     x:=100;
     y:=223;
     SetLineStyle(0,0,3);
     SetColor(Black);
     SetFillStyle(1,Red);
     FillEllipse(x,y,78,58);
     Line(23,223,176,223);
     SetFillStyle(1,Black);
     Circle(x-20,y-40,8);
     FloodFill(x-20,y-40,Black);
     Circle(x+50,y-10,10);
     FloodFill(x+50,y-10,Black);
     Circle(x+10,y+47,7);
     FloodFill(x+10,y+47,Black);
     Circle(x-20,y+32,10);
     FloodFill(x-20,y+32,Black);
     Circle(x+57,y+23,5);
     FloodFill(x+57,y+23,Black);
     Circle(x-45,y-13,10);
     FloodFill(x-45,y-13,Black);
     Circle(x+18,y-21,8);
     FloodFill(x+18,y-21,Black);
     Setcolor(Black);
     Circle(x+86,y,20);
     Setcolor(White);
     Line(176,226,195,240);
     Line(176,220,195,210);
readln;
closegraph;
end.

Коровка практически готова, осталось сделать так. чтобы всё это двигалось.. Можно как-нибудь обойтись без написания цикла для каждого кружка и эллипса или нет?

Это сообщение отредактировал(а) AxCx - 27.8.2008, 16:41

Dobermann

Дата 27.8.2008, 19:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Сделай окно в цикле, и в нем сделай дорогу, типа это окно будет двигаться, а б.к. нет

volvo877

Дата 27.8.2008, 21:28 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Цитата(AxCx @ 27.8.2008, 14:42

)

Можно как-нибудь обойтись без написания цикла для каждого кружка и эллипса или нет?

Можно как-нибудь запихать отрисовку всей твоей "коровки" в процедуру (X, Y передавая как параметры), и ее (процедуру) вызывать в цикле, или нет?

AxCx

Дата 28.8.2008, 09:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 8
Регистрация: 6.6.2008

Репутация: нет
Всего: нет

Да, я что-то подобное имел ввиду, но не знаю, как это реализовать =(

Virtuals

Дата 28.8.2008, 16:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 476
Регистрация: 27.11.2006

Репутация: нет
Всего: 11

Цитата

Да, я что-то подобное имел ввиду, но не знаю, как это реализовать =(

AxCx,

f а это то что тебе выше писал?

Код


procedure WriteKOROVA(x,y,lx,ly:word;clear:boolean);
begin

SetViewPort(x,y,x+lx,Y+ly ,false); //задаем окно
ClearViewPort; //и стираем все в нем нафиг
SetViewPort(0,0,getmaxx,getmaxy,false); //возвращаем размеры окна к полноразмерному экрану
if clear then exit; //если стоял флаг только потереть то свалить

//вот сдесь ты и рисуеш свою коровку!, только учти что оня обязанна уместится по координатам x,y с размерами xl,yl
//FillEllipse(x+lx div 2,y+ly div 2,lx div 2,ly div 2) ;

end;

и пользовать так

Код


var x,y:byte;
x:=1;
y:=1;
repeat
WriteKOROVA(x,y,shirinakorovi,visotakorovi, true) //потерли старую корову
inc(x,1); //получили новые координаты
WriteKOROVA(x,y,shirinakorovi,visotakorovi, нет) //потерли место под коровой и отрисовали

until x>100;

Dracogemini

Дата 13.6.2009, 11:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 13.6.2009

Репутация: нет
Всего: нет

Если не трудно, то помогите чтобы божья коровка двигалась:

Код


Program Korova;
uses Graph, Crt;
var x,y:integer;
procedure GraphInterFace;
Var driver, mode, error:Integer;
    s: String;
begin
     driver:=detect; s:='';
     InitGraph(driver,mode,s);
     error:=GraphResult;
     if error<>GrOk then
     begin
          writeln(GraphErrorMsg(Error));
          Halt(error);
     end;
end;   {GraphInterFace}
begin
     graphinterface;
     x:=100;
     y:=223;
     SetLineStyle(0,0,3);
     SetColor(Black);
     SetFillStyle(1,Red);
     FillEllipse(x,y,78,58);
     Line(23,223,176,223);
     SetFillStyle(1,Black);
     Circle(x-20,y-40,8);
     FloodFill(x-20,y-40,Black);
     Circle(x+50,y-10,10);
     FloodFill(x+50,y-10,Black);
     Circle(x+10,y+47,7);
     FloodFill(x+10,y+47,Black);
     Circle(x-20,y+32,10);
     FloodFill(x-20,y+32,Black);
     Circle(x+57,y+23,5);
     FloodFill(x+57,y+23,Black);
     Circle(x-45,y-13,10);
     FloodFill(x-45,y-13,Black);
     Circle(x+18,y-21,8);
     FloodFill(x+18,y-21,Black);
     Setcolor(Black);
     Circle(x+86,y,20);
     Setcolor(White);
     Line(176,226,195,240);
     Line(176,220,195,210);
readln;
closegraph;
end.

А то из этого у меня ничего не получается...

marinovsoft

Дата 13.6.2009, 21:14 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 25.1.2009
Где: Кемерово

Репутация: нет
Всего: нет

примерно так

Код


Program Korova;
uses Graph, Crt;
var x,y:integer;
    dx:Integer;
    dy:Integer;
procedure GraphInterFace;
Var driver, mode, error:Integer;
    s: String;
begin
     driver:=detect; s:='c:\bp\bgi';
     InitGraph(driver,mode,s);
     error:=GraphResult;
     if error<>GrOk then
     begin
          writeln(GraphErrorMsg(Error));
          Halt(error);
     end;
end;   {GraphInterFace}
begin
     graphinterface;
     x:=100; dx:=1;
     y:=223; dy:=0;
     repeat
     x:=x+dx;
     y:=y+dy;
     if (x>=640) or (x<=0) Then dx:=-dx;
     if (y>=480) or (y<=0) Then dy:=-dy;
     SetLineStyle(0,0,3);
     SetColor(Black);
     SetFillStyle(1,Red);

     FillEllipse(x,y,78,58);

     Line(x-77,y,x+76,y);

     SetFillStyle(1,Black);
     Circle(x-20,y-40,8);
     FloodFill(x-20,y-40,Black);
     Circle(x+50,y-10,10);
     FloodFill(x+50,y-10,Black);
     Circle(x+10,y+47,7);
     FloodFill(x+10,y+47,Black);
     Circle(x-20,y+32,10);
     FloodFill(x-20,y+32,Black);
     Circle(x+57,y+23,5);
     FloodFill(x+57,y+23,Black);
     Circle(x-45,y-13,10);
     FloodFill(x-45,y-13,Black);
     Circle(x+18,y-21,8);
     FloodFill(x+18,y-21,Black);
     Setcolor(Black);
     Circle(x+86,y,20);
     Setcolor(White);

     Line(x+76,y+3,x+95,y+17);
     Line(x+76,y-3,x+95,y-13);

     until keypressed;
closegraph;
end.

Это сообщение отредактировал(а) volvo877 - 14.6.2009, 09:51

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »