unit6.pas

一个采用类似大富翁游戏模式的背单词软件

end;

procedure TForm6.Button2Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'http://hi.baidu.com/3030/blog/item/4eefc9ea1ffd75d3d539c9e9.html#FContact', nil, nil, SW_SHOWNORMAL);

end;

procedure TForm6.go_amt(t: integer);
begin
 if t= 30 then
  begin
   //初始化图片
   game_intl_pic(false);
  end;

  case game_amt_index of
  0: amt_00(t);
  1: amt_01(t);
  2: amt_02(t);
  3: amt_03(t);
  4: amt_04(t);
  5: amt_05(t);
  6: amt_06(t);
  7: amt_07(t);
  8: amt_08(t);
  9: amt_09(t);
  end;

end;

procedure TForm6.game_intl_pic(b: boolean=true);
var i: integer;
   bmp : TBitmap;
begin
   // We generate a handful of bitmaps from scratch
   // you could also load them from a set of files, extract from an AVI etc.

      bmp:=TBitmap.Create;
      bmp.PixelFormat:=pf24bit;
    //  bmp.Width:=129;
     // bmp.Height:=86;
      bmp.LoadFromFile(ExtractFilePath(application.ExeName)+ 'sg.BMP');
        bmp.Width:=128;
        bmp.Height:=84;
      bmp.Canvas.Font.Name:='宋体';
      bmp.Canvas.Font.Height:=16;
      bmp.Canvas.Brush.Style:= bsClear;

         bmp.Canvas.TextOut(25, 35, '拼图背单词');
      bmp.Canvas.TextOut(3, 65, '[e-mail]');
         //GLMaterialLibrary1.Materials.Items[0].Material.Texture.image.Assign(bmp);
       for i:=  1 to 8 do
  begin
   if b then
    begin
   with GLMaterialLibrary1.AddTextureMaterial('img'+ inttostr(i),bmp) do
        Material.FrontProperties.Emission.Color:=clrGray50;
    end else begin
               GLMaterialLibrary1.Materials.Items[i-1].Material.Texture.image.Assign(bmp);
             end;
  end;

      bmp.Free;

  glCube1.Material.LibMaterialName:='img1';
  glCube2.Material.LibMaterialName:='img2';
  glCube3.Material.LibMaterialName:='img3';
  glCube4.Material.LibMaterialName:='img4';
  glCube5.Material.LibMaterialName:='img5';
  glCube6.Material.LibMaterialName:='img6';
  glCube7.Material.LibMaterialName:='img7';
  glCube8.Material.LibMaterialName:='img8';
end;

procedure TForm6.amt_00(t: integer);
begin
  //灯光位置移动
  if t<= 30 then
   GLLightSource1.Position.Z:= 8 / t
   else
     GLLightSource1.Position.Z:= 2/15 * t;
end;

procedure TForm6.amt_01(t: integer);
begin
   //变焦
  if t< 30 then
   GLCamera1.FocalLength:= 60 / t
   else
     GLCamera1.FocalLength:= 2 * (t-30);
end;

procedure TForm6.amt_02(t: integer);
begin
  //旋转
  GLDummyCube1.Turn(6);
end;

procedure TForm6.amt_03(t: integer);
begin
  //旋转
  GLDummyCube1.Pitch(6);
end;

procedure TForm6.amt_04(t: integer);
begin
  //翻转
 // GLDummyCube1.Pitch();
  GLDummyCube1.Roll(6);
end;

procedure TForm6.amt_05(t: integer);
begin
  //镜头左右旋转
  if t<= 30 then
 GLCamera1.MoveAroundTarget(0, 6)
 else
   GLCamera1.MoveAroundTarget(0, -6);
end;

procedure TForm6.amt_06(t: integer);
begin
  //变焦并旋转
  GLDummyCube1.Roll(6);
  if t< 30 then
   GLCamera1.FocalLength:= 60 / t
   else
     GLCamera1.FocalLength:= 2 * (t-30);
end;

procedure TForm6.amt_07(t: integer);
begin
  //镜头上下旋转
  if t<= 30 then
   GLCamera1.MoveAroundTarget(3, 0)
   else
     GLCamera1.MoveAroundTarget(-3, 0);
end;

procedure TForm6.amt_08(t: integer);
begin
  //
 GLDummyCube1.Pitch(6);
 if t< 30 then
   GLCamera1.FocalLength:= 60 / t
   else
     GLCamera1.FocalLength:= 2 * (t-30);
end;

procedure TForm6.amt_09(t: integer);
begin
   //一个一个消失，一个一个显示
   case t of
   1: glcube1.Visible:= false;
   5: glcube2.Visible:= false;
   9: glcube3.Visible:= false;
   13:glcube4.Visible:= false;
   17:glcube5.Visible:= false;
   21:glcube6.Visible:= false;
   25:glcube7.Visible:= false;
   28:glcube8.Visible:= false;

   31:glcube1.Visible:= true;
   35:glcube2.Visible:= true;
   39:glcube3.Visible:= true;
   43:glcube4.Visible:= true;
   47:glcube5.Visible:= true;
   51:glcube6.Visible:= true;
   55:glcube7.Visible:= true;
   58:glcube8.Visible:= true;
   end;
end;

procedure TForm6.spk_cube(c: tglcube);
var ss: string;
begin
  ss:= get_english(game_fangkuai[get_cube_pstion(currentPick as tglcube)-1].word_index);
  if ss<> '' then
   form1.skp_string(ss);
end;

procedure TForm6.Button5Click(Sender: TObject);
begin

   move_as_string(create_auto_s);
end;

procedure TForm6.move_as_string(const s: string);
var i: integer;
begin
screen.Cursor:= crHourGlass;
  for i:= 1 to length(s) do
   begin
    move_cube2(get_cube_from_cubeNo(strtoint(s[i])));
    application.ProcessMessages;
    sleep(500);
    application.ProcessMessages;
   end;
 screen.Cursor:= crdefault;
end;

function TForm6.get_cube_from_cubeNo(index: integer): tglcube;
begin
 case index of
 1: result:= glcube1;
 2: result:= glcube2;
 3: result:= glcube3;
 4: result:= glcube4;
 5: result:= glcube5;
 6: result:= glcube6;
 7: result:= glcube7;
 8: result:= glcube8;
 else
  result:= glcube1;
 end;

end;

procedure shifang(b:ptnode);
var temp:ptnode;
begin
 while b.next<>nil do
  begin
  temp:=b.next;
  b.next:=temp.next;
  dispose(temp);
  end;
end;
function count(ss:string):integer;
//计算h2
var
 i,n,m:integer;
 s:string;
begin
 n:=0;
 s:='123456780';
 for i:=1 to 9 do
   begin
    m:=pos(s[i],ss);
    n:=n+(abs(m-i)mod 3)+(abs(m-i)div 3);
   end;
 count:=n;
end;

function generate(ss:string; p:ptnode):ptnode;
//生成节点
var
 q:ptnode;
begin
 new(q);
 q.s:=ss;
 q.g:=p.g+1;
 q.h:=count(ss);
 q.parent:=p;
 generate:=q;
end;
function search(a,q:ptnode):boolean;
//搜索q是否为表a中的节点 position为q在a中的位置的前一个节点
var
 p:ptnode;
 search1:boolean;
begin
 search1:=false;
 position:=a;
 p:=a.next;
 while (p<>nil)do
  if (q.s<>p.s) then
    begin
     p:=p.next;
     position:=position.next;
    end
   else break;
 if (p<>nil) then
   search1:=true;
 search:=search1;
end;

procedure extend(var open,closed,p1:ptnode);
//扩展节点
var
 p,qq:ptnode;
 prior:ptnode;//要插入的位置的前一个节点的指针
begin
  if search(open,p1) then
    begin
     if (p1.g<position.next.g) then
       begin
         p:=position.next;
         p1.next:=p.next;
         position.next:=p1;
         dispose(p);
       end
     else dispose(p1);
    end
  else if search(closed,p1) then
          begin
           if (p1.h<position.next.h) then
           //if (p1.g<position.next.g) then
             begin
              p:=position.next;
              p1.next:=p.next;
              position.next:=p1;
              p1.parent:=p.parent;
              qq:=closed.next;
              while qq<>nil do
                if qq.parent=p then
                  qq.parent:=p1;
              dispose(p);
             end
           else dispose(p1);
          end
       else begin
             prior:=open;
             p:=open.next;
             while (p<>nil) do
                if ((p.h+p.g)<(p1.h+p1.g)) then
                 begin
                  prior:=prior.next;
                  p:=p.next;
                 end
                else break;
            p1.next:=prior.next;
            prior.next:=p1;
            end;
end;
procedure changestr(i,j:integer;var ss:string);
//交换字符串中两个字符的位置
var
 temp:char;
begin
 temp:=ss[i];
 ss[i]:=ss[j];
 ss[j]:=temp;
end;

function TForm6.create_auto_s: string;
var
 p,node,present:ptnode;//p：临时指针
 str1:string;
 zeroposition,i,j:integer;
begin
result:= '';
screen.Cursor:= crhourglass;
str:= '';

for i:= 0 to 8 do     //传入当前状态列表
 str:= str+ inttostr(game_fangkuai[i].fangkuai);

 nodenum:=0;
  step:=0;
 new(lclosed);
 lclosed.next:=nil;
 new(lopen);
 new(p);//lopen,lclosed均带头节点
 lopen.next:=p;
 p.s:=str;
 p.next:=nil;
 p.g:=0;
 p.parent:=nil;

 p.h:=count(str); //函数2

 while (lopen.next<>nil) do
   begin
    if(lopen.next.s<>'123456780')and(lopen.next.s<>'123456870') then
     begin
      nodenum:=nodenum+1;
      p:=lopen.next;
      lopen.next:=p.next;
      p.next:=lclosed.next;
      lclosed.next:=p;
      str1:=p.s;
      zeroposition:=pos('0',str1);
       if (zeroposition mod 3)<>1 then
         begin
          changestr(zeroposition,zeroposition-1,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if (zeroposition mod 3)<>0 then
         begin
          changestr(zeroposition,zeroposition+1,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if ((zeroposition-1)div 3)>0 then
         begin
          changestr(zeroposition,zeroposition-3,str1);
          present:=generate(str1,p);
           if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
       str1:=p.s;
       if ((zeroposition-1)div 3)<2 then
         begin
          changestr(zeroposition,zeroposition+3,str1);
          present:=generate(str1,p);
          if (p.parent<>nil)  then
           if present.s<>p.parent.s then
            extend(lopen,lclosed,present)
           else dispose(present)
           else extend(lopen,lclosed,present);
         end;
     end
   else break;

   end;

if (lopen.next.s='123456780') then
   begin
      new(path);
      path.next:=nil;
      new(node);
      node.s:=lopen.next.s;
      node.h:=lopen.next.h;
      node.g:=lopen.next.g;
      node.parent:=lopen.next.parent;
      node.next:=path.next;
      path.next:=node;
      step2:=1;
      if path.next.parent=nil then
      begin
      application.messagebox('已完成。','3D拼图',mb_ok+mb_iconinformation);
      exit;
      end
      else begin
            while path.next.parent.s<>str do
             begin
               new(node);
               node.s:=path.next.parent.s;
               node.h:=path.next.parent.h;
               node.g:=path.next.parent.g;
               node.parent:=path.next.parent.parent;
               node.next:=path.next;
               path.next:=node;
               step2:=step2+1;
             end;
             if messagebox(handle,pchar('此局能在'+ inttostr(step2)+'步完成，是否演示？这将扣除您5000金币'),'提示',mb_yesno or MB_ICONINFORMATION)= mryes then
              begin
               //扣金币
                Form1.cut_money(5000);
                stringgrid1.Cells[1,2]:= '扣除金币：5000';
               j:= pos('0',str);
                 for i:= 1 to step2 do
                  begin
                    p:=path.next;
                    path.next:=p.next;
                  result:= result + p.s[j];
                  j:= pos('0',p.s);
                  end;

              end;
               shifang(path);
           end;
   end
 else
   application.messagebox('此局无解！','3D拼图',mb_ok+ mb_iconinformation);

 shifang(lopen);
 shifang(lclosed);


 screen.Cursor:= crdefault;
end;

end.