IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Паскаль. Задача на графику..помогите доделать((
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 5
Пол: Женский
Реальное имя: Анастасия

Репутация: -  0  +


Здравствуйте. Мне нужно нарисовать кораблик, который двигался бы по синусоиде..вот кораблик вроде сделала, разобралась, но он плывет по прямой..и то коряво..помогите пожалуйста..подскажите что не так..
program 1; 
uses graph, crt; 
var 
grDriver, grMode, ErrCode, i: Integer; 
n: char; 
p: fillpatterntype; 
begin 
grDriver := Detect; 
InitGraph(grDriver, grMode,' '); 
ErrCode := GraphResult; 
if ErrCode = grOk then 
begin 
while n<>#27 do 
begin 
setbkcolor(9); 
line(600, 240, 500, 240); 
line(500, 240, 480, 200); 
line(600, 240, 610, 200); 
line(480, 200, 610, 200); 
rectangle(590, 150, 560, 200); 
rectangle(540, 170, 525, 200); 
moveto(10, 245); 
for i:=0 to 640 do 
begin 
lineto(i, round(2*sin(i*0.2))+245); 
end; 
getfillpattern(p); 
setfillpattern(p, 1); 
floodfill(480, 300, white); 
setfillpattern(p, 3); 
floodfill(1, 1, 15); 
n:=readkey; 
if n=' ' then 
begin 
for i:=0 to 520 do 
begin 
line(600-i, 240, 500-i, 240); 
line(500-i, 240, 480-i, 200); 
line(600-i, 240, 610-i, 200); 
line(480-i, 200, 610-i, 200); 
rectangle(590-i, 150, 560-i, 200); 
rectangle(540-i, 200, 575-i, 200); 
setcolor(black); 
line(600-i, 240, 500-i, 240); 
line(500-i, 240, 480-i, 200); 
line(600-i, 240, 610-i, 200); 
line(480-i, 200, 610-i, 200); 
rectangle(590-i, 150, 560-i, 200); 
rectangle(540-i, 200, 575-i, 200); 
end; 
end; 
end; 
CloseGraph; 
end 
else 
Writeln('Graphics error:', GraphErrorMsg(ErrCode)); 
end
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Ну, например, попробуй так:
program p1;
uses graph, crt;

procedure DrawShip(px, py: integer);
begin
  line(px, py, px-100, py);
  line(px-100, py, px-120, py-40);
  line(px, py, px+10, py-40);
  line(px-120, py-40, px+10, py-40);
  rectangle(px-10, py-90, px-40, py-41);
  rectangle(px-60, py-70, px-75, py-41);
end;

var
  grDriver, grMode, ErrCode, i: Integer;
  n: char;
  p: fillpatterntype;
  x: integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,' ');
  ErrCode := GraphResult;
  if ErrCode = grOk then begin
    moveto(10, 245);
    for i:=0 to 640 do begin
      lineto(i, round(2*sin(i*0.2))+245);
    end;

    setwritemode(XORput);
    x := 600;
    repeat
      drawship(x, round(2*sin(x*0.2))+240);
      delay(44); { <--- Задержку подберешь сама ... }
      drawship(x, round(2*sin(x*0.2))+240);
      dec(x);
      if keypressed
        then n := readkey;
    until (n = #27);
    setwritemode(CopyPut);
    CloseGraph;
  end
  else
    Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.
Задержку изменишь по необходимости... Раскрасишь нужными цветами - тоже...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 5
Пол: Женский
Реальное имя: Анастасия

Репутация: -  0  +


Да..спасибо..разобралась. Огромное спасибо за помощь smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 5
Пол: Женский
Реальное имя: Анастасия

Репутация: -  0  +


А можно к вам еще обратиться. У меня задача такая, нужно нарисовать землю и вращающуюся вокруг нее луну, при чем так фто бы луна пересекала землю сзади. Ну вот они у меня движутся, только никак не могу раскрасить и не понимаю как сделать так фто бы луна пересекала землю, но изображение земли при этом не повреждалось..
uses graph, crt;
const a = 300;
      b = 230;
      r = 150;
      r1 =10;
      dphi =  2*Pi/72;
      n  =18;
var grDriver,
    grMode,
    grErr:integer;
    i, x, y:integer;
    phi :real;

begin
   grDriver:=Detect;
   InitGraph(grDriver, grMode,'c:\');
   grERR:=graphResult;
   if grErr<>grOK then
   begin
     writeln('ошибка ',graphErrorMsg(grErr));
     halt
   end;
   setcolor(green);
   circle( a, b, r div 2 );
   phi:= 0;
   while not keypressed  do
   begin
     y:=round(R*sin(phi)/2);
     x:=round(R*cos(phi));
     setcolor(green);
     circle(x+a,y+b,R1);

     delay(5000);

     setcolor( getBkColor );
     circle(x+a,y+b,R1);
     phi:= phi+dphi;
   end;

   closegraph;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Ну, смотри, вот одна из возможных реализаций:
   setfillstyle(solidfill, blue); { рисуем Землю }
   fillellipse(a, b, R div 2, R div 2);
   setcolor(white);
   circle(a, b, R div 2);

   phi:= 0;
   while not keypressed  do
   begin
     y:=round(R*sin(phi)/2);
     x:=round(R*cos(phi));

     setfillstyle(solidfill, lightgray); { рисуем Луну }
     fillellipse(x+a, y+b, R1, R1);

     if y < 0 then begin { если Y < 0, а следовательно, Земля закрывает Луну }
        setfillstyle(solidfill, blue); { , то поверх только что нарисованной Луны перерисовываем Землю }
        fillellipse(a, b, R div 2, R div 2);
        setcolor(white);
        circle(a, b, R div 2);
     end;

     delay(75);

     setcolor(getbkcolor); { а теперь затираем изображение луны, для чего }
     setfillstyle(solidfill, getbkcolor); { рисуем цветом фона чуть бОльший круг }
     fillellipse(x+a, y+b, R1+2, R1+2);

     setfillstyle(solidfill, blue); { и, поскольку, изображение Земли тоже могла пострадать, }
     fillellipse(a, b, R div 2, R div 2); { перерисовываем и ее... }
     setcolor(white);
     circle(a, b, R div 2);

     phi:= phi+dphi;
   end;
Но у этого способа есть небольшой недостаток: он будет мерцать. Чтобы избавиться от мерцания придется несколько усложнить программу, скажем перейти на многостраничную графику: на одной странице рисуем, другую в этот момент показываем, потом переключаемся на уже отрисованное (страница обновляется за один проход луча, мерцания не видно). Примеры таких программ посмотри в поиске по форуму, ключевые слова SetVisualPage и SetActivePage.

Можно сделать и без многостраничности: проверять, касается ли Луна Земли (портит ее изображение) или нет. Если нет - то можно не отрисовывать Землю повторно, это уменьшит мерцания. Но когда Луна будет проходить перед Землей или позади нее - мерцание все же останется, поэтому первый способ все-же предпочтительнее.

P.S. Следующий вопрос, если он будет, не относящийся к этим программам, задавай в новой теме...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.04.2025 22:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name