unit1.pas

最短路径之娃娃找草莓Demodelphi源码 控件类源码windows平台

//名称：寻找最短路径算法
//作者：KingOne
//日期：2003年12月6日
//地点：武汉大学
//联系方式：QQ:122512447  Email:[e-mail]  短信：(0)13995652752
//个人主页：http://www.8k41.com
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, se_controls, KsSkinEdits, KsSkinButtons, StdCtrls,
  ksskinstdcontrol, KsSkinPanels, ComCtrls;

type
  TForm1 = class(TForm)
    tempmap: TImage;
    Edit: TEdit;
    SeSkinScrollBox1: TSeSkinScrollBox;
    Image: TImage;
    SeSkinPanel1: TSeSkinPanel;
    Button1: TButton;
    Button2: TButton;
    Button5: TButton;
    ListBox1: TListBox;
    messagelistbox: TListBox;
    ScrollBox1: TScrollBox;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit1: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Edit15: TEdit;
    Button3: TButton;
    Button4: TButton;
    StaticText5: TStaticText;
    Timer1: TTimer;
    ScrollBox2: TScrollBox;
    ok: TImage;
    map_1: TImage;
    map_B: TImage;
    map_A: TImage;
    map_0: TImage;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    display: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure drawrectin;
    { Private declarations }
  public
    { Public declarations }
  end;
  //---------------------display(image控件)是image(在地图)的缩放显示
var
  Form1: TForm1;
  DRect,SRect:TRect;
  startx,starty:integer;//起始坐标　
  PointX,PointY:integer;//目标坐标
  maphang,maplie:integer;//map行与列
  win:bool;
  flag2:bool;
  AutoTime:integer;//演示循环的次数
  AutoPlayFlag:bool;//自动演示标记
  po:integer;
  makemap:bool;//是否自动生成地图
  tempstr,tempmapid:string;//画地图时用到的量变
  i,j,p:integer;//画地图时用到的参量
  re,re2:integer;//循环变量
  X,Y:integer;//NPC当前行与列
  juliFlag:integer;//距离标记
  index:integer;//所有可以达到的坐标的序号
  txztsz:array[0..31,0..31] of string;//通行状态数组
  OnRoadx:array[0..900] of string;//可以到达的坐标
  OnRoady:array[0..900] of string;
  ABCDE_X:array[0..900]of string;//将回塑的坐标记录于此
  ABCDE_Y:array[0..900] of string;
  alreadyGO:array[0..31,0..31] of string;//已经标记过的坐标
  juli:array[0..31,0..31]of string;//点到起始点的距离
  findUp,finddown,findleft,findright:bool;//目标在哪个方向被发现
implementation

{$R *.dfm}
 procedure tform1.drawrectin;
var ii,jj:integer;
begin
 image.Canvas.Brush.Color:=clBlack;
 image.Canvas.FillRect(image.ClientRect);
 image.Canvas.Pen.Color:=clMoneyGreen;
 image.Canvas.Pen.Width:=1;
 image.Canvas.Pen.Style:=psDash;
 //初始化起始位置
 startx:=(image.width-40*maphang) div 2;
 starty:=(image.Height-40*maplie) div 2;
 
 for ii:=0 to maphang-1 do
  for jj:=0 to maplie-1 do
   begin
    image.Canvas.Rectangle(startx+ii*40,
    starty+jj*40,startx+(ii+1)*40,starty+(jj+1)*40);
   end;
  
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//-------------------初始化--------------------------------
 //makemap:=false;
 findup:=false;
 finddown:=false;
 findleft:=false;
 findright:=false;
 re:=0;re2:=0;
 index:=0;
 po:=0;
 juliFlag:=2;//之所以不设为1，是为了避免可能发生的错误
 win:=false;
 maphang:=30;//取得定制的行与列
 maplie:=30;
 image.Canvas.Brush.Color:=clBlack;
 image.Canvas.FillRect(image.ClientRect);
 //showmessage('初始化..');
 for re:=1 to 4000 do //这个1250是我调试了半天才得出的，郁闷
 begin
 OnRoadx[re]:='0';
 OnRoady[re]:='0';
 end;
 re:=0;re2:=0;
 drawrectin;//在image上绘制矩形框

//----------------------初始化完毕----------------------------


//----------------检查数字地图是否合法-----------------
{if length(edit1.Text)<>30 then
  begin
  showmessage('第1行字符串长度必须为30');
  edit1.Text:='010100000000000';
  end;
if length(edit2.Text)<>15 then
  begin
  showmessage('第2行字符串长度必须为15');
  edit2.Text:='A00101000000000';
  end;
if length(edit3.Text)<>15 then
  begin
  showmessage('第3行字符串长度必须为15');
  edit3.Text:='110101000000000';
  end;
if length(edit4.Text)<>15 then
  begin
  showmessage('第4行字符串长度必须为15');
  edit4.Text:='000101000000000';
  end;
if length(edit5.Text)<>15 then
  begin
  showmessage('第5行字符串长度必须为15');
  edit5.Text:='011001000000000';
  end;
if length(edit6.Text)<>15 then
  begin
  showmessage('第6行字符串长度必须为15');
  edit6.Text:='00001B000000000';
  end;
 if length(edit7.Text)<>15 then
  begin
  showmessage('第7行字符串长度必须为15');
  edit7.Text:='000010000000000';
  end;
 if length(edit8.Text)<>15 then
  begin
  showmessage('第8行字符串长度必须为15');
  edit8.Text:='000010000000000';
  end;
 if length(edit9.Text)<>15 then
  begin
  showmessage('第9行字符串长度必须为15');
  edit9.Text:='000010000000000';
  end;
 if length(edit10.Text)<>15 then
  begin
  showmessage('第10行字符串长度必须为15');
  edit10.Text:='000010000000000';
  end;
 if length(edit11.Text)<>15 then
  begin
  showmessage('第11行字符串长度必须为15');
  edit11.Text:='000010000000000';
  end;
 if length(edit12.Text)<>15 then
  begin
  showmessage('第12行字符串长度必须为15');
  edit12.Text:='000010000000000';
  end;
 if length(edit13.Text)<>15 then
  begin
  showmessage('第13行字符串长度必须为15');
  edit13.Text:='000010000000000';
  end;
 if length(edit14.Text)<>15 then
  begin
  showmessage('第14行字符串长度必须为15');
  edit14.Text:='000010000000000';
  end;
 if length(edit15.Text)<>15 then
  begin
  showmessage('第15行字符串长度必须为15');
  edit15.Text:='000010000000000';
  end;                                          }
//----------------数字地图是否合法检查完毕-----------------

 messagelistbox.Items.Add('绘制地图...');
 //button1.Enabled:=false;
 //button2.Enabled:=true;
 p:=1;
 if (makemap=false) then
 edit.Text:=edit1.Text+edit2.Text+edit3.Text+edit4.Text+edit5.Text+edit6.Text+edit7.Text+
 edit8.Text+edit9.Text+edit10.Text+edit11.Text+edit12.Text+edit13.Text+edit14.Text+edit15.Text+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000'+
 '000000000000000000000000000000'+'000000000000000000000000000000';

 //--------★★★★★★★★★读入地图★★★★★★★★★★★★★★---------
 For i:=1 to 30 do
  for j:=1 to 30 do
  begin
   tempMapID:=copy(edit.Text,p,1);
   //showmessage(tempmapid);
   if tempmapid<>''then
   begin
   //showmessage('第'+inttostr(i)+'行');
    if tempmapid='0' then
     begin
      tempmap.Picture:=map_0.Picture;
      txztsz[i,j]:='0';
     end
    else
    if tempmapid='1' then
     begin
     tempmap.Picture:=map_1.Picture;
     txztsz[i,j]:='1';
     end
    else
    if tempmapid='A' then
     begin
     tempmap.Picture:=map_A.Picture;
     StartX:=i;StartY:=j;
     X:=startx;Y:=starty;
     txztsz[i,j]:='A';
     juli[i,j]:='2';
     //showmessage(inttostr(a_oldx)+','+inttostr(a_oldy));
     end
     else
    if tempmapid='B' then
      begin
      tempmap.Picture:=map_B.Picture ;
      PointX:=i;PointY:=j;
      txztsz[i,j]:='B';
      //showmessage(inttostr(b_oldx)+','+inttostr(b_oldy));
      end;
    drect:=rect(j*40-40,i*40-40,j*40,i*40);
    srect:=rect(0,0,40,40);
    image.Canvas.CopyRect(drect,tempmap.Canvas,srect);
    end;
   p:=p+1;
   tempMapID:='';
 end;
//--------★★★★★★★★★★★★★★★★★★★★★★★---------

 for re:=0 to 31 do
  begin
    txztsz[0,re]:='1';
    txztsz[re,0]:='1';
    txztsz[31,re]:='1';
    txztsz[re,31]:='1';
  end;
  messagelistbox.Items.Add('绘制完毕');


end;

procedure TForm1.Button2Click(Sender: TObject);
var flagON:bool;  //在一次完整(右下左右)循环中，若有坐标记入onroad，
               //则允许当前点到起始点距离＋1
begin
 makemap:=false;
 messagelistbox.Clear;
 listbox1.Clear;
 messagelistbox.Items.Add('开始搜索...');
 //button2.Enabled:=false;
 flagON:=false;
 //--------------判断起点与目标点是否相邻--------------------
   if (txztsz[x,y+1]='B')  or (txztsz[x+1,y]='B') or
      (txztsz[x,y-1]='B')  or (txztsz[x-1,y]='B') then
     begin
       messagelistbox.Items.Add('目标相邻');
       win:=true;
     end
   else//如果不相邻
 Begin//2121
  //=============================================
 TRY
  while win=false do//没找到时则循环 用break跳出循环