Задание: построение Эйлерова цикла в неориентированном графе, заданном матрицей инцидентности.
Проблема: процедуру Эйлерова цикла нам дали готовую (она перечисляет вершины), вот только не могу графически на экране изобразить преобразованный граф.

Program Lab;

Uses Crt,Graph;

const Qt = 20;

var st : string;
    k1 : integer;
{--------------------------   Begin Stack  -------------------------------}

const NL = 1000;

Type Number = 0..NL;
Type Stack = object
             Elements: array [1..NL] of integer;
             Last: Number;
             Constructor Init;
             Function  Push (Dn : integer)    : boolean;
             Function  Empty : boolean;
             Function  Pop (var Dn:integer): boolean;
             Procedure Print;
             end;

Constructor Stack.Init;
begin
   Last:=0;
end;

Function Stack.Push(Dn : integer): boolean;
begin
   If Last < NL then
   begin
      Inc(Last);
      Elements[Last] := Dn;
      Push := true;
   end
   else Push := false;
end;

Function Stack.Empty : boolean;
begin
   If Last = 0
   then Empty := TRuE
   else Empty := false;
end;

Function Stack.Pop (var Dn : integer): boolean;
var I : Number;
begin
   If Empty then Pop := false
   else
   begin
      Dn := Elements[Last];
      Dec(Last);
      Pop := true;
   end;
end;

Procedure Stack.Print;
var I : Number;
begin
   For I := 1 to Last do write(Elements[I]:3);
   writeln;
end;


{-----------------------------  Begin Graf  -----------------------------}

const MaxVertex = 100;
      MaxEdges  = 500;
      x0 = 320;
      y0 = 240;
      R = 200;

Type
      Edge = record
             From, Into : integer;
             end;

      Graf = object
             KolVertex : 0..MaxVertex;
             KolEdges :  0..MaxEdges;
             Edges:array [1..MaxEdges] of Edge;
             Used: array [1..MaxVertex] of boolean;
             Numbers: array [1..MaxVertex] of integer;
             coordX: array [1..MaxVertex] of integer;
             coordY: array [1..MaxVertex] of integer;
             Constructor Init(KV, KE : integer);
             Function Get(var s : string) : string;
             Procedure Print; {VbIvod grafa na ekran}
             end;

Constructor Graf.Init(KV, KE : integer);
var i : integer;
begin
   KolVertex := KV;
   KolEdges := KE;
   For i := 1 to KolVertex do
   begin
      Used[i] := false;
      Numbers[i] := MaxInt;
      coordX[i] := round(x0 + R*cos(2*pi*(i-1)/KolVertex));
      coordY[i] := round(y0 - R*sin(2*pi*(i-1)/KolVertex));
   end;
end;

Function Graf.Get(var s : string) : string;
begin
   Get := s;
end;

Procedure Graf.Print;
var i, j, rad, rad1, vert,
    x1, y1,
    grDriver, grMode : integer;
    f : boolean;
    s : string;

const x0 = 460;
      y0 = 80;
      dins = 20;

begin
   rad := 5;
   rad1 := 8;
   grDriver := Detect;
   InitGraph(grDriver, grMode, '');
   SetColor(15);
   For i := 1 to KolVertex do
   begin
      Circle(coordX[i], coordY[i], rad);
      str(i, s);
      SetColor(Yellow);
      OutTextXY(coordX[i] + round(13*cos(2*pi*(i-1)/KolVertex)),
        coordY[i] - round(13*sin(2*pi*(i-1)/KolVertex)), s);
      SetColor(15);
   end;
   For i := 1 to KolEdges do
   For j := 1 to KolVertex do
   begin
      f := true;
      If Edges[i].From = j
      then vert := Edges[i].Into
      else
      If Edges[i].Into = j
      then vert := Edges[i].From
      else f := false;
      If f then
      begin
         SetColor(9);
         Line(coordX[j], coordY[j], coordX[vert], coordY[vert]);
      end;
      SetColor(15);
   end;
   readln;
   CloseGraph;
end;

{--------------------------------------------------------------------------}
var Gra : Graf;

Function Another(NE, First : integer; var Second : integer) : boolean;
begin
   Another := true;
   with Gra.Edges[NE] do
   begin
      If From = First then Second := Into
      else
      If Into = First then Second := From
      else Another := false;
   end;
end;

Procedure DeleteEdge(Number : integer);
var i : integer;
begin
   with Gra do
   begin
      dec(KolEdges);
      For i := Number to KolEdges do Edges[i] := Edges[i + 1];
   end;
end;

Function Euler(var Sta : Stack) : boolean;

Function SearchEdge(var Vertex, NumberEdge : integer) : boolean;
var I : integer;
begin
   with Gra do
   begin
      SearchEdge := true;
      For I := 1 to KolEdges do
      If Another(I, Vertex, Vertex) then
      begin
         NumberEdge := I;
         exit;
      end;
      SearchEdge := false;
   end;
end;

var Sta1 : Stack;
Vertex, NumberEdge: integer;
s : string;

begin
   Euler := false;
   Sta.Init;
   Sta1.Init;
   Vertex := Gra.Edges[1].From;
   write(Gra.Edges[1].Into);
   While Gra.KolEdges > 0 do
   If SearchEdge(Vertex, NumberEdge) then
   begin
      Sta.Push(Vertex);
      DeleteEdge(NumberEdge);
   end
   else
   If Sta.Pop(Vertex)
   then Sta1.Push(Vertex)
   else exit;
   While Sta1.Pop(Vertex) do Sta.Push(Vertex);
   Euler := true;
end;

const

   Root = 4;

   MS1 : array[1..6,1..6] of integer=
  ((1,0,1,0,0,1),
   (0,1,0,0,0,0),
   (0,0,1,0,0,0),
   (0,1,0,1,0,1),
   (0,0,0,1,1,0),
   (1,0,0,0,1,0));



var i, j, k, t : integer;
    sta1 : Stack;

BEGIN

   with Gra do {Вот здесь рисую граф ДО преобразования}
   begin
   Init(6, 6);
   k := 1;
   for i := 1 to 6 do
   for j := 1 to 5 do
   for t := j + 1 to 6 do
   begin
      if (MS1[j,i] = 1) and (MS1[t,i] = 1)
      then
      begin
         Edges[i].From := j;
         Edges[i].Into := t;
         Used[j] := true;
         Used[t] := true;
         Inc(k);
         break;
      end;
   end;
   Print;
end;

   {Gra.Init(6, 6); Здесь надо нарисовать граф ПОСЛЕ построения ЭЦ}
   sta1.Pop(i);
   t := 1;
   while not sta1.Empty do
   begin
      sta1.Pop(j);
      with Gra do
      begin
         Edges[t].From := i;
         Edges[t].Into := j;
         writeln(i, ' ',j);
         readln;
         Used[i] := true;
         Used[j] := true;
      end;
      i := j;
      inc(t);
   end;}
   write('Euler cycle:  '); {Отладочная инфа - простой вывод списка вершин}
   Euler(sta1);
   sta1.print;
   readln;
   {Gra.Print;}
END.