unit6.pas

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

unit Unit6;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,math, GLScene, GLTeapot, GLMisc, GLObjects, GLWin32Viewer,
  GLTexture, GLGraph, ExtCtrls,VectorGeometry, StdCtrls, GLGeomObjects,
  GLSkydome, GLLensFlare, Grids, GLCadencer, GLFireFX, GLParticleFX,shellapi,mmsystem;
const
 form6_msg= 19991;
  cn_jit_game_star= 18;
  cn_jit_game_up= 21;
  cn_jit_game_down=22;
  cn_jit_game_left=23;
  cn_jit_game_right=24;
  pic_file_count=10;

type
 jit_sz= record
  fangkuai: integer;
  word_index: integer;
  end;
  ptnode=^tnode;
  tnode=record
    s:string;
    g,h:integer;
    //num:节点于最终节点位置不同的字符个数
    //g:深度
    parent,next:ptnode;
    //next:链表中指向下一个节点的指针
    //parent:路径中的父节点
  end;

type
  TForm6 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCube1: TGLCube;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLMaterialLibrary1: TGLMaterialLibrary;
    GLDummyCube1: TGLDummyCube;
    GLPlane1: TGLPlane;
    GLXYZGrid1: TGLXYZGrid;
    Timer2: TTimer;
    Button1: TButton;
    GLCube2: TGLCube;
    GLCube3: TGLCube;
    GLCube4: TGLCube;
    GLCube5: TGLCube;
    GLCube6: TGLCube;
    GLCube7: TGLCube;
    GLCube8: TGLCube;
    SkyDome1: TGLSkyDome;
    GLTorus1: TGLTorus;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    GroupBox2: TGroupBox;
    StringGrid1: TStringGrid;
    Button2: TButton;
    Button3: TButton;
    GLCadencer1: TGLCadencer;
    GLFireFXManager1: TGLFireFXManager;
    PFXRing: TGLPolygonPFXManager;
    PFXRenderer: TGLParticleFXRenderer;
    GLDummyCube2: TGLDummyCube;
    Button4: TButton;
    Label9: TLabel;
    Label10: TLabel;
    GLLensFlare1: TGLLensFlare;
    Button5: TButton;
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure GLSceneViewer1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    mdx,   mdy   :   Integer;
    jit_isgame: boolean;
    currentPick,oldpick : TGLCustomSceneObject;
    is_enter: boolean;
    jit_time,tip_time: integer;
    pic_name: string;
    game_fangkuai: array[0..8] of jit_sz;
    game_step_count: integer;
    game_time_count: integer;
    game_total: integer;
    game_total_one: integer;
    game_is_amt: boolean;
    game_amt_index,game_amt_count: integer;
    procedure instl_game_fangkuai;
    procedure instl_game_index;
    procedure darw_position; //画随机方块
    procedure darw_word; //在方块上写单词
    function get_space: integer; //获取空白格所在位置
    function can_move(c: TGLCube): boolean; //一个东东是否可以移动
    procedure resume_color(c: TGLCube);//恢复颜色
    function get_chinese(index: integer): string;
    function get_english(index: integer): string;
    procedure move_cube(c: tglcube);
    procedure move_cube2(c: tglcube);
    function getspace_at_xy:jit_sz;
    function get_cube_pstion(c: tglcube): integer;
    procedure set_space(i: integer);
    procedure msg_from_form1(var Message: TMessage); message form6_msg;
    procedure move_updown(up: integer); //方向键移动游戏方块
    procedure create_pic_name; //选择一个随机图片文件名
    procedure chinese_bold;
    procedure chinese_not_bold;
    function get_cube_from_index(index: integer): tglcube;
    function get_cube_from_cubeNo(index: integer): tglcube;
    procedure move_to_up;
    procedure move_to_down;
    procedure move_to_left;
    procedure move_to_right;
    procedure go_amt(t: integer);  //开局动画
    procedure game_intl_pic(b: boolean=true); //显示最初的默认图片
    procedure amt_00(t: integer);  
    procedure amt_01(t: integer);  //动画0 －－9
    procedure amt_02(t: integer);
    procedure amt_03(t: integer);
    procedure amt_04(t: integer);
    procedure amt_05(t: integer);
    procedure amt_06(t: integer);
    procedure amt_07(t: integer);
    procedure amt_08(t: integer);
    procedure amt_09(t: integer);
    procedure spk_cube(c: tglcube);
    procedure move_as_string(const s: string);
    function create_auto_s: string;
  public
    { Public declarations }
    jit_word_count: integer;
  end;

var
  Form6: TForm6;

  str:string;
  step,step2,nodenum:integer;
  position:ptnode;//节点在open或closed中的位置
  path,lopen,lclosed:ptnode;
  ee:boolean;

implementation
   uses unit1;
{$R *.dfm}

procedure TForm6.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
GLCamera1.AdjustDistanceToTarget(Power(1.1,   WheelDelta/120));
end;

procedure TForm6.GLSceneViewer1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
	pick : TGLCustomSceneObject;
begin
 if game_is_amt then
  exit;

if not jit_isgame then
 begin
 if messagebox(handle,'游戏尚未开局，是否立即开始？','提示',mb_yesno or MB_ICONWARNING)= mryes then
    button1click(glsceneviewer1);
   exit;
 end;

  mdx:=x;   mdy:=y;
	// if an object is picked...
        if is_enter then
        begin
	pick:=(GLSceneViewer1.Buffer.GetPickedObject(x, y) as TGLCustomSceneObject);
       //if Assigned(pick) then begin
          if pick is tglcube then
           begin
            if Shift=[ssLeft] then
              move_cube(pick as tglcube)
               else
                spk_cube(pick as tglcube);
           end;
	//end;
        end;

end;

procedure TForm6.GLSceneViewer1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  var
        dx,   dy   :   Integer;
begin
if not jit_isgame then exit;

         try
           currentPick:=(GLSceneViewer1.Buffer.GetPickedObject(x, y) as TGLCustomSceneObject);
         except
           exit;
         end;

		// if we are picked, target color is red, else it is black (no emission)
		if (currentPick is tglcube) then
                  begin
                   if not is_enter then
                    begin
                    is_enter:= true;
                    tip_time:= 0;
                    oldpick:= currentpick;
                    can_move(currentpick as tglcube);
                    end;
                  end
                    else begin
                          if is_enter then
                           begin
                              if tip_time> 49 then
                                begin
                                  //中文恢复
                                 chinese_not_bold;
                                end;
                             is_enter:= false;
                             if Assigned(oldpick) then
                               resume_color(oldpick as tglcube);
                           end;
                         end;
		// Set new color at 66% between current and target color
	       {	with Material.FrontProperties.Emission do
			Color:=VectorLerp(targetColor, Color, 0.66)  }



   dx:=mdx-x;   dy:=mdy-y;
    
        mdx:=x;   mdy:=y;

   if Shift=[ssRight] then
      GLCamera1.MoveAroundTarget(dy, dx)
   else if Shift=[ssLeft] then
      GLCamera1.RotateObject(GLDummyCube1, dy, dx);
    

end;

procedure TForm6.FormCreate(Sender: TObject);
begin

    game_intl_pic; //显示游戏初始方块图片

//  GLMaterialLibrary1.AddTextureMaterial('jpg2','E:\作品\3dtest\{3F052F79-6633-4936-97F2-C89D1F02FD2E}.BMP');

 // glcube1.Material;


  stringgrid1.Cells[0,0]:= '剩余时间：';
 stringgrid1.Cells[0,1]:= '经过步数：';
 stringgrid1.Cells[0,2]:= '金币：';
 stringgrid1.Cells[0,3]:= '上局分数：';
 stringgrid1.Cells[0,4]:= '累计分数：';
   stringgrid1.Cells[1,4]:= '测试版不累计';
 stringgrid1.Cells[0,5]:= '单词朗读：';
   stringgrid1.Cells[1,5]:= '点击鼠标右键朗读';
 stringgrid1.Cells[0,6]:= '状态：';
  stringgrid1.Cells[1,6]:= '游戏尚未开局';

  create_pic_name;
 
end;

procedure TForm6.Timer2Timer(Sender: TObject);
begin
	// get what is under the mouse
  if game_is_amt then
   begin
    inc(game_amt_count);   //进入动画
      go_amt(game_amt_count);
    if game_amt_count= 60 then  //6秒钟后退出动画状态
     game_is_amt:= false;
    exit;
   end;
 inc(jit_time);

  if jit_time mod 4 = 0 then
   glsceneviewer1.Invalidate;

 if jit_time= 30 then
  begin
    GetOrCreateSourcePFX(GLDummyCube2).Enabled:= false;
   GLCadencer1.Enabled:= false;
    GLFireFXManager1.Disabled:= false;
  end;
 inc(tip_time);
  if tip_time= 50 then
   begin
    //中文粗体
    chinese_bold;
   end;
  if tip_time=70 then
   begin
    //中文恢复
    chinese_not_bold;
   end;
  if tip_time= 10040 then
   begin
    GLFireFXManager1.ParticleSize:= 0;
     GLFireFXManager1.Disabled:= true;
     GLCadencer1.Enabled:=false;
    glsceneviewer1.Invalidate;
   end;
   dec(game_time_count);

   if game_time_count>= 0 then
      stringgrid1.Cells[1,0]:= inttostr(game_time_count div 10)+ ' 秒';

   if game_time_count= 0 then
    begin
     jit_isgame:= false;
     GLFireFXManager1.ParticleSize:= 3;
     GLFireFXManager1.Disabled:= false;
     GLCadencer1.Enabled:= true;
     tip_time:= 10000;
     button3.Enabled:= false;
     button4.Enabled:= false;
    end;

end;

procedure TForm6.Button1Click(Sender: TObject);
begin
   // We generate a handful of bitmaps from scratch
   // you could also load them from a set of files, extract from an AVI etc.
 if jit_isgame then
  begin
   if messagebox(handle,'游戏已经在进行中，是否重新开局？','游戏进行中',mb_yesno or MB_ICONWARNING)= mrno then
    exit;
  end;
 screen.Cursor:= crhourglass;

 
    game_amt_index:= random(10);
    game_amt_count:= 0;
    game_is_amt:=true;
     screen.Cursor:= crhourglass;

       while game_is_amt do
       application.ProcessMessages;


     screen.Cursor:= crdefault;
 timer2.Enabled:= true;
  button3.Enabled:= true;
  button4.Enabled:= true;
  stringgrid1.Cells[1,6]:= '游戏进行中……';

  game_step_count:=0;
    game_time_count:=6000;

     stringgrid1.Cells[1,0]:= '600 秒';
 stringgrid1.Cells[1,1]:= '0';
      
  //按数组来重新初始化方块
          instl_game_fangkuai;

    //初始化单词在单词本的随机位置
          instl_game_index;

   //画新位置
     darw_position;
   darw_word; //显示单词


   // Initialize our loop
  // Cube1.Material.MaterialLibrary:=GLMaterialLibrary1;
  // glCube1.Material.LibMaterialName:='jpg1';

  jit_isgame:= true;
  screen.Cursor:= crdefault;

end;

procedure TForm6.instl_game_fangkuai; //初始化单词方块的随机位置
var i,j: integer;
    n: boolean;
begin
  for i:= 0 to 7 do
   begin
    game_fangkuai[i].fangkuai:= 0;
   end;

  for i:=0 to 7 do
   begin
     game_fangkuai[i].fangkuai:= random(8)+ 1; //产生一个随机数
     repeat
       n:= true;
      for j:= i-1 downto 0 do
       begin
       if game_fangkuai[i].fangkuai= game_fangkuai[j].fangkuai then
        begin
          n:= false;
          game_fangkuai[i].fangkuai:= random(8)+ 1;
          break;
        end;
        end;
      until n;

    end;


   game_fangkuai[8].fangkuai:= 0;
   game_fangkuai[8].word_index:= 0;
end;

procedure TForm6.instl_game_index;  //初始化游戏在单词本中的单词索引。
var i,j: integer;
    n: boolean;
begin
  for i:= 0 to 7 do
   begin
    game_fangkuai[i].word_index:= 0;
   end;

   for i:=0 to 7 do
   begin
     game_fangkuai[i].word_index:= random(jit_word_count); //产生一个随机数
     repeat
       n:= true;
      for j:= i-1 downto 0 do
       begin
       if game_fangkuai[i].word_index= game_fangkuai[j].word_index then
        begin
          n:= false;
          game_fangkuai[i].word_index:= random(jit_word_count);
          break;
        end;
        end;
      until n;

    end;


end;

procedure TForm6.darw_position;
   function get_x(j: integer): integer;
    begin
     result:= 0;
      if j in[0,3,6] then
       result:= -4
       else if j in[1,4,7] then
            result:= 0
            else if j in[2,5,8] then
             result:= 4;
    end;
    function get_y(k: integer): integer;
    begin
     result:= 0;
      if k in[0..2] then
       result:= 3
       else if k in[3..5] then
            result:= 0
            else if k in[6..8] then
             result:= -3;
    end;
var i: integer;
begin
  for i:= 0 to 7 do