最短路径（校园导游）的简单算法

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, bsSkinCtrls, bsSkinData, BusinessSkinForm, bsCalendar, ExtCtrls,

jpeg, Menus, bsSkinMenus, StdCtrls, bsSkinHint, bsMessages;

type

TForm1 = class(TForm)

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinData1: TbsSkinData;

bsCompressedStoredSkin1: TbsCompressedStoredSkin;

bsSkinButton1: TbsSkinButton;

bsSkinMonthCalendar1: TbsSkinMonthCalendar;

Shape1: TShape;

bsSkinMainMenu1: TbsSkinMainMenu;

erfg1: TMenuItem;

asda1: TMenuItem;

asdas1: TMenuItem;

asd1: TMenuItem;

bsSkinMainMenuBar1: TbsSkinMainMenuBar;

fgdfgdfgdf1: TMenuItem;

bsSkinPopupMenu1: TbsSkinPopupMenu;

N1111: TMenuItem;

N22221: TMenuItem;

N3331: TMenuItem;

bsSkinStdLabel1: TbsSkinStdLabel;

bsSkinHint1: TbsSkinHint;

damen: TImage;

xyf: TImage;

st: TImage;

ydc: TImage;

lanqiou: TImage;

gongyu: TImage;

jxl: TImage;

Shape2: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

Shape7: TShape;

Shape3: TShape;

bsSkinStdLabel2: TbsSkinStdLabel;

bsSkinStdLabel3: TbsSkinStdLabel;

bsSkinStdLabel4: TbsSkinStdLabel;

bsSkinStdLabel5: TbsSkinStdLabel;

bsSkinStdLabel6: TbsSkinStdLabel;

bsSkinStdLabel7: TbsSkinStdLabel;

bsSkinStdLabel8: TbsSkinStdLabel;

bsSkinStdLabel9: TbsSkinStdLabel;

bsSkinStdLabel10: TbsSkinStdLabel;

bsSkinStdLabel11: TbsSkinStdLabel;

bsSkinStdLabel12: TbsSkinStdLabel;

bsSkinStdLabel14: TbsSkinStdLabel;

bsSkinStdLabel15: TbsSkinStdLabel;

bsCompressedStoredSkin2: TbsCompressedStoredSkin;

bsSkinData2: TbsSkinData;

Shape8: TShape;

bsSkinStdLabel16: TbsSkinStdLabel;

bsSkinStdLabel17: TbsSkinStdLabel;

bsSkinStdLabel13: TbsSkinStdLabel;

Shape9: TShape;

bsSkinStdLabel18: TbsSkinStdLabel;

Shape10: TShape;

Shape11: TShape;

bsSkinStdLabel19: TbsSkinStdLabel;

N1: TMenuItem;

bsSkinMessage1: TbsSkinMessage;

Shape12: TShape;

bsSkinButton2: TbsSkinButton;

procedure bsSkinButton1Click(Sender: TObject);

procedure N1111Click(Sender: TObject);

procedure damenClick(Sender: TObject);

procedure jxlClick(Sender: TObject);

procedure lanqiouClick(Sender: TObject);

procedure ydcClick(Sender: TObject);

procedure gongyuClick(Sender: TObject);

procedure stClick(Sender: TObject);

procedure xyfClick(Sender: TObject);

procedure asdas1Click(Sender: TObject);

procedure asda1Click(Sender: TObject);

procedure N1Click(Sender: TObject);

procedure bsSkinButton2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2, Unit4, Unit5, Unit6;

{$R *.dfm}

procedure TForm1.bsSkinButton1Click(Sender: TObject);

begin

form6.show;

end;

procedure TForm1.N1111Click(Sender: TObject);

begin

form2.Show;

//form2.bsSkinButton1.Caption:=sender.Create;

end;

procedure TForm1.damenClick(Sender: TObject);

begin

form2.request:=1;

form5.request2:=1;

form2.Image1.Picture:=damen.Picture;

form2.note.Width:=800;

form2.note.Height:=60;

form2.note.Lines.Clear;

form2.note.Lines.Add('安徽师范大学大门,因为施工所以没建好');

form2.note.Lines.Add('目前的大门没有标志.');

form2.show;

end;

procedure TForm1.jxlClick(Sender: TObject);

begin

form2.request:=4;

form5.request2:=4;

form2.Image1.Picture:=jxl.Picture;

form2.note.Width:=800;

form2.note.Height:=60;

form2.note.Lines.Clear;

form2.note.Lines.Add('安徽师范大学南校区教学楼,现在共有四栋');

form2.note.Lines.Add('其管理由一泓物业管理有限公司来实现.每');

form2.note.Lines.Add('个教室都配备了多媒体');

form2.show;

end;

procedure TForm1.lanqiouClick(Sender: TObject);

begin

form2.request:=2;

form5.request2:=2;

form2.Image1.Picture:=lanqiou.Picture;

form2.note.Width:=800;

form2.note.Height:=60;

form2.note.Lines.Clear;

form2.note.Lines.Add('大学南校区篮球场,是同学们上课');

form2.note.Lines.Add('和锻身体的主要场所,目前有很多的篮球架,');

form2.note.Lines.Add('基本满足同学们的需要.');

form2.show;

end;

procedure TForm1.ydcClick(Sender: TObject);

begin

form2.request:=3;

form5.request2:=3;

form2.Image1.Picture:=ydc.Picture;

form2.note.Width:=800;

form2.note.Height:=60;

form2.note.Lines.Clear;

form2.note.Lines.Add('安徽师范大学南校区运动场,它位于篮球场的');

form2.note.Lines.Add('边上.由足球场,网球场和排球场构成.目前仍');

form2.note.Lines.Add('处于施工阶段.');

form2.show;

end;

procedure TForm1.gongyuClick(Sender: TObject);

begin

form2.request:=5;

form5.request2:=5;

form2.Image1.Picture:=gongyu.Picture;

form2.note.Width:=800;

form2.note.Lines.Clear;

form2.note.Lines.Add('大学南校区学生公寓,大概有20多栋,');

form2.note.Lines.Add('每栋楼四层,每层28个房间,没间房四个人住,其');

form2.note.Lines.Add('管理也是由其他公司来实现.');

form2.show;

end;

procedure TForm1.stClick(Sender: TObject);

begin

form2.request:=6;

form5.request2:=6;

form2.Image1.Picture:=st.Picture;

form2.note.Width:=800;

form2.note.Lines.Clear;

form2.note.Lines.Add('大学南校区食堂,公司层楼.');

form2.note.Lines.Add('四楼是超市,一至三层是食堂.');

form2.show;

end;

procedure TForm1.xyfClick(Sender: TObject);

begin

form2.request:=7;

form5.request2:=7;

form2.Image1.Picture:=xyf.Picture;

form2.note.Width:=800;

form2.note.Lines.Clear;

form2.note.Lines.Add('大学南校区洗浴中心,是同');

form2.note.Lines.Add('学们洗衣洗澡理发的地方.');

form2.show;

end;

procedure TForm1.asdas1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.asda1Click(Sender: TObject);

begin

showmessage('点击有关图片就行了!')

end;

procedure TForm1.N1Click(Sender: TObject);

begin

form4.show;

end;

procedure TForm1.bsSkinButton2Click(Sender: TObject);

begin

form4.Show;

end;

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, bsSkinCtrls, ExtCtrls, bsSkinData, BusinessSkinForm, StdCtrls;

type

TForm2 = class(TForm)

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinData1: TbsSkinData;

bsCompressedStoredSkin1: TbsCompressedStoredSkin;

Image1: TImage;

bsSkinTextLabel1: TbsSkinTextLabel;

bsSkinButton1: TbsSkinButton;

bsSkinTextLabel2: TbsSkinTextLabel;

bsSkinButton2: TbsSkinButton;

bsSkinTextLabel3: TbsSkinTextLabel;

note: TbsSkinTextLabel;

bsCompressedStoredSkin2: TbsCompressedStoredSkin;

bsSkinData2: TbsSkinData;

procedure FormShow(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure bsSkinButton2Click(Sender: TObject);

procedure bsSkinButton1Click(Sender: TObject);

private

{ Private declarations }

public

request:integer;{

Public declarations }

end;

mapinfo=array[1..7,1..7]of real;

roadinfo=array[1..7,1..8]of integer;

flagarray=array[1..7]of bool;

distinfo=array[1..7]of real;

var

Form2: TForm2;

request:integer;

map:mapinfo;

road:roadinfo;

flag:flagarray;

dist:distinfo;

implementation

uses Unit3, Unit5;

{$R *.dfm}

procedure TForm2.FormShow(Sender: TObject);

var

v,i,j,w,k,l:integer;

min: real;

begin

//form3.Show;

min:=100;

for i:=1 to 7 do

begin

flag[i]:=false;

if map[request,i]<100 then

begin

road[i,8]:=1;

road[i,1]:=i;

dist[i]:=map[request,i];

end//if

else

begin

road[i,8]:=0;

dist[i]:=100;

end;//else

end;//for i

flag[request]:=true;

for j:=1 to 7 do

begin

for w:=1 to 7 do

begin

if ((flag[w]=false) and (dist[w]<min)) then

begin

min:=dist[w];

v:=w;

end;//if dist[w]<min

end;//for w

min:=100;

if dist[v]=100 then

showmessage('dist[v]=100!!')

else

begin//////

flag[v]:=true;

for k:=1 to 7 do

begin

if ((flag[k]=false) and(dist[v]+map[v][k]<dist[k]))then

begin

dist[k]:=dist[v]+map[v][k];

road[k,8]:=road[k,8]+1;

for l:=1 to road[v,8] do

road[k,l]:=road[v,l];

road[k,road[k,8]+1]:=v;

end;//if ((flag[k]=false) and(dist[v]+map[v][k]<dist[k])then

end;//for k

end;//////esle

end;//for j:=1 to 7 do over

//for i:=1 to 7 do

//listbox1.Items.Add(floattostr(dist[i]));

end;//procedure over

procedure TForm2.FormCreate(Sender: TObject);

begin

//request:=4;

map[1,1]:=0;

map[1,2]:=2.5;

map[1,3]:=100;

map[1,4]:=8;

map[1,5]:=4;

map[1,6]:=100;

map[1,7]:=100;

map[2,1]:=2.5;

map[2,2]:=0;

map[2,3]:=1.5;

map[2,4]:=6;

map[2,5]:=2;

map[2,6]:=100;

map[2,7]:=100;

map[3,1]:=100;

map[3,2]:=1.5;

map[3,3]:=0;

map[3,4]:=5;

map[3,5]:=100;

map[3,6]:=100;

map[3,7]:=100;

map[4,1]:=8;

map[4,2]:=8;

map[4,3]:=5;

map[4,4]:=0;

map[4,5]:=4.2;

map[4,6]:=100;

map[4,7]:=100;

map[5,1]:=4;

map[5,2]:=2;

map[5,3]:=100;

map[5,4]:=4.2;

map[5,5]:=0;

map[5,6]:=1.5;

map[5,7]:=2;

map[6,1]:=100;

map[6,2]:=100;

map[6,3]:=100;

map[6,4]:=100;

map[6,5]:=1.5;

map[6,6]:=0;

map[6,7]:=1;

map[7,1]:=100;

map[7,2]:=100;

map[7,3]:=100;

map[7,4]:=100;

map[7,5]:=2;

map[7,6]:=1;

map[7,7]:=0;

end;

procedure TForm2.bsSkinButton2Click(Sender: TObject);

//var

//i:integer;

begin

form5.Show;

end;

procedure TForm2.bsSkinButton1Click(Sender: TObject);

begin

form3.l1.Caption:=floattostr(dist[1])+'m ';

form3.l2.Caption:=floattostr(dist[2])+'m ';

form3.l3.Caption:=floattostr(dist[3])+'m ';

form3.l5.Caption:=floattostr(dist[4])+'m ';

form3.l6.Caption:=floattostr(dist[5])+'m ';

form3.l7.Caption:=floattostr(dist[6])+'m ';

form3.l8.Caption:=floattostr(dist[7])+'m ';

form3.Show;

end;

end.

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, bsSkinData, BusinessSkinForm, StdCtrls, bsSkinCtrls, jpeg,

ExtCtrls;

type

TForm3 = class(TForm)

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinData1: TbsSkinData;

bsCompressedStoredSkin1: TbsCompressedStoredSkin;

bsSkinStdLabel1: TbsSkinStdLabel;

bsSkinStdLabel2: TbsSkinStdLabel;

bsSkinStdLabel3: TbsSkinStdLabel;

bsSkinStdLabel4: TbsSkinStdLabel;

bsSkinStdLabel5: TbsSkinStdLabel;

bsSkinStdLabel6: TbsSkinStdLabel;

bsSkinStdLabel7: TbsSkinStdLabel;

bsSkinStdLabel8: TbsSkinStdLabel;

damen: TImage;

lanqiou: TImage;

ydc: TImage;

jxl: TImage;

gongyu: TImage;

st: TImage;

xyf: TImage;

l1: TbsSkinStdLabel;

l2: TbsSkinStdLabel;

l3: TbsSkinStdLabel;

l5: TbsSkinStdLabel;

l6: TbsSkinStdLabel;

l7: TbsSkinStdLabel;

l8: TbsSkinStdLabel;

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

end.

unit Unit5;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, bsSkinData, BusinessSkinForm, StdCtrls, bsSkinCtrls, CheckLst;

type

TForm5 = class(TForm)

bsSkinStdLabel1: TbsSkinStdLabel;

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinData1: TbsSkinData;

bsCompressedStoredSkin1: TbsCompressedStoredSkin;

rg: TbsSkinRadioGroup;

word: TbsSkinLabel;

lab: TCheckListBox;

procedure rgChecked(Sender: TObject);

procedure rgClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

request2:integer;

{ Public declarations }

end;

mapinfo=array[1..7,1..7]of real;

roadinfo=array[1..7,1..8]of integer;

flagarray=array[1..7]of bool;

distinfo=array[1..7]of real;

var

Form5: TForm5;

request:integer;

map:mapinfo;

road:roadinfo;

flag:flagarray;

dist:distinfo;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm5.rgChecked(Sender: TObject);

var

m,n:integer;

v,i,j,w,k,l:integer;

min: real;

begin

for m:=0 to rg.ComponentCount-1 do

if (rg.Controls[m]as tbsSkinCheckRadioBox).Checked then

n:=m;

//form3.Show;

form5.lab.Items.clear;

for i:=1 to road[n+1,8] do

begin

//大门运动场教学大楼公寓洗浴中心

case road[n+1,i] of

1:form5.lab.Items.Add('南校区大门 ') ;

2:form5.lab.Items.Add('篮球场 ') ;

3:form5.lab.Items.Add('运动场 ') ;

4:form5.lab.Items.Add('教学大楼 ') ;

5:form5.lab.Items.Add('公寓 ') ;

6:form5.lab.Items.Add('食堂 ') ;

7:form5.lab.Items.Add('洗浴中心 ') ;

end;

end;//for i

//listbox1.Items.Add(floattostr(dist[i]));

end;//procedure over

procedure TForm5.rgClick(Sender: TObject);

var

m,n:integer;

v,i,j,w,k,l:integer;

min: real;

begin

for m:=0 to rg.ComponentCount-1 do

if (rg.Controls[m]as tbsSkinCheckRadioBox).Checked then

begin

n:=m;

//form5.Caption:=inttostr(n);

end;

//form3.Show;

form5.lab.Items.clear;

for i:=1 to 7 do

begin

//师大南校区大门安师大南校区大门运动场教学大楼公寓洗浴中心

case road[n+1,i] of

1:form5.lab.Items.Add('师大南校区大门 ') ;

2:form5.lab.Items.Add('篮球场 ') ;

3:form5.lab.Items.Add('运动场 ') ;

4:form5.lab.Items.Add('教学大楼 ') ;

5:form5.lab.Items.Add('公寓 ') ;

6:form5.lab.Items.Add('食堂 ') ;

7:form5.lab.Items.Add('洗浴中心 ') ;

end;

end;//for i

//lab.Items.IndexOf()

case n+1 of

begin

if lab.Items.IndexOf('师大南校区大门 ')=-1 then

form5.lab.Items.Add('安师大南校区大门 ') ;

end;

begin

if lab.Items.IndexOf('篮球场 ')=-1 then

form5.lab.Items.Add('篮球场 ') ;

end;

begin

if lab.Items.IndexOf('运动场 ')=-1 then

form5.lab.Items.Add('运动场 ') ;

end;

begin

if lab.Items.IndexOf('教学大楼 ')=-1 then

form5.lab.Items.Add('教学大楼 ') ;

end;

begin

if lab.Items.IndexOf('公寓 ')=-1 then

form5.lab.Items.Add('公寓 ') ;

end;

begin

if lab.Items.IndexOf('食堂 ')=-1 then

form5.lab.Items.Add('食堂 ') ;

end;

begin

if lab.Items.IndexOf('洗浴中心 ')=-1 then

form5.lab.Items.Add('洗浴中心 ') ;

end;

//listbox1.Items.Add(floattostr(dist[i]));

end;//procedure over

procedure TForm5.FormCreate(Sender: TObject);

begin

//request:=form2.request;

map[1,1]:=0;

map[1,2]:=2.5;

map[1,3]:=100;

map[1,4]:=8;

map[1,5]:=4;

map[1,6]:=100;

map[1,7]:=100;

map[2,1]:=2.5;

map[2,2]:=0;

map[2,3]:=1.5;

map[2,4]:=6;

map[2,5]:=2;

map[2,6]:=100;

map[2,7]:=100;

map[3,1]:=100;

map[3,2]:=1.5;

map[3,3]:=0;

map[3,4]:=5;

map[3,5]:=100;

map[3,6]:=100;

map[3,7]:=100;

map[4,1]:=8;

map[4,2]:=8;

map[4,3]:=5;

map[4,4]:=0;

map[4,5]:=4.2;

map[4,6]:=100;

map[4,7]:=100;

map[5,1]:=4;

map[5,2]:=2;

map[5,3]:=100;

map[5,4]:=4.2;

map[5,5]:=0;

map[5,6]:=1.5;

map[5,7]:=2;

map[6,1]:=100;

map[6,2]:=100;

map[6,3]:=100;

map[6,4]:=100;

map[6,5]:=1.5;

map[6,6]:=0;

map[6,7]:=1;

map[7,1]:=100;

map[7,2]:=100;

map[7,3]:=100;

map[7,4]:=100;

map[7,5]:=2;

map[7,6]:=1;

map[7,7]:=0;

end;

procedure TForm5.FormShow(Sender: TObject);

var

m,n:integer;

v,i,j,w,k,l:integer;

min: real;

begin

//form3.Show;

min:=100;

for i:=1 to 7 do

begin

flag[i]:=false;

if map[request2,i]<100 then

begin

road[i,8]:=1;

road[i,1]:=i;

dist[i]:=map[request2,i];

end//if

else

begin

road[i,8]:=0;

dist[i]:=100;

end;//else

end;//for i

flag[request2]:=true;

for j:=1 to 7 do

begin

for w:=1 to 7 do

begin

if ((flag[w]=false) and (dist[w]<min)) then

begin

min:=dist[w];

v:=w;

end;//if dist[w]<min

end;//for w

min:=100;

if dist[v]=100 then

showmessage('dist[v]=100!!')

else

begin//////

flag[v]:=true;

for k:=1 to 7 do

begin

if ((flag[k]=false) and(dist[v]+map[v][k]<dist[k]))then

begin

dist[k]:=dist[v]+map[v][k];

road[k,8]:=road[k,8]+1;

for l:=1 to road[v,8] do

road[k,l]:=road[v,l];

road[k,road[k,8]+1]:=w;

end;//if ((flag[k]=false) and(dist[v]+map[v][k]<dist[k])then

end;//for k

end;//////esle

end;//for j:=1 to 7 do over

end;

end.