rei_04.pas

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

unit Rei_04;

interface

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

type
  TRei40_04 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private }
  public
    { Public  }
  end;

const
  Yoko = 39;                    //绘制用点阵图的横向图案数
  Tate = 29;                    //绘制用点阵图的直立图案数
  GmenX = (Yoko - 2) * 16;      //显示画面用的横向点数
  GmenY = (Tate - 2) * 16;      //显示画面用的直立点数
  Mdot = 2;                     //卷动点数

var
  Rei40_04: TRei40_04;
  //   定义载入用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //   定义图像用数组与各种变量（Byte类型、Trect类型）
  Bigmap: array[0..255, 0..255] of Byte;
  P, PX, PY: Byte;
  MapX, MapY, DX, DY: Byte;
  Dir, NextD: Byte;
  Rect_L, Rect_M, Rect_C, Rect_G: TRect;

implementation

{$R *.DFM}

procedure TRei40_04.FormCreate(Sender: TObject);
var
  X, Y: Byte;
begin
  //   设定表格属性
  Rei40_04.Height := 480;
  Rei40_04.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;
  Button4.Height := 25;
  Button4.Left := 603;
  Button4.Top := 136;
  Button4.Width := 25;
  Button5.Height := 25;
  Button5.Left := 603;
  Button5.Top := 192;
  Button5.Width := 25;
  //   载入图形文件
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  //   制作图像用测试数组资料
  for Y := 0 to 255 do
    for X := 0 to 255 do
    begin
      if (X = 0) or (X = 255) or (Y = 0) or (Y = 255) then
        P := 2
      else if (X = 128) and (Y = 128) then
        P := 2
      else if (X < 5) or (X > 250) or (Y < 5) or (Y > 250) then
        P := 12
      else if (X < 15) or (X > 235) or (Y < 15) or (Y > 235) then
        P := 15
      else if ((X < 138) and (X > 118)) and ((Y < 138) and (Y > 118)) then
        P := 15
      else if ((X < 148) and (X > 108)) and ((Y < 148) and (Y > 108)) then
        P := 14
      else if (X * Y < 25000) and (X * Y > 23000) then
        P := 13
      else if (X * Y < 28000) and (X * Y > 20000) then
        P := 12
      else if (X * Y < 31000) and (X * Y > 17000) then
        P := 15
      else if (X * Y < 34000) and (X * Y > 14000) then
        P := 13
      else if (X * Y < 37000) and (X * Y > 11000) then
        P := 14
      else if (X * Y < 40000) and (X * Y > 8000) then
        P := 12
      else if (X * Y < 43000) and (X * Y > 6000) then
        P := 15
      else if (X * Y < 47000) and (X * Y > 4000) then
        P := 14
      else if (X * Y < 50000) and (X * Y > 2000) then
        P := 13
      else if (X * Y < 53000) and (X * Y > 1000) then
        P := 12
      else
        P := 2;
      Bigmap[X, Y] := P;
    end;
  //   储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Yoko * 16;
  Make_Bmap.Height := Tate * 16;
  //   绘制用初始图像座标的初值设定
  MapX := 109;
  MapY := 114;
  //   显示用初始位移的初值设定
  DX := 16;
  DY := 16;
  //   卷动方向（现在／下次）的初值设定
  Dir := 0;
  NextD := 0;
  //   将初始图像绘制於Make_Bmap
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      P := Bigmap[MapX + X, MapY + Y];
      PX := (P and $F) * 16;
      PY := P and $F0;
      Rect_L := Rect(PX, PY, PX + 16, PY + 16);
      Rect_M := Rect(X * 16, Y * 16, X * 16 + 16, Y * 16 + 16);
      Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
    end;
end;

procedure TRei40_04.Timer1Timer(Sender: TObject);
var
  X, Y: Byte;
begin
  //   变更各个方向的位移值
  case Dir of
    1: DY := DY - Mdot;
    2: DY := DY + Mdot;
    3: DX := DX - Mdot;
    4: DX := DX + Mdot;
  end;
  //   往各方式卷动并显示
  Rei40_04.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(DX, DY, GmenX + DX, GmenY + DY);
  Rect_G := Rect(0, 0, GmenX, GmenY);
  Rei40_04.Canvas.CopyRect(Rect_G, Make_Bmap.Canvas, Rect_M);
  //   如卷动至图像的边界时，则绘制新的图像
  if ((DX and 31) = 0) or ((DY and 31) = 0) then
  begin
    Make_Bmap.Canvas.CopyMode := cmSrcCopy;
    case Dir of
      //   图像的上限
      1: begin
        Rect_M := Rect(0, 0, GmenX + 32, GmenY + 16);
        Rect_C := Rect(0, 16, GmenX + 32, GmenY + 32);
        Make_Bmap.Canvas.CopyRect(Rect_C, Make_Bmap.Canvas, Rect_M);
        MapY := MapY - 1;
        for X := 0 to (Yoko - 1) do
        begin
          P := Bigmap[((MapX + X) and $FF), MapY];
          PX := (P and $F) * 16;
          PY := P and $F0;
          Rect_L := Rect(PX, PY, PX + 16, PY + 16);
          Rect_M := Rect(X * 16, 0, X * 16 + 16, 16);
          Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
        end;
      end;
      //   图像的下限
      2: begin
        Rect_M := Rect(0, 16, GmenX + 32, GmenY + 32);
        Rect_C := Rect(0, 0, GmenX + 32, GmenY + 16);
        Make_Bmap.Canvas.CopyRect(Rect_C, Make_Bmap.Canvas, Rect_M);
        MapY := MapY + 1;
        for X := 0 to (Yoko - 1) do
        begin
          P := Bigmap[((MapX + X) and $FF), ((MapY + Tate - 1) and $FF)];
          PX := (P and $F) * 16;
          PY := P and $F0;
          Rect_L := Rect(PX, PY, PX + 16, PY + 16);
          Rect_M := Rect(X * 16, GmenY + 16, X * 16 + 16, GmenY + 32);
          Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
        end;
      end;
      //   图像的左限
      3: begin
        Rect_M := Rect(0, 0, GmenX + 16, GmenY + 32);
        Rect_C := Rect(16, 0, GmenX + 32, GmenY + 32);
        Make_Bmap.Canvas.CopyRect(Rect_C, Make_Bmap.Canvas, Rect_M);
        MapX := MapX - 1;
        for Y := 0 to (Tate - 1) do
        begin
          P := Bigmap[MapX, ((MapY + Y) and $FF)];
          PX := (P and $F) * 16;
          PY := P and $F0;
          Rect_L := Rect(PX, PY, PX + 16, PY + 16);
          Rect_M := Rect(0, Y * 16, 16, Y * 16 + 16);
          Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
        end;
      end;
      //   图像的右限
      4: begin
        Rect_M := Rect(16, 0, GmenX + 32, GmenY + 32);
        Rect_G := Rect(0, 0, GmenX + 16, GmenY + 32);
        Make_Bmap.Canvas.CopyRect(Rect_G, Make_Bmap.Canvas, Rect_M);
        MapX := MapX + 1;
        for Y := 0 to (Tate - 1) do
        begin
          P := Bigmap[((MapX + Yoko - 1) and $FF), ((MapY + Y) and $FF)];
          PX := (P and $F) * 16;
          PY := P and $F0;
          Rect_L := Rect(PX, PY, PX + 16, PY + 16);
          Rect_M := Rect(GmenX + 16, Y * 16, GmenX + 32, Y * 16 + 16);
          Make_Bmap.Canvas.CopyRect(Rect_M, Load_Bmap.Canvas, Rect_L);
        end;
      end;
    end;
    //   重新设定卷动方向与位移
    Dir := NextD;
    DX := 16;
    DY := 16;
  end;
end;

procedure TRei40_04.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //   按下[上]键时
  NextD := 1;
  if Dir = 0 then
    Dir := 1;
end;

procedure TRei40_04.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //   按下[下]钮时
  NextD := 2;
  if Dir = 0 then
    Dir := 2;
end;

procedure TRei40_04.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //   按下[左]钮时
  NextD := 3;
  if Dir = 0 then
    Dir := 3;
end;

procedure TRei40_04.Button4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //   按下[右]钮时
  NextD := 4;
  if Dir = 0 then
    Dir := 4;
end;

procedure TRei40_04.Button5MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //   按下[停]钮时
  NextD := 0;
end;

procedure TRei40_04.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //   释放载入用与绘制用的点阵图
  Load_Bmap.Free;
  Make_Bmap.Free;
end;

end.