1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:

function TGraph.Dijkstra(FromID, ToID: Integer): Integer;
type
  PDijkstraList = ^TDijkstraList;
  TDijkstraList = record
    ID      : Integer;
    WayLen  : Integer;
    Previous: PDijkstraList;
    Next    : PDijkstraList;
  end;

  TDijkstraNodes = record
    ID     : Integer;
    WayLen : Integer;
  end;

  TNode = record
    PreviousID: Integer;
    WayLen    : Integer;
    Childs    : array of TDijkstraNodes;
    List      : PDijkstraList;
  end;

var
  dNodesList: array of TNode;
  i, j, cnt : Integer;
  VisitList : PDijkstraList;
  last, p   : PDijkstraList;
  pl        : PNodeList    ;

begin
  SendMessage(_MHandle, WM_Dijkstra_Start, 0, 0);
  Result:=-1;
  if (FromID<=_NodeCount) and (ToID<=_NodeCount) and (FromID>0) and (ToID>0) then
  begin
    //Liste kopieren
    if _GraphKind=gkList then
    begin
      SetLength(dNodesList, _NodeCount);

      for i := 0 to _NodeCount-1 do
      begin
        with dNodesList[i] do
        begin
          WayLen    := MaxInt;
          List      := nil;
          PreviousID:= -1;
        end;
        cnt:=0;
        pl:=_NodesList[i];
        while pl<>nil do
        begin
          if StrToIntDef(pl^.Caption, -1)>=0 then inc(cnt);
          pl:=pl^.NextNode;
        end;  
        SetLength(dNodesList[i].Childs, cnt);
        cnt:=0;
        pl:=_NodesList[i];
        while pl<>nil do
        begin
          if StrToIntDef(pl^.Caption, -1)>=0 then
          begin
            dNodesList[i].Childs[cnt].ID     := pl^.ID;
            dNodesList[i].Childs[cnt].WayLen := StrToInt(pl^.Caption);
            inc(cnt);
          end; 
          pl:=pl^.NextNode;
        end;
      end;
    end
    else
    begin
      SetLength(dNodesList, _NodeCount);
      for i := 0 to _NodeCount-1 do
      begin
        with dNodesList[i] do
        begin
          WayLen    := MaxInt;
          List      := nil;
          PreviousID:= -1;
        end;
        cnt:=0;
        for j := 0 to _NodeCount-1 do if (_NodesMatrix[i][j].Connect) and (StrToIntDef(_NodesMatrix[i][j].Caption, -1)>=0) then inc(cnt);
        SetLength(dNodesList[i].Childs, cnt);
        cnt:=0;
        for j := 0 to _NodeCount-1 do
        begin
          if _NodesMatrix[i][j].Connect and (StrToIntDef(_NodesMatrix[i][j].Caption, -1)>=0)  then
          begin
           dNodesList[i].Childs[cnt].ID      := j;
           dNodesList[i].Childs[cnt].WayLen  :=StrToInt(_NodesMatrix[i][j].Caption);
           inc(cnt);
          end;
        end;
      end;
    end;

    //Startwerte der Priotitätsliste setzten
    GetMem(VisitList, SizeOf(TDijkstraList));
    with VisitList^ do
    begin
      ID:=FromID-1;
      VisitList^.WayLen:=0;
      VisitList^.Previous:=nil;
      VisitList^.Next:=nil;
    end;
    last:=VisitList;
    dNodesList[FromID-1].List:=VisitList;
    dNodesList[FromID-1].WayLen:=0;

    //Proioritätswarteschlange abarbeiten
    while VisitList <> nil do
    begin
      if VisitList^.ID = ToID-1 then //Ziel gefunden
      begin
        i:=ToID-1;
        Result:=dNodesList[i].WayLen;
        SendMessage(_MHandle, WM_Dijkstra_Result_WayLen, wParam(Result), 0);
        while i<>FromID-1 do
        begin
          SendMessage(_MHandle, WM_Dijkstra_Result_Node, wParam(dNodesList[i].WayLen), lParam(i+1));
          i:=dNodesList[i].PreviousID;
        end;
        SendMessage(_MHandle, WM_Dijkstra_Result_Node, 0, lParam(FromID));

        while VisitList<>nil do
        begin
          p:=VisitList.Next;
          FreeMem(VisitList);
          VisitList:=p;
        end;
      end
      else
      begin
        cnt:=High(dNodesList[VisitList^.ID].Childs);
        for i := 0 to cnt do
        begin
          if VisitList^.WayLen + dNodesList[VisitList^.ID].Childs[i].WayLen < dNodesList[dNodesList[VisitList^.ID].Childs[i].ID].WayLen  then
          begin
            dNodesList[dNodesList[VisitList^.ID].Childs[i].ID].WayLen:=VisitList^.WayLen + dNodesList[VisitList^.ID].Childs[i].WayLen;
            dNodesList[dNodesList[VisitList^.ID].Childs[i].ID].PreviousID:=VisitList^.ID;
            if dNodesList[dNodesList[VisitList^.ID].Childs[i].ID].List = nil then
            begin //noch nicht in Warteschlange
              GetMem(p, SizeOf(TDijkstraList));
              with p^ do
              begin
                ID:=dNodesList[VisitList^.ID].Childs[i].ID;
                WayLen:=VisitList^.WayLen + dNodesList[VisitList^.ID].Childs[i].WayLen;
                Previous:=last;
                Next:=nil;
              end;
              dNodesList[p^.ID].List:=p;
              last^.Next:=p;
              last:=p;
            end
            else //sonst Wegkosten updaten
            begin
              p:=dNodesList[dNodesList[VisitList^.ID].Childs[i].ID].List;
              p^.WayLen:=VisitList^.WayLen + dNodesList[VisitList^.ID].Childs[i].WayLen;
            end;
            //Prioritätswarteschlangeneigenschaften wiederherstellen
            while (p^.Previous<>nil) and (p^.Previous^.WayLen > p^.WayLen) do
            begin
              if p^.Next = nil then last:=p^.Previous;              
              if p^.Previous^.Previous = nil then
              begin
                VisitList:=p;
                p^.Previous^.Next    :=p^.Next;
                p^.Previous^.Previous:=p;
                p^.Next:=p^.Previous;
                p^.Previous:=nil;
              end
              else
              begin
                p^.Previous^.Previous^.Next:=p;
                p^.Previous^.Next    :=p^.Next;
                p^.Previous^.Previous:=p;
                p^.Next:=p^.Previous;
                p^.Previous:=p^.Previous^.Previous;
              end;
            end;
          end;          
        end;
        p:=VisitList;
        VisitList:=VisitList^.Next;
        FreeMem(p)
      end;
    end;    
  end;
  SendMessage(_MHandle, WM_Dijkstra_End, 0, 0);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

type
  PNodeList = ^TNodeList;
  TNodeList = record
    Caption : String;
    ID      : Integer;
    NextNode: PNodeList;
  end;

  TNodeMatrix = record
    Caption: String;
    Connect: Boolean;
  end;

  TGraphKind = (gkList, gkMatrix);
  TGraph = class
  private
    _GraphKind: TGraphKind;

    _NodeCount: Integer;
    _NodeCaption: array of String;

    _NodesList: array of PNodeList;
    _NodesMatrix: array of array of TNodeMatrix;
    ...