unit1.pas

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

  Begin//-------------主循环------------------------------------
     //右
    if (txztsz[x,y+1]='0') and (alreadygo[x,y+1]<>'1') and (txztsz[x,y+1]<>'B') and (win=false) then//=1说明已经标记过
    begin
      alreadygo[x,y+1]:='1';//作标记
      onroadX[index]:=inttostr(x);//将可到达的点记入序列中
      onroadY[index]:=inttostr(y+1);
      if juli[x,y]<>'0' then
      //juli[x,y+1]:=inttostr(juliflag);//到起始点距离
      juli[x,y+1]:=inttostr(strtoint(juli[x,y])+1);//到起始点距离
      index:=index+1;
      flagON:=true;
      //showmessage('右通'+inttostr(x+1)+','+inttostr(y));
    end//--------------
    else if txztsz[x,y+1]='B'  then
    begin
     //showmessage('在'+inttostr(x)+','+inttostr(y+1)+'处发现目标！');
     findright:=true;
     alreadyGO[pointx,pointy]:='1';
     win:=true;
     break;
    end;
  //下
    if (txztsz[x+1,y]='0') and (alreadygo[x+1,y]<>'1') and (txztsz[x+1,y]<>'B')and (win=false) then//=1说明已经标记过
    begin
      alreadygo[x+1,y]:='1';//作标记
      onroadX[index]:=inttostr(x+1);//将可到达的点记入序列中
      onroadY[index]:=inttostr(y);
      if juli[x,y]<>'0' then
      //juli[x+1,y]:=inttostr(juliflag);//到起始点距离
      juli[x+1,y]:=inttostr(strtoint(juli[x,y])+1);
      index:=index+1;
      flagON:=true;
      //showmessage('下通');
    end//--------------
    else if txztsz[x+1,y]='B' then
    begin
     //showmessage('在'+inttostr(x+1)+','+inttostr(y)+'处发现目标！');
     finddown:=true;
     alreadyGO[pointx,pointy]:='1';
     win:=true;
     break;
    end;
    //左
    if (txztsz[x,y-1]='0') and (alreadygo[x,y-1]<>'1') and (txztsz[x,y-1]<>'B')and (win=false) then//=1说明已经标记过
    begin
      alreadygo[x,y-1]:='1';//作标记
      onroadX[index]:=inttostr(x);//将可到达的点记入序列中
      onroadY[index]:=inttostr(y-1);
      if juli[x,y]<>'0' then
      //juli[x,y-1]:=inttostr(juliflag);//到起始点距离
      juli[x,y-1]:=inttostr(strtoint(juli[x,y])+1);
      index:=index+1;
      flagON:=true;
     // showmessage('左通');
    end//--------------
    else if txztsz[x,y-1]='B' then
    begin
     //showmessage('在'+inttostr(x)+','+inttostr(y-1)+'处发现目标！');
     findleft:=true;
     alreadyGO[pointx,pointy]:='1';
     win:=true;
     break;
    end;
    //上
    if (txztsz[x-1,y]='0') and (alreadygo[x-1,y]<>'1') and (txztsz[x-1,y]<>'B') and (win=false)then//=1说明已经标记过
    begin
      alreadygo[x-1,y]:='1';//作标记
      onroadX[index]:=inttostr(x-1);//将可到达的点记入序列中
      onroadY[index]:=inttostr(y);
      if juli[x,y]<>'0' then
      //juli[x-1,y]:=inttostr(juliflag);//到起始点距离
      juli[x-1,y]:=inttostr(strtoint(juli[x,y])+1);
      index:=index+1;
      flagON:=true;
      //showmessage('上通');
    end//--------------
    else if txztsz[x-1,y]='B' then
    begin
     //showmessage('在'+inttostr(x-1)+','+inttostr(y)+'处发现目标！');
     findup:=true;
     alreadyGO[pointx,pointy]:='1';
     win:=true;
     break;
    end;
    //-------------完成:判断右、下、左、上的状态-------------
    x:=strtoint(onroadX[po]);
    y:=strtoint(onroadY[po]);
    po:=po+1;
    if flagON=true then juliflag:=juliflag+1;
    flagON:=false;
    if win=true then break;
  End;//-------------主循环------------------------------------
  
  if alreadyGO[pointx,pointy]<>'1' then
    begin
      messagelistbox.Items.Add('搜索完毕');
      messagelistbox.Font.Color:=
      messagelistbox.Items.Add('目标不可到达!');
      listbox1.Items.Add('目标不可到达!');
       button4.Enabled:=true;//使停止自动演示按钮可用
    end;
  //showmessage(inttostr(juliflag));

  //except
   // messagelistbox.Items.Add('目标不可到达!');
   // end;//endtry
  // showmessage('搜索完毕');
//---------******************************************************
//--------★★★★★★★★★★★★回塑★★★★★★★★★★★★★-------------
   messagelistbox.Items.Add('搜索完毕...');
   messagelistbox.Items.Add('绘制路径...');
   //showmessage('开始回塑');
   win:=false;
   re2:=0;
   abcde_x[re2]:=inttostr(x);
   abcde_y[re2]:=inttostr(y);
   re2:=re2+1;
   //showmessage('开始回塑');
   while win=false do
   Begin//------------------主循环------------------------------------
    //右
    if (txztsz[x,y+1]='0')
        and (strtoint(juli[x,y])-strtoint(juli[x,y+1])=1) then//=1说明已经标记过
    begin
      abcde_x[re2]:=inttostr(x);
      abcde_y[re2]:=inttostr(y+1);
      x:=x;
      y:=y+1;
      flag2:=true;
      po:=po-1;
    end//--------------
    else if txztsz[x,y+1]='A'  then
    begin
    // showmessage('在'+inttostr(x+1)+','+inttostr(y)+'处发现目标！');
     win:=true;
     break;
    end
  else//下
    if (txztsz[x+1,y]='0')
            and (strtoint(juli[x,y])-strtoint(juli[x+1,y])=1) then//=1说明已经标记过
    begin
      abcde_x[re2]:=inttostr(x+1);
      abcde_y[re2]:=inttostr(y);
      x:=x+1;
      flag2:=true;
      y:=y;
      po:=po-1;
    end//--------------
    else if txztsz[x+1,y]='A'  then
    begin
     //showmessage('在'+inttostr(x+1)+','+inttostr(y)+'处发现目标！');
     win:=true;
     break;
    end
    else //左
    if (txztsz[x,y-1]='0')
            and (strtoint(juli[x,y])-strtoint(juli[x,y-1])=1) then//=1说明已经标记过
    begin
      abcde_x[re2]:=inttostr(x);
      abcde_y[re2]:=inttostr(y-1);
      x:=x;
      y:=y-1;
      flag2:=true;
      po:=po-1;
    end//--------------
    else if txztsz[x,y-1]='A'  then
    begin
     //showmessage('在'+inttostr(x)+','+inttostr(y-1)+'处发现目标！');
     win:=true;
     break;
    end
    else//上
    if (txztsz[x-1,y]='0') 
            and (strtoint(juli[x,y])-strtoint(juli[x-1,y])=1) then//=1说明已经标记过
    begin
      abcde_x[re2]:=inttostr(x-1);
      abcde_y[re2]:=inttostr(y);
      x:=x-1;
      y:=y;
      flag2:=true;
      po:=po-1;
    end//--------------
    else if txztsz[x-1,y]='A'  then
    begin
     //showmessage('在'+inttostr(x-1)+','+inttostr(y)+'处发现目标！');
     win:=true;
     break;
    end;
    //-------------完成:判断右、下、左、上的状态-------------

    //x:=strtoint(onroadX[po]);
    //y:=strtoint(onroadY[po]);
    if flag2=true then re2:=re2+1;
    if win=true then break;
    


  End;//-------------主循环------------------------------------
  //showmessage('RE2的值　为:'+inttostr(re2));
  //showmessage('高定!开始画最短路径喽');
  //-------------------画最短路径--------------------------
    re:=1;
    listbox1.Items.Insert(0,'↓详细路径↓');
    //showmessage('开始绘制最短路径');
    for re:=0 to re2-1 do
    begin
    listbox1.Items.Insert(1,'↓ '+inttostr(re2-re)+': ['+abcde_X[re]+','+abcde_Y[re]+'] ↓');
    i:=strtoint(abcde_X[re]);
    j:=strtoint(abcde_Y[re]);
    tempmap.Picture:=ok.Picture;
    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;
    listbox1.Items.Add('--描述完毕--');
    messagelistbox.Items.Add('绘制完毕.');
    //showmessage('添加到列表框');
    messagelistbox.Items.Add('最短距离:'+inttostr(re2));
     button4.Enabled:=true;//使停止自动演示按钮可用
  //------------------------------------回塑完毕---------------------------------
  except
    begin
    messagelistbox.Items.Add('搜索完毕');
    messagelistbox.Items.Add('目标不可到达!');
    listbox1.Items.Add('目标不可到达!');
    sleep(2000);
    button4.Enabled:=true;//使停止自动演示按钮可用
    end
  end;//endtry
 end;//2121
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button3Click(Sender: TObject);
var ed,ed2,tempPPP:integer;
  startPP,endPP:bool;//是否选定了出发点与目标地点
begin
  //button3.Enabled:=false;
  messagelistbox.Clear;

  Randomize;
  makemap:=true;
  startpp:=false;
  endpp:=false;
  edit.Text:='';
  //选墙与地
  for ed:=1 to 900 do
  begin
    tempPPP:=random(random(18));
    if { }(tempppp=3)or (tempppp=1) then edit.Text:=edit.Text+'1' else
    if (tempppp=0)or(tempppp=2)or (tempppp=7)or (tempppp=5)then edit.Text:=edit.Text+'0' else
    if tempppp=13 then
     begin
       if startpp=false then
         begin
          edit.Text:=edit.Text+'A';
          startpp:=true;
         end
       else edit.Text:=edit.Text+'0';
     end else//;
     if tempppp=16 then
     begin
       if endpp=false then
         begin
          edit.Text:=edit.Text+'B';
          endpp:=true;
         end
       else edit.Text:=edit.Text+'0';
     end else//;
     edit.Text:=edit.Text+'0';
  end;
 makemap:=true;
  //选出发点与目标地点
 button1.Click;

end;

procedure TForm1.Button4Click(Sender: TObject);
begin

  AutoTime:=0;//初始化自动演示次数
 if button4.Caption='自动演示' then
  begin
   button4.Caption:='停止演示' ;
   button4.Enabled:=false;//使自动演示按钮不可用
   timer1.Enabled:=true;
 
   image.Visible:=false;
   display.Visible:=true;
  end
  else
  begin
   button4.Caption:='自动演示';
   timer1.Enabled:=false;

   image.Visible:=true;
   display.Visible:=false;
  end;
 //--------


end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if AutoPlayFlag=false then
  begin
   button3.Click;
   button4.Enabled:=false;//使自动演示按钮不可用
   AutoPlayFlag:=true;
  end else
  begin
   button2.Click;
   AutoPlayFlag:=false;
  end;
  AutoTime:=AutoTime+1;
  StaticText5.Caption:='次数:'+inttostr(AutoTime);
  display.Picture:=image.Picture;
end;

end.