Версия для печати темы

Автор: Diamond 17.05.2009 16:09

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

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

Автор: volvo 17.05.2009 17:11

Ну, например, попробуй так:

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.

Задержку изменишь по необходимости... Раскрасишь нужными цветами - тоже...

Автор: Diamond 17.05.2009 18:15

Да..спасибо..разобралась. Огромное спасибо за помощь

Автор: Diamond 17.05.2009 19:12

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

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.

Автор: volvo 18.05.2009 14:13

Ну, смотри, вот одна из возможных реализаций:

   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. Следующий вопрос, если он будет, не относящийся к этим программам, задавай в новой теме...