Графика на Паскле

[tanek]

Добрый вечер !!!У меня не большая проблема, мне необходимо вывести прямоугольники, движущиеся вдоль экрана. У меня есть задача про круг, который движтся по экрану. Не могли бы вы мне помочь ее переделать для прямоугольников???

program t1;
var
grmd,i,g:integer;
begin
  grmd:=degetc;
  Initgraph(grdr,grmd,'C:\bp\bgi');
  SetBkColor(lightGray);
  g:=getbkcolor;
  i:=20;
  j:=20;
  while i<GetmaxX do
  begin
    setcolor(red);
    SetFillStyle(1,red);
    FillEllipse(i,j,5,5);
    delay(3000);
    setcolor(g);
    SetFillStyle(1,g);
    FillEllipse(i,j,5,5);
    i:=i+random(3);
    j:=j+random(2);
  end;
  readln;
end.

Зарание спасибо!!!

[Sazary]

Вы "это" хоть запускали?
Половина переменных не объявлена, модули не подключены.

И, собственно, а в чем проблема? Вы не можете заменить эллипс на прямоугольник?

uses graph,crt;
var
d,m : smallint;  // для TP 7 заменить тип на integer
g,i,j : integer;
f : array[1..4] of PointType;
begin
  Initgraph(d,m,'');
  SetBkColor(lightGray);
  g:=getbkcolor;
  i:=20;
  j:=20;
  while i<GetmaxX do
  begin
  if keypressed then
   if readkey = #27 then break;
    setcolor(red);
    SetFillStyle(1,red);
    i:=i+random(3);
    j:=j+random(2);
    f[1].x := i;
    f[1].y := j;
    f[2].x := i + 10 ;
    f[2].y := j;
    f[3].x := i + 10;
    f[3].y := j + 10;
    f[4].x := i;
    f[4].y := j + 10;

    FillPoly(4,f);
    delay(100);
    setcolor(g);
    SetFillStyle(1,g);
    Fillpoly(4,f);
    i:=i+random(3);
    j:=j+random(2);
  end;
  readln;
end.

[tanek]

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

[Sazary]

Вы писали:

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

Я переделал.

Предоставьте свои наработки.

[tanek]

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

Program Rectangls;

uses
  Dos, Crt, Graph;

Const
  RectHeight = 20;
  RectWidth  = 30;
  backgroundColor = 0;
  FillColor = 1;
  BorderColor = 15;
  dx = 10;
  end_x = 300;
  sx = 100;
  sy = 100;
  delay_redraw = 2000;


{$F+}
procedure MyExitProc(var OldExitProc : Pointer);
begin
  ExitProc := OldExitProc; {Восстановите адрес процедуры выхода }
  CloseGraph;              {Закройте графическую систему }
end; { MyExitProc }
{$F-}

procedure Initialize(var OldExitProc : Pointer);
{ Калибруйте графику и сообщите о любых ошибках, которые могут произойти }
var
  InGraphicsMode : boolean; { Инициализация флагов графического режима }
  PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
 GraphDriver:integer;
   MaxX,MaxY:word;
   GraphMode:integer;
   MaxColor:word;
begin
  { when using Crt and graphics, turn off Crt's memory-mapped writes }
  DirectVideo := False;
  OldExitProc := ExitProc;                { save previous exit proc }
  ExitProc := @MyExitProc;                { insert our exit proc in chain }
  PathToDriver := '';
  repeat

{$IFDEF Use8514}                          { check for Use8514 $DEFINE }
    GraphDriver := IBM8514;
    GraphMode := IBM8514Hi;
{$ELSE}
    GraphDriver := Detect;                { use autodetection }
{$ENDIF}

    InitGraph(GraphDriver, GraphMode, PathToDriver);
    ErrorCode := GraphResult;             { preserve error return }
    if ErrorCode <> grOK then             { error? }
    begin
      Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
      if ErrorCode = grFileNotFound then  { Can't find driver file }
      begin
        Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
        Readln(PathToDriver);
        Writeln;
      end
      else
        Halt(1);                          { Some other error: terminate }
    end;
  until ErrorCode = grOK;
  Randomize;                { init random number generator }
  MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  MaxX := GetMaxX;          { Get screen resolution values }
  MaxY := GetMaxY;
end; { Initialize }

procedure abcd(var Rect_offset:integer;var RectanglesOnScreen:Integer);
var
  i:integer;
begin
  for i:=0 to RectanglesOnScreen do
    begin
      if Rect_offset+i*(RectWidth+dx) <= end_x then
      begin
        SetColor(BorderColor);
        MoveTo(sx+Rect_offset+i*(RectWidth+dx),sy);
        LineTo(sx+Rect_offset+i*(RectWidth+dx),sy+RectHeight);
      end;
      if (Rect_offset+i*(RectWidth+dx)-1 <= end_x) and (Rect_offset+i*(RectWidth+dx)-1 >= 0) then
      begin
        SetColor(FillColor);
        MoveTo(sx+Rect_offset+i*(RectWidth+dx)-1,sy+1);
        LineTo(sx+Rect_offset+i*(RectWidth+dx)-1,sy+RectHeight-1);
      end;
      if Rect_offset+i*(RectWidth+dx)-RectWidth >= 0 then
      begin
        SetColor(backgroundColor);
        MoveTo(sx+Rect_offset+i*(RectWidth+dx)-RectWidth,sy);
        LineTo(sx+Rect_offset+i*(RectWidth+dx)-RectWidth,sy+RectHeight);
      end;
      if (Rect_offset+i*(RectWidth+dx)-RectWidth+1 >= 0) and (Rect_offset+i*(RectWidth+dx)-RectWidth+1 <= end_x)then
      begin
        SetColor(BorderColor);
        MoveTo(sx+Rect_offset+i*(RectWidth+dx)-RectWidth+1,sy);
        LineTo(sx+Rect_offset+i*(RectWidth+dx)-RectWidth+1,sy+RectHeight);
      end;
    end;
end;
procedure run_rectangles;
var
  Ch : char;
  Rect_offset:integer;
  RectanglesOnScreen:Integer;
  i:integer;
  ErrorCode   : integer;
begin
  RectanglesOnScreen:=0;
  Rect_offset:=0;
  repeat
    Rect_offset:=Rect_offset+1;
    if Rect_offset>RectWidth+dx then
    begin
      Rect_offset:=0;
      if end_x > RectanglesOnScreen*(RectWidth+dx) then RectanglesOnScreen:=RectanglesOnScreen+1;
    end;

    abcd(Rect_offset,RectanglesOnScreen);

    delay(delay_redraw);
  until KeyPressed;
  Ch := ReadKey;
end;

var
  OldExitProc : Pointer;  { Saves exit procedure address }


begin
  Initialize(OldExitProc);
  run_rectangles;
  CloseGraph;
end.

[Sazary]

Сообщение от tanek

вот есть программа

Не нужно показывать программы, взятые откуда-то. Покажите свою. Ту, которую вы написали (или напишете) сами.
Я лично не собираюсь разбираться в этом коде. Зачем?

Возьмите код из поста #2 и пробуйте переделать. Нужно, чтобы прямоугольник двигался прямолинейно? Найдите место, где считаются координаты и измените его.

[tanek]

не понятно.....

[Sazary]

не понятно.....

Что непонятно?
В таком случае лучше сделайте все сами с нуля.
Если вы будете искать готовое решение, то понимания у вас, естественно, не прибавится.

[tanek]

uses graph,crt;

VAR
x,y,i:integer; {x и y - центр прямоугольника, i - для цикла}


{процедура установки графического режима}
PROCEDURE grafika_on;
var
drv,mode:integer;
BEGIN
drv:=9; {VGA }
mode:=2; {VGAHi}
initgraph(drv,mode,'D:\bp\bgi');
END;

{------------------- основная программа ---------------}
BEGIN
grafika_on; {установить графический режим }
x:=300; {центр прямоугольника с координатами x,y }
y:=200;

for i:=1 to 100 do {НАЧАЛО ЦИКЛА}
begin
setcolor(9); {цвет линий прямоугольника - голубой }
rectangle(x-i,y-i,x+i,y+i); {нарисовать прямоугольник }
delay(100); {подождать }
setcolor(0); {изменить цвет линий прямоугольника - черный}
rectangle(x-i,y-i,x+i,y+i); {нарисовать прямоугольник - стереть }
end; {КОНЕЦ ЦИКЛА}

readkey; {ждать нажатия любой кнопки }
closegraph; {выход из графического режима }
END.

вот но она рисует нае так как надо....

[Sazary]

tanek, из приведенного кода не понятно, что там не так и как должно быть.

Подробно опишите что должно происходить. Что откуда вылезать и что куда должно ползти.