rei_21.pas

Delphi经典游戏程序设计40例.pdf 中国铁道出版社出版 含源码

unit Rei_21;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ExtCtrls;

type
  TRei40_21 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Make3D(Mx, My, Md: Byte; Bmap: TBitmap);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
  public
    { Public 定义 }
  end;

const
  Yoko = 37;   //显示的横向图案数
  Tate = 27;   //显示的纵向图案数
  LW = 12;     //立体化时的基本幅度（点数）
  Ymax = 14;   //横向图像数-1
  Tmax = 14;   //纵向图像-1

var
  Rei40_21: TRei40_21;
  //  定义并定义图像数组
  Lmap: array[0..Ymax, 0..Tmax] of Byte = (
    ($00,$01,$01,$00,$00,$00,$00,$01,$00,$00,$00,$00,$01,$00,$00),
    ($00,$00,$01,$00,$00,$00,$00,$01,$00,$01,$01,$00,$01,$00,$00),
    ($00,$01,$01,$00,$00,$00,$00,$01,$00,$00,$00,$00,$01,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$01,$00,$01,$01,$00,$00,$00,$00),
    ($01,$01,$01,$00,$00,$00,$00,$01,$00,$00,$00,$00,$01,$00,$00),
    ($00,$00,$00,$00,$00,$00,$00,$01,$00,$01,$01,$00,$00,$01,$01),
    ($00,$01,$00,$01,$01,$01,$01,$01,$00,$00,$01,$01,$00,$00,$00),
    ($00,$01,$00,$00,$00,$00,$00,$01,$01,$00,$01,$00,$01,$01,$00),
    ($00,$01,$01,$01,$00,$01,$00,$00,$00,$00,$00,$00,$00,$01,$00),
    ($00,$01,$00,$00,$00,$01,$00,$01,$01,$01,$01,$01,$00,$01,$00),
    ($00,$00,$00,$01,$00,$01,$00,$00,$00,$00,$00,$01,$00,$00,$00),
    ($00,$01,$01,$01,$00,$01,$00,$01,$00,$01,$00,$01,$00,$01,$01),
    ($00,$01,$00,$00,$00,$01,$00,$00,$00,$01,$00,$00,$00,$00,$00),
    ($00,$01,$00,$01,$00,$01,$00,$01,$00,$01,$00,$01,$01,$01,$00),
    ($00,$00,$00,$01,$00,$00,$00,$00,$00,$01,$00,$00,$00,$00,$00)
   );
  Dmap: array[0..4, 0..4] of Byte;
  //  定义线条3D用的点阵图
  Back_Bmap: TBitmap;
  //  定义各种变量（Byte类型、TRect类型）
  LX, LY, Dir: Byte;
  Rect_B, Rect_M: TRect;

implementation

{$R *.DFM}

procedure TRei40_21.FormCreate(Sender: TObject);
begin
  //  设定Form属性
  Rei40_21.Height := 480;
  Rei40_21.Width := 640;
  Button1.Height := 25;
  Button1.Left := 603;
  Button1.Top := 16;
  Button1.Width := 25;
  Button2.Height := 25;
  Button2.Left := 603;
  Button2.Top := 56;
  Button2.Width := 25;
  Button3.Height := 25;
  Button3.Left := 603;
  Button3.Top := 96;
  Button3.Width := 25;
  //  储存线条3D用的点阵图
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := 30 * LW;
  Back_Bmap.Height := 30 * LW;
  //  变量的初始设定
  LX := 1;
  LY := 1;
  Dir := 1;
end;

procedure TRei40_21.Timer1Timer(Sender: TObject);
begin
  //  如果可以移动，便改变座标
  if Dir > 15 then
  begin
    Dir := Dir and 15;
    case Dir of
      0: if (LX + 1 <= Ymax) and (Lmap[LX + 1, LY] and 1 = 0) then
        LX := LX + 1;
      1: if (LY - 1 >= 0) and (Lmap[LX, LY - 1] and 1 = 0) then
        LY := LY - 1;
      2: if (LX - 1 >= 0) and (Lmap[LX - 1, LY] and 1 = 0) then
        LX := LX - 1;
      3: if (LY + 1 <= Tmax) and (Lmap[LX, LY + 1] and 1 = 0) then
        LY := LY + 1;
    end;
  end;
  //  立体化显示
  Make3D(LX, LY, Dir, Back_Bmap);
  Back_Bmap.Canvas.CopyMode := cmSrcCopy;
  Rei40_21.Canvas.Draw(16, 16, Back_Bmap);
end;

procedure TRei40_21.Make3D(Mx, My, Md: Byte; Bmap: TBitmap);
var
  //  定义局部变量
  X, Y: ShortInt;
begin
  //  制作3D线条的对象图像Dmap
  for X := 0 to 4 do
    for Y:= 0 to 4 do
      Dmap[X, Y] := 1;
  case Md of
    0: begin
      for X := 4 downto 0 do
        for Y := -2 to 2 do
          if (Mx + X <= Ymax) and (My + Y >= 0) and (My + Y <= Tmax) then
            Dmap[Y + 2, 4 - X] := Lmap[Mx + X, My + Y];
    end;
    1: begin
      for Y := -4 to 0 do
        for X := -2 to 2 do
          if (My + Y >= 0) and (Mx + X >= 0) and (Mx + X <= Ymax) then
            Dmap[X + 2, Y + 4] := Lmap[Mx + X, My + Y];
    end;
    2: begin
      for X := -4 to 0 do
        for Y := 2 downto -2 do
          if (Mx + X >= 0) and (My + Y >= 0) and (My + Y <= Tmax) then
            Dmap[2 - Y, 4 + X] := Lmap[Mx +X , My + Y];
    end;
    3: begin
      for Y := 4 downto 0 do
        for X := 2 downto -2 do
          if (My + Y <= Ymax) and (Mx + X >= 0) and (Mx + X <= Ymax) then
            Dmap[2 - X, 4 - Y] := Lmap[Mx + X, My + Y];
    end;
  end;
  //  将线条3D绘制在点阵图上
  Bmap.Canvas.Pen.Width := 2;
  Bmap.Canvas.Pen.Color := clWhite;
  Bmap.Canvas.Brush.Color := clBlack;
  Bmap.Canvas.Rectangle(0, 0, Bmap.Width, Bmap.Height);
  for X := 0 to 4 do
    if (Dmap[X, 0] and 1) = 1 then
      Bmap.Canvas.Rectangle(X * 6 * LW, 12 * LW, (X * 6 + 6) * LW, 18 * LW);
  if (Dmap[0, 1] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(0 , 10 * LW), Point(0, 20 * LW),
      Point(6 * LW, 18 * LW), Point(6 * LW, 12 * LW)]);
  if (Dmap[1, 1] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(10 * LW, 10 * LW), Point(10 * LW, 20 * LW),
      Point(12 * LW, 18 * LW), Point(12 * LW, 12 * LW)]);
  if (Dmap[3, 1] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(20 * LW, 10 * LW), Point(20 * LW, 20 * LW),
      Point(18 * LW, 18 * LW), Point(18 * LW, 12 * LW)]);
  if (Dmap[4, 1] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(30 * LW, 10 * LW), Point(30 * LW, 20 * LW),
      Point(24 * LW, 18 * LW), Point(24 * LW, 12 * LW)]);
  for X := 1 to 3 do
    if (Dmap[X, 1] and 1) = 1 then
      Bmap.Canvas.Rectangle((X - 1) * 10 * LW, 10 * LW, X * 10 * LW, 20 * LW);
  if (Dmap[1, 2] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(7 * LW, 7 * LW), Point(7 * LW, 23 * LW),
      Point(10 * LW, 20 * LW), Point(10 * LW, 10 * LW)]);
  if (Dmap[3, 2] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(23 * LW, 7 * LW), Point(23 * LW, 23 * LW),
      Point(20 * LW, 20 * LW), Point(20 * LW, 10 * LW)]);
  for X := 1 to 3 do
    if (Dmap[X, 2] and 1) = 1 then
      Bmap.Canvas.Rectangle(((X - 1) * 16 - 9) * LW, 7 * LW,
        ((X - 1) * 16 + 7) * LW, 23 * LW);
  if (Dmap[1, 3] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(3 * LW, 3 * LW), Point(3 * LW, 27 * LW),
      Point(7 * LW, 23 * LW), Point(7 * LW, 7 * LW)]);
  if (Dmap[3, 3] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(27 * LW, 3 * LW), Point(27 * LW, 27 * LW),
      Point(23 * LW, 23 * LW), Point(23 * LW, 7 * LW)]);
  for X := 1 to 3 do
    if (Dmap[X, 3] and 1) = 1 then
      Bmap.Canvas.Rectangle(((X - 1) * 24 - 21) * LW, 3 * LW,
        ((X - 1) * 24 + 3) * LW, 27 * LW);
  if (Dmap[1, 4] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(0, 0), Point(0, 30 * LW),
      Point(3 * LW, 27 * LW), Point(3 * LW, 3 * LW)]);
  if (Dmap[3, 4] and 1) = 1 then
    Bmap.Canvas.Polygon([Point(30 * LW, 0), Point(30 * LW, 30 * LW),
      Point(27 * LW, 27 * LW), Point(27 * LW, 3 * LW)]);
  Bmap.Canvas.PolyLine([Point(1, 1), Point(1, Bmap.Height - 1),
    Point(Bmap.Width - 1, Bmap.Height - 1), Point(Bmap.Width - 1, 1),
      Point(1, 1)]);
end;

procedure TRei40_21.Button1Click(Sender: TObject);
begin
  //  移动指定
  Dir := Dir or 16;
end;

procedure TRei40_21.Button2Click(Sender: TObject);
begin
  //  改为向左转
  Dir := (Dir + 1) and 3;
end;

procedure TRei40_21.Button3Click(Sender: TObject);
begin
  //  改为向右转
  Dir := (Dir + 3) and 3;
end;

procedure TRei40_21.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将线条3D用的点阵图释放掉
  Back_Bmap.Free;
end;

end.