程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 最短路徑(校園導游)的簡單算法

最短路徑(校園導游)的簡單算法

編輯:Delphi
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
  1:
  begin
  if lab.Items.IndexOf('師大南校區大門 ')=-1 then
  form5.lab.Items.Add('安師大南校區大門 ') ;
  end;
  2:
  begin
  if lab.Items.IndexOf('籃球場 ')=-1 then
  form5.lab.Items.Add('籃球場 ') ;
  end;
  3:
  begin
  if lab.Items.IndexOf('運動場 ')=-1 then

  form5.lab.Items.Add('運動場 ') ;
  end;
  4:
  begin
  if lab.Items.IndexOf('教學大樓   ')=-1 then
  form5.lab.Items.Add('教學大樓   ') ;
  end;
  5:
  begin
  if lab.Items.IndexOf('公寓 ')=-1 then
  form5.lab.Items.Add('公寓 ') ;
  end;
  6:
  begin
  if lab.Items.IndexOf('食堂 ')=-1 then
  form5.lab.Items.Add('食堂 ') ;
  end;
  7:
  begin
  if lab.Items.IndexOf('洗浴中心 ')=-1 then
  form5.lab.Items.Add('洗浴中心 ') ;
  end;
  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

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved