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

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

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

 
 Ответить  Открыть новую тему 
> Динамический список координат, Графика
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


Собственно написал вот такую программу. Шарик движется линейно между точками (x[i],y[i])..

Uses Graph,Crt,My;

Const N=10;

Type
TPoint=record
x:real;
y:real;
end;

p=array[1..N] of TPoint;

Var
Dot:p;
output:text;
i:integer;
x,y:real;

procedure draw;
Var a,b,c:real;
begin

Init_graph;

for i:=1 to N do
PutPixel(round(Dot[i].x),round(Dot[i].y),red);{отмечает маршрут}

{дальше собственно "анимация"..}
for i:=1 to N-1 do
begin
x:=Dot[i].x;
if Dot[i].x<Dot[i+1].x then
begin
repeat
x:=x+1;
a:=x*Dot[i+1].y-x*Dot[i].y-Dot[i].x*Dot[i+1].y+Dot[i].x*Dot[i].y;
b:=Dot[i+1].x*Dot[i].y-Dot[i].x*Dot[i].y;
c:=Dot[i+1].x-Dot[i].x;
y:=(a+b)/c;
Drawcircle(round(x),round(y),green);
delay(2600);
Drawcircle(round(x),round(y),white);
until x>=Dot[i+1].x;
end
else
begin
repeat
x:=x-1;
a:=x*Dot[i+1].y-x*Dot[i].y-Dot[i].x*Dot[i+1].y+Dot[i].x*Dot[i].y;
b:=Dot[i+1].x*Dot[i].y-Dot[i].x*Dot[i].y;
c:=Dot[i+1].x-Dot[i].x;
y:=(a+b)/c;
Drawcircle(round(x),round(y),green);
delay(2600);
Drawcircle(round(x),round(y),white);
until x<=Dot[i+1].x;
end;
end;
readkey;
end;

{main program}
BEGIN
clrscr;
randomize;

{вводим координаты точек}
for i:=1 to N do
begin
Dot[i].x:=round(random(640));
Dot[i].y:=round(random(480));
end;
draw;
END.


А вопрос то - помогите алгоритмом работы такой программы, только с использованием динамического списка этих самых точек.
Объясните,пожалуйста, каким способом обращатся к данным из (как я понимаю) динамического списка записей.
Заранее спасибо.

Сообщение отредактировано: xlr8 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

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


Тут прочитал как решать товю задачу?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


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


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


Просмотрите...правильно ли я всё сделал? (программа работает конечно)
Код

Uses Graph,Crt,My;

Const N=10000;

Type

     point=^tpoint;

     tpoint=record
     x:real;
     y:real;
     next:point;
     end;



Var
      Dot:array[1..N] of point;
      output:text;
      i:integer;
      x,y:real;

procedure draw;
Var a,b,c:real;
begin

Init_graph;
for i:=1 to N do
begin
with Dot[i]^ do
begin
PutPixel(round(x),round(y),red);
next:=Dot[i+1];
end;
end;
readkey;
for i:=1 to N-1 do
    begin
    x:=Dot[i]^.x;
    if Dot[i]^.x<Dot[i+1]^.x then
       begin
            repeat
            x:=x+1;
            a:=x*Dot[i+1]^.y-x*Dot[i]^.y-Dot[i]^.x*Dot[i+1]^.y+Dot[i]^.x*Dot[i]^.y;
            b:=Dot[i+1]^.x*Dot[i]^.y-Dot[i]^.x*Dot[i]^.y;
            c:=Dot[i+1]^.x-Dot[i]^.x;
            y:=(a+b)/c;
            Drawcircle(round(x),round(y),green);
            delay(300);
            Drawcircle(round(x),round(y),black);
            until x>=Dot[i+1]^.x;
       end
          else
              begin
                   repeat
                   x:=x-1;
                   a:=x*Dot[i+1]^.y-x*Dot[i]^.y-Dot[i]^.x*Dot[i+1]^.y+Dot[i]^.x*Dot[i]^.y;
                   b:=Dot[i+1]^.x*Dot[i]^.y-Dot[i]^.x*Dot[i]^.y;
                   c:=Dot[i+1]^.x-Dot[i]^.x;
                   y:=(a+b)/c;
                   Drawcircle(round(x),round(y),green);
                   delay(300);
                   Drawcircle(round(x),round(y),black);
                   until x<=Dot[i+1]^.x;
              end;
end;
Dispose(Dot[i]);
end;

{main program}
BEGIN
clrscr;
randomize;
for i:=1 to N do
begin
     New(Dot[i]);
     with Dot[i]^ do
     begin
     x:=round(random(640));
                           {writeln(Dot[i]^.x:4:0);}
     y:=round(random(480));
                           {writeln(Dot[i]^.y:4:0);}
                           next:=nil;
     end;
end;
readkey;
draw;
readkey;
END.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Помощник капитана
****

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

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


Извини, а можно присоеденить модуль My? А то знаешь,компилятор то не волшебник.. smile.gif


--------------------
Dum spiro spero!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






xlr8, динамический список где? Массив вижу, списка здесь нет...

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


Вот модуль My..но он совсем не суть..
volvo, задание прийдется уточнить dry.gif ...Ну а если с динам. масивом - это правильно (ну тоесть дин. масив так строится)?
Код

Unit MY;

Interface

Uses Crt, Graph;

Var Err,s,x,y:integer;

procedure Init_Graph;
procedure Drawcircle(x,y:integer;color:word);

Implementation

procedure Init_Graph;
var GD, GM, EC: Integer;
begin
GD:= Detect;
  InitGraph(GD,GM,'C:\TP\BGI\');
EC:= GraphResult;
  if EC<>GrOK then
   begin
    WriteLn('Error Graphic Initialize: ', GraphErrorMsg(EC));
    Halt(1);
   end;
end;

procedure Drawcircle(x,y:integer;color:word);
var p:FillPatternType;
begin
  Setcolor(color);
  Circle(x,y,2);
  GetFillPattern(p);
  SetFillPattern(p,color);
  FloodFill(x,y,color);
end;
End.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






И динамического массива здесь тоже нет... Понимаешь, динамический массив - это когда ты при запуске программы не знаешь его размера, и только в RunTime становится известен размер, который тебе необходим, и инициализируется массив нужного размера. А у тебя все известно - массив статический (место-то под сам массив выделяется еще на этапе компиляции). То, что сами элементы хранятся в "куче" - ничего не значит... Массив от этого не становится динамическим в полном смысле этого слова...

А задание все-таки уточни, и подкорректируй название темы соответственно, а то в названии написано одно, а ты говоришь что это - несущественно...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


Код

Uses Graph,Crt,My;

Type

     point=^tpoint;

     tpoint=record
     x:real;
     y:real;
     next:point;
     end;



Var
      first:point;
      place:point;
      output:text;
      k,i:integer;
      x,y:real;

procedure draw(first:point);
Var a,b,c:real;
    r:point;
begin

Init_graph;

place:=first;
while place<>nil do
begin
Drawcircle(round(place^.x),round(place^.y),red);
place:=place^.next;
end;}

place:=first;

while (place^.next<>nil) do
begin
    y:=0;
    x:=place^.x;
    r:=place^.next;
    if place^.x<r^.x then
       begin
            repeat
            x:=x+1;
            y:=((x*r^.y-x*place^.y-place^.x*r^.y+place^.x*r^.y)+(r^.x*place^.y-place^.x*place^.y))/(r^.x-place^.x);
            writeln(y);
            {Drawcircle(round(x),round(y),green);
            delay(2600);
            Drawcircle(round(x),round(y),black);}
            until x>=r^.x;
       end
          else
              begin
                   repeat
                   x:=x-1;
                   y:=((x*r^.y-x*place^.y-place^.x*r^.y+place^.x*r^.y)+(r^.x*place^.y-place^.x*place^.y))/(r^.x-place^.x);
                   Drawcircle(round(x),round(y),green);
                   delay(2600);
                   Drawcircle(round(x),round(y),black);
                   until x<=r^.x;
end;
place:=place^.next;
end;
end;

{main program}
BEGIN
clrscr;
randomize;
first:=nil;
while k<>2 do
begin
     New(place);
     readln(place^.x);
     readln(place^.y);
     place^.next:=first;
     first:=place;
     k:=k+1;
end;
readkey;
draw(first);
readkey;
END.



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

Сообщение отредактировано: xlr8 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


меркантильный
***

Группа: Пользователи
Сообщений: 161
Пол: Мужской

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


Вопрос: обязательно использовать массивы,
файлы, динамическме списки?
Можешь уточнить задание?
Если точки все равно задаются рандомно,
или шире-произвольно, то обязателен ли их список?
Есть один экспериментальный код, где шарик
отражается от стенок, но и сам может менять свое направление.
Выкладывается под ТВОЮ полную ответственность cool.gif /Шутка blum.gif /.


--------------------
Смысл откроется тебе. Красками играя
Жизнь предстанет как поток без конца и края.


В этом мире порой разбиваютсямечты
Но чтобы он стал другой Вдруг в него приходишь ТЫ...

После странствий и скитаний настают другие времена.
Старая волна уходит и приходит новая волна.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


Задачу нужно решить применив двунаправленый список (этих самых координат)..
Если кто знает - подскажите как?
Заранее спасибо

Сообщение отредактировано: xlr8 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Вот набросок:
uses crt, graph;
type
plist = ^tlist;
tlist = record
X, Y: integer;
prev, next: plist;
end;

const
R = 5;
step = 20; { <--- Можешь поиграться с этим }
var
head, tail: plist;


{
append new item to the end of list
}
procedure append_list(x, y: integer);
var p: plist;
begin
p := new(plist);
p^.x := x; p^.y := y;
p^.next := nil;
p^.prev := tail;

if head = nil then head := p
else tail^.next := p;

tail := p;

setfillstyle(solidfill, red);
fillellipse(p^.x, p^.y, R, R);
end;

var
gd, gm: integer;
i: integer;
p: plist;

cx, cy, DX, DY: real;
begin
initgraph(gd, gm, '');
setcolor(white);

head := nil; tail := nil;
for i := 1 to 10 do begin
append_list(random(getmaxx), random(getmaxy));
end;

setcolor(lightgreen);
cx := 0; cy := 0;

p := head;
while p <> nil do begin

DX := (p^.x - cx) / step;
DY := (p^.y - cy) / step;
for i := 1 to step do begin
setcolor(black);
circle(trunc(cx), trunc(cy), R);
cx := cx + DX; cy := cy + DY;
setcolor(lightgreen);
circle(trunc(cx), trunc(cy), R);
delay(25); { <--- Измени на бОльшее значение }
end;

p := p^.next;
end;


readln;
closegraph;
end.

Единственное, что надо еще сделать - это принять меры против того, что изображение точки "размывается" при проходе над ней шарика... Это просто, попробуй догадаться сам...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


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


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

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


 
procedure delete_elem(i:byte);
var
nav,p1,p2:plist;
search:boolean;
c:byte;
begin
search:=false;

c:=0;
p:=head;
while p^.next<>NIL do
begin
if c=i then
begin
search:=true;
break;
end;
p:=p^.next;
inc©;
end;

if search then
begin
writeln('Remove elem #',c,' (',p^.x,',',p^.y,')');
nav:=p;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);
nav:=nil;

end
else writeln('No result of search')

end;



Помогите удалить елемент из списка. По правильному вроде бы так..У меня работает всё отлично только если вот так:

nav:=p^.next;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);
nav:=nil;



В чем проблема тут?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Цитата
В чем проблема тут?
Может, в том, что элементы считаются у тебя с НУЛЯ?

Добавлено через 6 мин.
Хм... вторая попытка... Ты сам понял, что написал?
   nav:=p;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);

Это значит (если Nav заменить на P, они же равны, так?):
   p^.prev:=p^.prev;
p^.next:=p^.next;
dispose(p);

Что получишь? Бред...

Делаем так?
   nav:=p;
if p^.prev <> nil then p^.prev^.next := nav^.next;
if p^.next <> nil then p^.next^.prev := nav^.prev;
dispose(nav);

 К началу страницы 
+ Ответить 

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

 





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