⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 eightnumberfrm.pas

📁 此软件是八数码软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    if ( AStar1PathTop <> 0 ) then
    begin
        AStar1Memo.Lines.Clear;
        //显示初始结点
        AStar1Memo.Lines.Add( ' ' + inttostr(Queue[1].status[1,1]) + ' ' + inttostr(Queue[1].status[1,2]) + ' ' + inttostr(Queue[1].status[1,3]) );
        AStar1Memo.Lines.Add( ' ' + inttostr(Queue[1].status[2,1]) + ' ' + inttostr(Queue[1].status[2,2]) + ' ' + inttostr(Queue[1].status[2,3]) );
        AStar1Memo.Lines.Add( ' ' + inttostr(Queue[1].status[3,1]) + ' ' + inttostr(Queue[1].status[3,2]) + ' ' + inttostr(Queue[1].status[3,3]) );

        //循环显示其他结点
        for i := AStar1PathTop-1 DownTo 1 do
        begin
            AStar1Memo.Lines.Add( '   |');
            AStar1Memo.Lines.Add( ' ' + inttostr(Queue[AStar1Path[i]].status[1,1]) + ' ' + inttostr(Queue[AStar1Path[i]].status[1,2]) + ' ' + inttostr(Queue[AStar1Path[i]].status[1,3]) );
            AStar1Memo.Lines.Add( ' ' + inttostr(Queue[AStar1Path[i]].status[2,1]) + ' ' + inttostr(Queue[AStar1Path[i]].status[2,2]) + ' ' + inttostr(Queue[AStar1Path[i]].status[2,3]) );
            AStar1Memo.Lines.Add( ' ' + inttostr(Queue[AStar1Path[i]].status[3,1]) + ' ' + inttostr(Queue[AStar1Path[i]].status[3,2]) + ' ' + inttostr(Queue[AStar1Path[i]].status[3,3]) );
        end;//end of for i

    end; //end of if ( AStar1PathTop <> 0 )----找到路径

    //路径结点总数和访问结点总数赋予对应的Label
     AStar1RoadLabel.Caption := inttostr(AStar1PathTop) + '  ';
     AStar1VisitedLabel.Caption := inttostr(AStarQueueTop) + '  ';

   //设置显示路径结点总数和访问结点总数的Label为可见
     AStar1RoadLabel.Visible := True;
     AStar1VisitedLabel.Visible := True;

end;


//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////BFS过程根据宽度优先搜索(Broad First Search)算法求出从初始结点到目标结点的路径,记录在BFSPath全局数组中
////入口:procedure----MemorizeBFSRoad
////参数:无
////返回值:最后一个生成的结点的下标
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TEightNumber.BFS(): integer;
var  i,j,k : integer; //循环变量
     ChooseX,ChooseY : integer;  //即将要展开的结点的空格的行列坐标
     row,col : integer;  //空格移动后,空格的新坐标
     SameNumber : integer;   //有结点与新增结点相同,则为该结点的下标,否则为0
     find : boolean;  //找到路径达到目标状态
begin
   //初始化
   find := False;
   BFSHead := 0; //BFSHead是全局变量,表示当前结点在数组Queue中的下标
   BFSTail := 1; //BFSTail是全局变量,表示新生成结点在数组Queue中的下标

   //清空BFSPath数组
   for i := 1 to 100 do
   begin
      BFSPath[i] := 0;
   end;

    //*********************************************
    //此时BFSTail为1,亦即指向初始结点
    //调用IsTarget函数判断初始结点是否目标结点
    //如果是则返回True,否则返回False
    if IsTarget( BFSTail )   //初始结点是目标结点
    then   find := True;


   //*********************************************
   ////////////////////BFS算法////////////////////
   //*********************************************
   while ( ( not find ) and ( BFSTail < High( Queue ) ) ) do
   begin
       BFSHead := BFSHead + 1; //取出下一个结点进行展开

       ChooseX := Queue[BFSHead].x;  //取出展开节点的空格的行坐标
       ChooseY := Queue[BFSHead].y;  //取出展开节点的空格的列坐标

      for k := 1 to 4 do
      begin
         row := ChooseX + MoveX[k];         //row和col表示空格移动后,空格的新坐标
         col := ChooseY + MoveY[k];         //k从1到4分别表示空格向上、左、下、右移动

         //以下if的判断条件是判断空格是否可以向上、左、下、右移动
         if ( (row >= 1) and (row <= 3) and (col >= 1) and (col <=3) ) then
         begin
             BFSTail := BFSTail +1;  //新增一个结点

             //////////通过展开的结点BFSHead设置新增结点BFSTail的8个数字和空格位置
             ////先将结点BFSHead的8个数字和空格位置复制到结点BFSTail中
             for i := 1 to 3 do
             begin
                for j := 1 to 3 do
                begin
                   Queue[BFSTail].status[i,j] := Queue[BFSHead].status[i,j]
                end;//end of for j
             end;//end of for i

             ////再修改因为空格移动而造成的两个结点的不同之处
             Queue[BFSTail].status[ChooseX,ChooseY] := Queue[BFSHead].status[row,col];
             Queue[BFSTail].status[row,col] := 0;

             ////再记录空格的行列坐标
             Queue[BFSTail].x := row;
             Queue[BFSTail].y := col;

             //*********************************************
             //调用BFSExist函数判断新增结点是否在之前已经生成
             //如果之前已经生成则返回已经生成的结点的下标
             //如果还没有生成则返回0
             SameNumber := BFSExist();

             if (SameNumber > 0) then     //新增结点在之前已经生成
             begin
                BFSTail := BFSTail - 1; //撤消此新增结点
             end //end of if (SameNumber > 0)----新增结点在之前已经生成

             else //新增结点在之前并没有已经生成
             begin
                  //设置新增结点BFSTail的指针指向BFSHead结点
                  Queue[BFSTail].prior := BFSHead;

                  //*********************************************
                  //调用IsTarget函数判断新增结点是否目标结点
                  //如果是则返回True,否则返回False
                  if IsTarget( BFSTail ) then  //新增结点是目标结点
                  begin
                      find := True;
                      break;
                  end //end of if IsTarget( BFSTail )----新增结点是目标结点

             end;//end of else----新增结点在之前并没有已经生成

         end;//end of if ( (row >= 1) and (row <= 3) and (col >= 1) and (col <=3) )
         
      end;//end of for k

   end;//end of while

   //BFS的返回值是最后一个生成的结点的下标
   BFS := BFSTail;

end;

///////////////////////////////////////////////////
////Depth函数计算参数指定的结点的深度,也就是g函数
////入口:function----AStar(method:integer):integer
////参数:某一结点在Queue数组中的下标
////返回值:参数指定的结点的深度
///////////////////////////////////////////////////
function TEightNumber.Depth(n: integer): integer;
var  count:integer;  //深度
     temp :integer;  //中间结点
begin
  count := 0;
  temp  := n;
  while (temp<>1) do    //初始结点在数组中的下标是1,所以这里的判断条件是(temp<>1)
  begin
    count := count + 1;
    temp := Queue[temp].prior;    //temp不断通过指针向初始结点逼近
  end;
  Depth := count;   //返回深度

end;


/////////////////////////////////////////////////////
////AStarExist函数判断新增结点是否在之前已经生成
////返回值:之前已经生成则返回已经生成的结点的下标
////        还没有生成则返回0
////入口:function----AStar(method:integer):integer
////参数:无,因为判断的是新增结点,下标必为AStarQueueTop
/////////////////////////////////////////////////////
function TEightNumber.AStarExist: integer;
var  i,j,k : integer;        //循环变量
     same : boolean;         //标识新增结点是否与已有结点相同
     SameNumber : integer;   //如果same为True,则表示与新增结点相同的结点的下标,否则为0
begin
       SameNumber := 0;
       for k := 1 to AStarQueueTop - 1 do
       begin
           same := True;
           for i := 1 to 3 do
           begin
              for j := 1 to 3 do
              begin
                 if (Queue[AStarQueueTop].status[i,j] <> Queue[k].status[i,j]) then
                 begin
                     same := False;  //不相同则设置same为False
                     break;   //exit for j  ******  不相同则跳出循环
                 end;//end of if
              end;//end of for j

           if not same then break; //exit for i  ******  不相同则跳出循环

           end;//end of for i

       if same then
       begin
          SameNumber := k;    //令SameNumber记住和新增结点相同的结点的下标
          break; //exit for k
       end;//end of if

       end;//end of for k

      AStarExist := SameNumber;  //返回是否已有结点与新增结点相同,返回0和已有结点下标
end;

/////////////////////////////////////////////////////
////FormCreate过程用于初始化
/////////////////////////////////////////////////////
procedure TEightNumber.FormCreate(Sender: TObject);
var i:integer;                //循环变量
    ImageHDC : HDC;           //9个Image的句柄
    AllNumberImageHDC : HDC;  //AllNumberImage的句柄
begin
    //定位本窗体
    Width := 780;
    Height := 540;
    Top := ( Screen.Height - EightNumber.Height - 50 ) Div 2;
    Left := ( Screen.Width - EightNumber.Width ) Div 2;

    //初始化MoveX和MoveY数组
    //MoveX表示空格的行移动,MoveY表示空格的列移动
    //第1个元素代表空格向上移动
    MoveX[1] := -1;
    MoveY[1] := 0;
    //第2个元素代表空格向左移动
    MoveX[2] := 0;
    MoveY[2] := -1;
    //第3个元素代表空格向下移动
    MoveX[3] := 1;
    MoveY[3] := 0;
    //第4个元素代表空格向右移动
    MoveX[4] := 0;
    MoveY[4] := 1;

    //在确定初始结点和目标结点之前4个Button都不能启动
    AStar1Btn.Enabled := False;
    AStar2Btn.Enabled := False;
    BFSBtn.Enabled := False;
    //CompareBtn.Enabled := False;

    //将9宫图赋空白图
    AllNumberImageHDC := AllNumberImage.Canvas.Handle;
    for i := 1 to 9 do
    begin
        //依次取得9个Image的句柄
        ImageHDC := (EightNumber.Controls[i] AS TImage).Canvas.Handle;
        BitBlt(ImageHDC, 0, 0, 91, 91, AllNumberImageHDC, 0, 0, SRCCOPY);
    end;

    //设置状态栏的参数
      StatusBar.Font.Size := 10;
      StatusBar.Font.Style := StatusBar.Font.Style + [fsBold];

    //设置状态栏显示内容
      StatusBar.Panels[0].Text := '欢迎使用本八数码软件';

end;


///////////////////////////////////////////////////
////HValue1函数计算参数指定的结点的启发式函数1的值
////此启发式函数为"不在位"的将牌数
////入口:function----FValue1(n: integer): integer
////返回值:参数指定的结点的启发式函数1的值
////参数:某一结点在Queue数组中的下标
///////////////////////////////////////////////////
function TEightNumber.HValue1(n: integer): integer;
var  i,j:integer;  //循环变量
     count:integer; //启发式函数h1---"不在位"的将牌数
begin
     count := 0;
     for i := 1 to 3 do
     begin
        for j := 1 to 3 do
        begin
          if ( (Target[i,j] <> 0) and (Target[i,j] <> Queue[n].status[i,j]) )
          then   count := count + 1;
        end;//end of for j
     end;//end of for i

     HValue1 := count;  //返回启发式函数的值

end;


///////////////////////////////////////////////////
////HValue2函数计算参数指定的结点的启发式函数2的值
////此启发式函数为将牌"不在位"的距离和
////入口:function----FValue2(n: integer): integer
////返回值:参数指定的结点的启发式函数2的值
////参数:某一结点在Queue数组中的下标
///////////////////////////////////////////////////
function TEightNumber.HValue2(n: integer): integer;
var  i,j,p,q:integer;  //循环变量
     count:integer; //启发式函数h2---将牌"不在位"的距离和
begin
     count := 0;
     for i := 1 to 3 do
     begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -