main.~pas

一个拼图游戏

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, ExtDlgs,About, OleCtrls,
  ShockwaveFlashObjects_TLB;
type block=array[1..9] of byte;
type
  TfrmMain = class(TForm)
    MainMenu: TMainMenu;
    G1: TMenuItem;
    start: TMenuItem;
    N2: TMenuItem;
    ok: TMenuItem;
    H1: TMenuItem;
    about: TMenuItem;
    image: TImage;
    loadpic: TMenuItem;
    N11: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    js: TMenuItem;
    swfPlayer: TShockwaveFlash;
    procedure okClick(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure unCheck;
    procedure FormCreate(Sender: TObject);
    procedure drawback;
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure startClick(Sender: TObject);
    function getRow:integer;
    function getLine:integer;
    procedure imageClick(Sender: TObject);
    function won:boolean;
    procedure win;
    procedure jsClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    backg:String;
    bgb:TBitMap;
    fk:array[1..9] of TBitMap;
    grid:block;
    procedure draw;
    procedure init;
    procedure cell;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.okClick(Sender: TObject);
begin
  close;
end;

procedure TfrmMain.aboutClick(Sender: TObject);
begin
  frmAbout:=TfrmAbout.Create(self);
  frmAbout.Show;
end;

procedure TfrmMain.unCheck;
begin
  N11.Checked:=false;
  N21.Checked:=false;
  N31.Checked:=false;
  N41.Checked:=false;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
{var i:integer;
    s:string;}
begin
  sleep(2000);
  js.Enabled:=false;
  bgb:=TBitMap.Create;
  drawback;
  backg:=ExtractFilePath(Application.ExeName)+'pic\1.bmp';
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  init;
end;

procedure TfrmMain.N11Click(Sender: TObject);
begin
  backg:=ExtractFilePath(Application.ExeName)+'pic\1.bmp';
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  unCheck;
  N11.Checked:=true;
end;

procedure TfrmMain.N21Click(Sender: TObject);
begin
  backg:=ExtractFilePath(Application.ExeName)+'pic\2.bmp';
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  unCheck;
  N21.Checked:=true;
end;

procedure TfrmMain.N31Click(Sender: TObject);
begin
  backg:=ExtractFilePath(Application.ExeName)+'pic\3.bmp';
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  unCheck;
  N31.Checked:=true;
end;

procedure TfrmMain.N41Click(Sender: TObject);
begin
  backg:=ExtractFilePath(Application.ExeName)+'pic\4.bmp';
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  unCheck;
  N41.Checked:=true;
end;

procedure TfrmMain.draw;//把grid中的图片画出来
var i,j:integer;
begin
  for i:=1 to 3 do
    for j:=1 to 3 do
    begin
      if grid[(i-1)*3+j] <> 0 then
        image.Canvas.Draw(20+(j-1)*(400 div 3),20+(i-1)*(300 div 3),fk[grid[(i-1)*3+j]])
      else
        begin
        //image.Canvas.Rectangle(20+(j-1)*(400 div 3),20+(i-1)*(300 div 3),20+j*(400 div 3),20+i*(300 div 3));
        image.Canvas.Brush.Color:=clBlue;
        image.Canvas.FillRect(rect(20+(j-1)*(400 div 3),20+(i-1)*(300 div 3),20+j*(400 div 3)+2,20+i*(300 div 3)));
        end;
    end;;
end;

procedure TfrmMain.init;//产生不重复的数字，用来保存各个图片的位置
var i,j,k,ran:integer;
begin
  Randomize;
  for i:=1 to 9 do
      grid[i]:=0;
  k:=1;
  while k<=8 do
  begin
    ran:=random(9);
    if ran=0 then
      ran:=1;
    grid[k]:=ran;
    for j:=1 to k-1 do
    begin
      if grid[k]=grid[j] then
        k:=k-1;
    end;
    k:=k+1;
  end;
end;

procedure TfrmMain.drawback;//画出背景,完成初始界面的工作
var bg:TRect;
begin
  bg:=rect(0,0,image.Width,image.Height);
  image.Canvas.Brush.Color:=clBlue;
  image.Canvas.FillRect(bg);
end;

procedure TfrmMain.startClick(Sender: TObject);
begin
  swfPlayer.Visible:=false;
  swfPlayer.Stop;
  js.Enabled:=true;
  cell;
  init;
  draw;
end;

function TfrmMain.getRow:integer; //取得鼠标的位置在第几列
var vpoint,point:TPoint;
begin
  getcursorpos(vpoint);
  point:=screentoclient(vpoint);
  if (point.x<20) and (point.x>420) then
  else
  result:=(point.X-20) div (400 div 3)+1;
end;

function TfrmMain.getLine:integer;//取得鼠标点击的是第几行
var vpoint,point:TPoint;
begin
  getcursorpos(vpoint);
  point:=screentoclient(vpoint);
  if (point.y<20) and (point.y>320) then
  else
  result:=(point.Y-20) div (300 div 3) + 1;
end;

procedure TfrmMain.imageClick(Sender: TObject);//核心算法，用来移动图片
var i,j,k:integer;
begin
  i:=getLine;
  j:=getRow;
  k:=(i-1)*3+j;
  {行数,检查上下是不是有空位,有的话就交换空位与图片}
  case i of
    1:if grid[k+3]=0 then
      begin
        grid[k+3]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
    2:begin
      if grid[k+3]=0 then
      begin
        grid[k+3]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end
      else
      if grid[k-3]=0 then
      begin
        grid[k-3]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
    end;
    3:if grid[k-3]=0 then
      begin
        grid[k-3]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
  end;
  {检查左右是不是有空位,有的话就交换图片与空位}
  case j of
    1:if grid[k+1]=0 then
      begin
        grid[k+1]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
    2:begin
      if grid[k-1]=0 then
      begin
        grid[k-1]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end
      else
      if grid[k+1]=0 then
      begin
        grid[k+1]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
    end;
    3:if grid[k-1]=0 then
      begin
        grid[k-1]:=grid[k];
        grid[k]:=0;
        draw;
        win;
      end;
  end;

end;
procedure TfrmMain.cell;//产生各个cell的图片，保存到tbitmap变量中
var i,j,k:integer;
begin
  bgb.LoadFromFile(backg);
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  for k:=1 to 9 do
  begin
    j:=(k-1) div 3 + 1;
    i:=(k-1) mod 3+1;
    fk[k]:=TBitMap.Create;
    fk[k].Width:=400 div 3;
    fk[k].Height:=300 div 3;
    fk[k].Canvas.CopyRect(rect(0,0,(400 div 3) -2,(300 div 3) -2),image.Canvas,rect(20+(400 div 3)*(i-1),20+(300 div 3)*(j-1),20+(400 div 3)*i,20+(300 div 3)*j));
  end;
end;

function TfrmMain.won:boolean;
var i,j:integer;
begin
  j:=0;
  for i:=1 to 8 do
    if grid[i]=i then
      j:=j+1;
  if j>=8 then
    result:=true
  else
    result:=false;
end;

procedure TfrmMain.win;
begin
  if won then
  begin
  swfPlayer.Visible:=true;
  swfPlayer.Enabled:=true;
  swfPlayer.Movie:=ExtractfilePath(Application.ExeName)+'pic\win.swf';
  swfPlayer.Play;
  end;
end;
procedure TfrmMain.jsClick(Sender: TObject);
begin
  swfPlayer.Stop;
  {swfPlayer.Visible:=true;
  swfPlayer.Movie:=ExtractfilePath(Application.ExeName)+'pic\win.swf';
  swfPlayer.Enabled:=true;
  swfPlayer.Play;}
  image.Canvas.StretchDraw(rect(20,20,420,320),bgb);
  swfPlayer.Visible:=false;
end;
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_F12 then
  begin
  swfPlayer.Visible:=true;
  swfPlayer.Movie:=ExtractfilePath(Application.ExeName)+'pic\win.swf';
  swfPlayer.Enabled:=true;
  swfPlayer.Play;
  end;
end;

end.