rei_08.pas

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

unit Rei_08;

interface

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

type
  TRei40_08 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private  }
    procedure ScrolX(var SX: Word; Y1, Y2: Word; Bmap: TBitmap);
    procedure SbanDi(Sary: array of Byte; X1, Y1: Integer; Bmap: TBitmap);
    procedure PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
  public
    { Public  }
  end;

const
  Yoko = 37;            //显示的横向图案数
  Tate = 27;            //显示的纵向图案数
  DYoko = Yoko * 16;    //显示的横向点数
  DTate = Tate * 16;    //显示的纵向点数
  PtFull = 16;          //全面显示（不要重叠显示）的图案数
  SY1 = 160;            //卷动区块(1)的Y座标
  SY2 = 260;            //卷动区块(2)的Y座标
  SY3 = 340;            //卷动区块(3)的Y座标

var
  Rei40_08: TRei40_08;
  //  定义载入用、去除模版用、背景用与绘制用的点阵图
  Back_Bmap: TBitmap;
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Make_Bmap: TBitmap;
 //  定义各种变量（Byte类型、Word类型、Trect类型）
  PX, PY: Byte;
  n, SX1, SX2, SX3, SX4: Word;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  //  定义复合图案用的数组
  Spr00: array[0..(31 * 11 + 1)] of Byte = (
    31, 11,
    12,12,12,12,12,12,12, 0,12,12,12, 0,12,12,12,12,12,12,12,
      0,12, 0, 0, 0, 0, 0,12,12,12,12,12,
    12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,12,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12,12,12,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0,12, 0,12, 0, 0, 0,12,
    0, 0,12,12,12, 0, 0, 0,12,12,12, 0, 0, 0,12,12,12, 0, 0,
      0,12,12,12,12,12, 0,12,12,12,12,12
  );

implementation

{$R *.DFM}

procedure TRei40_08.FormCreate(Sender: TObject);
begin
  //  设定Form属性
  Rei40_08.Height := 480;
  Rei40_08.Width := 640;
  //  载入背景图案
  Back_Bmap := TBitmap.Create;
  Back_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Back_Sample.bmp');
  //  载入图案
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  Load_Bmap.Palette := Back_Bmap.Palette;
  //  储存去除用点阵图
  Xpat_Bmap := TBitmap.Create;
  Xpat_Bmap.Width := 256;
  Xpat_Bmap.Height := 256;
  //  制作去除用点阵图
  Rect_L := Rect(0, 0, 256, 256);
  Xpat_Bmap.Canvas.CopyMode := cmSrcCopy;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  Xpat_Bmap.Canvas.Brush.Color := clBlack;
  Xpat_Bmap.Canvas.BrushCopy(Rect_L, Load_Bmap, Rect_L, clWhite);
  Xpat_Bmap.Canvas.CopyMode := cmMergePaint;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  //  储存绘制用点阵图并复制背景(Back_Bmap)
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  Rect_B := Rect(0, 0, DYoko, DTate);
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Make_Bmap.Canvas.CopyRect(Rect_M, Back_Bmap.Canvas, Rect_B);
  //  初始设定卷动点
  SX1 := 0;
  SX2 := 0;
  SX3 := 0;
end;

procedure TRei40_08.Timer1Timer(Sender: TObject);
begin
  //  虚拟多重卷动
  SX1 := SX1 + 4;
  SX2 := SX2 + 2;
  SX3 := SX3 + 1;
  ScrolX(SX2, SY1, SY2, Make_Bmap);
  ScrolX(SX1, 0, SY1, Make_Bmap);
  ScrolX(SX3, SY2, SY3, Make_Bmap);
  SbanDi(Spr00, 66, 66, Make_Bmap);
  //  将绘制用点阵图显示在Form上
  Rei40_08.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_08.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_08.ScrolX(var SX: Word; Y1, Y2: Word; Bmap: TBitmap);
begin
  //  将背景按指定的点数做旋转处理并绘制至指定的点阵图
  Rect_B := Rect(0, Y1, SX, Y2);
  Rect_D := Rect(DYoko - SX + 16, Y1 + 16, DYoko + 16, Y2 + 16);
  Bmap.Canvas.CopyMode := cmSrcCopy;
  Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  if SX = DYoko then
    SX := 0
  else begin
    Rect_B := Rect(SX, Y1, DYoko, Y2);
    Rect_D := Rect(16, Y1 + 16, DYoko - SX + 16, Y2 + 16);
    Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  end;
end;

procedure TRei40_08.SbanDi(Sary: array of Byte; X1, Y1: Integer;
  Bmap: TBitmap);
var
  X, Y: Byte;
begin
  //  将数组指定的复合图案绘制至指定的点阵图上（重叠显示适用）
  n := 2;
  for Y := 0 to (Sary[1] - 1) do
    for X := 0 to (Sary[0] - 1) do
    begin
      if (X1 + X * 16 >= 0) and (X1 + X * 16 <= DYoko + 16) and
        (Y1 + Y * 16 >= 0) and (Y1 + Y * 16 <= DTate + 16) then
          PatDi(Sary[n], X1 + X * 16, Y1 + Y * 16, Bmap);
      n := n + 1;
    end;
end;

procedure TRei40_08.PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定图案绘制至指定点阵图的指定位置上（重叠显示适用）
  PX := (Pnum and $F) * 16;
  PY := Pnum and $F0;
  Rect_L := Rect(PX, PY, PX + 16, PY + 16);
  Rect_D := Rect(X1, Y1, X1 + 16, Y1 + 16);
  if Pnum <> 0 then
    if Pnum >= PtFull then
    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(Rect_D, Xpat_Bmap.Canvas, Rect_L);
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end
    else begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end;
end;

procedure TRei40_08.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、背景用与绘制用的点阵图释放掉
  Back_Bmap.Free;
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Make_Bmap.Free;
end;

end.