Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.05.2011, 13:53   #1
Alina_Honey
Пользователь
 
Регистрация: 14.12.2010
Сообщений: 23
По умолчанию Стрелочки

Задание: нарисовать граф и сделать матрицу инцидентности.
Я сделала уже программу, но только проблема в том, что никак не придумаю как стрелочки сделать(граф то ориентированый) может вы мне поможете:
Код:
uses crt,graphABC;
const nmax=200;
const mmax=200;
type mas=array[1..nmax] of integer;

procedure Tochki(x,y:mas;n:integer);
var i:integer;

begin
for i:=1 to n do
circle(x[i],y[i],2);
//setpixel(x[i],y[i],clBlack);
end;
var A: array[1..nmax,1..nmax]of integer;
    B: array[1..mmax,1..mmax]of integer;
    masy,masx:mas;
    n,i,j:integer;
    x,y:mas;
    R,rm,k,m : integer;
     cntrx,cntry : integer;
     Width,Height: Integer;
     s: string;
Begin
for i:=1 to 3 do
begin
for j:=1 to 3 do
read(A[i,j]);
end;
rm:=10;
SetWindowSize(800,600);
Width:=800;
Height:=600;
cntrx := round(Width div 2);
cntry := round(Height div 2);
R := round(cntrx/1.5);
{l:=10;}
repeat
write('Ðàçìåðíîñòü ìàññèâà äî ',nmax,' n=');
readln(n);
clrscr;
until (n>0)and(n<=nmax);

hidecursor;
for i:=1 to n do
 begin

  x[i]:=round(cntrx+R*cos(i*2*pi/n));
  y[i]:=round(cntry+R*sin(i*2*pi/n));

  masx[i]:=x[i];
  masy[i]:=y[i];
  begin
   str(i,s);
  //   inc(i);
  TextOut(x[i]-10,y[i],s);
 {  writeln(masx[i],' ',masy[i]);   }
 end;
 end;
Tochki(x,y,n);
Begin
 for i:=1 to n do
begin
 for j:=1 to n do
 if (i=j) and (A[i,j]=1) then
     begin
     SetBrushColor(clred);
 ellipse(masx[i],masy[i],masx[j]+12,masy[j]+12);
 end
 else
 if (A[i,j]=1) and (i<>j) and (A[j,i]<>1) then
 Begin
   SetBrushColor(clWhite);
   line(masx[i],masy[i],masx[j],masy[j]);
  TextOut(masx[j],masy[j]-20,'strelochka')
 end
 else
 if (A[j,i]=1) and (i<>j) and (A[i,j]=1) then
 Begin
 line(masx[i],masy[i],masx[j],masy[j]);
 end;

 end;
 readln();
 m:=1;
   for i:=1 to n do
begin
 for j:=1 to n do
 if A[i,j]=1 then
 if i=j then
 begin
 B[i,m]:=2;
 m:=m+1;
 end
 else
 Begin
 B[i,m]:=1;
 B[j,m]:=-1;
 m:=m+1;
 end;
 end;
 writeln('Ìàòðèöà èíöèäåíòíîñòè:');
for i:=1 to n do
begin
for j:=1 to m do
write(B[i,j]:3,'');
writeln();
end;
end;
 end.
Alina_Honey вне форума Ответить с цитированием
Старый 25.05.2011, 15:46   #2
OlegVE
Форумчанин
 
Регистрация: 27.09.2010
Сообщений: 376
По умолчанию

Здравствуйте
В качестве идеи: Сделайте процедуру, которая рисует две линии под углом из одной точки. Передайте в эту процедуру координаты линии, для которой надо нарисовать стрелку, в процедуре посчитайте наклон, координаты от конечной точки и... рисуйте эти две линии.
До свидания
OlegVE вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск