[Alegun]

У меня такое получилось, на концах путей алгоритм

Добавлено немного позже

На случай пропажи исходника вот юнит формы

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  arr: array of array[0..2] of integer;

  implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 i: integer;
begin
 with Memo1, StringGrid1 do  // Заполнение таблицы
  begin
   RowCount:= Lines.Count;
   for i := 0 to Lines.Count - 1 do
    begin
     Cells[0,i]:= Copy(Lines[i], 1, Pos('-',Lines[i])-1);
     Cells[1,i]:= Copy(Lines[i], Pos('-', Lines[i])+1,Length(Lines[i]));
    end;{for i}
 end; {with}

 Button2.Enabled:= true;

 end;

procedure TForm1.Button2Click(Sender: TObject);

 function lm (ds, ts: integer): integer;
  var i: integer;
 begin
  Result:= 0;
  for i := High(arr) downto Low(arr) do
    if (arr[i, 2] > 0) and (arr[i, 1] = ds) then
    begin

     // Помечаем данный конец пути чтоб опять по нему не пройти
     if ds = ts then arr[i, 2]:= 1;
     Result:= arr[i, 0];
     Exit;
    end;
 end;

var
 i, b, k, m: integer;
 pth: array of array of integer;
 s: string;
begin
 with StringGrid1 do
 begin

 SetLength(arr, RowCount);

 for i:= 0 to RowCount-1 do // Заплонение массива
  begin
   arr[i,0]:= StrToInt(Cells[0,i]);
   arr[i,1]:= StrToInt(Cells[1,i]);
  end;
 end; {with}

 k:= 0;

 // Нахождение конечной точки
 for i:= Low(arr) to High(arr) do if arr[i,1] > k then k:= arr[i,1];

 b:= 0;

 // Кол-во возможных путей
 for i:= Low(arr) to High(arr) do if arr[i,1] = k then inc(b);

 // Подготовка массива для путей
 SetLength(pth, b, Length(arr));

 for i:= Low(pth) to High(pth) do
   begin
    m:= k;
    b:= Low(arr);
     while (m > 0) or (b < High(arr)) do
     begin
     pth[i,b]:= m;
     m:= lm(m,k);
     Inc(b);
     end;
  end;{for i}

 Memo2.Clear;
 Memo2.Lines.Add('Варианты: ' + IntToStr(Length(pth)));
 Memo2.Lines.Add('');

 for i:= Low(pth) to High(pth) do
  begin
   s:= IntToStr(i + 1) + ' - ';
   for b:= High(arr) downto Low(arr) do
   if pth[i,b] > 0 then s:= s + IntToStr(pth[i,b]) + '-';
   Delete(s, Length(s), 1);
   Memo2.Lines.Add(s);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Button2.Enabled:= false;
 Memo1.Text:=
   '1-2' +#13#10+
   '1-3' +#13#10+
   '2-4' +#13#10+
   '2-5' +#13#10+
   '3-6' +#13#10+
   '4-6' +#13#10+
   '5-6' +#13#10;
end;
end.