rei_10.pas

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

unit Rei_10;

interface

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

type
  //  定义记录类型
  TPatDt = record
    Used: Byte;
    Sban: Byte;
    Xpos: Integer;
    Ypos: Integer;
    Smov: Byte;
    Sadd: Byte;
  end;

  TRei40_10 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure YScroll;
    procedure ChrDi(Sban: Byte; X1, Y1: Integer; 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;          //全面显示（不要重叠显示）的图案数
  MaxMap = 370;         //图案的最大数
  ScDot = 2;            //卷动的点数(1,2,4,8,16)

var
  Rei40_10: TRei40_10;
  //  定义载入用、去除模版用、背景用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义数组、变量（Byte类型、Word类型、TRect类型、数组类型）
  P, PX, PY, n: Byte;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  ChPon: array[0..9] of TPatDt;
  Yplus:array[0..20] of Byte = (
    0, 10, 19, 27, 34, 40, 45, 49, 52, 54, 55,
    55, 54, 52, 49, 45, 40, 34, 27, 19, 10
  );
  Smap: array[0..(Yoko - 1), 0..(MaxMap - 1)] of Byte;
  //  图案点、卷动点与绘制点的定义与初始设定
  Mpoint: Word = 0;
  Spoint: Integer = 16;
  Ypoint: Integer = 0;
  //  复合图案数组
  Spr00: array[0..5] of Byte = (2, 2, 24, 25, 26, 27);
  Spr01: array[0..5] of Byte = (2, 2, 28, 29, 30, 31);
  Spr02: array[0..5] of Byte = (2, 2, 32, 33, 48, 49);

implementation

{$R *.DFM}

procedure TRei40_10.FormCreate(Sender: TObject);
var
  X, Cn: Byte;
  Y: Word;
begin
  //  设定Form属性
  Rei40_10.Height := 480;
  Rei40_10.Width := 640;
  //  载入图案
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  //  储存去除用点阵图
  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);
  //  制作卷动背景用数组数据
  for Y := 0 to (MaxMap - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      if (X > (Y mod Yoko)) and ((X + (Y mod Yoko) + 1) < Yoko) then
        P := 15
      else if (X < (Y mod Yoko)) and ((X + (Y mod Yoko) + 1) > Yoko) then
        P := 15
      else if Y < Yoko then
        P := 12
      else if Y < Yoko * 2 then
        P := 13
      else if Y < Yoko * 3 then
        P := 14
      else if Y < Yoko * 4 then
        P := 2
      else if Y < Yoko * 5 then
        P := 14
      else if Y < Yoko * 6 then
        P := 13
      else if Y < Yoko * 7 then
        P := 12
      else if Y < Yoko * 8 then
        P := 13
      else if Y < Yoko * 9 then
        P := 14
      else
        P := 15;
      Smap[X, Y] := P;
    end;
  //  储存背景绘制用点阵图
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := DYoko;
  Back_Bmap.Height := DTate + 16;
  //  将初始背景绘制至Back_Bmap
  for Y := 0 to Tate do
  begin
    for X := 0 to (Yoko - 1) do
      PatDi(Smap[X, Y], X * 16, (Tate - Y) * 16, Back_Bmap);
    Mpoint := Mpoint + 1;
  end;
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  //  初始设定角色数组
  for Cn := 0 to 4 do
  begin
    ChPon[Cn * 2].Used := 1;
    ChPon[Cn * 2].Sban := 0;
    ChPon[Cn * 2].Xpos := Cn * 90 + 100;
    ChPon[Cn * 2].Ypos := (Cn and 1) * 100 + 200;
    ChPon[Cn * 2].Smov := 0;
    ChPon[Cn * 2].Sadd := 0;
    ChPon[Cn * 2 + 1].Used := 1;
    ChPon[Cn * 2 + 1].Sban := (Cn and 1) + 1;
    ChPon[Cn * 2 + 1].Xpos := Cn * 90 + 100;
    ChPon[Cn * 2 + 1].Ypos := 0;
    ChPon[Cn * 2 + 1].Smov := 1;
    ChPon[Cn * 2 + 1].Sadd := Random(21);
  end;
end;

procedure TRei40_10.Timer1Timer(Sender: TObject);
var
  Cn: Byte;
begin
  //  将卷动背景与所有的角色绘制在Make_Bmap上
  for Cn := 0 to 4 do
    if (ChPon[Cn * 2 + 1].Used = 1) and (ChPon[Cn * 2 + 1].Smov = 1) then
    begin
      ChPon[Cn * 2 + 1].Ypos :=
        ChPon[Cn * 2].Ypos - Yplus[ChPon[Cn * 2 + 1].Sadd];
      ChPon[Cn * 2 + 1].Sadd := ChPon[Cn * 2 + 1].Sadd + 1;
      if ChPon[Cn * 2 + 1].Sadd > 20 then
        ChPon[Cn * 2 + 1].Sadd := 0;
    end;
  YScroll;
  for Cn := 0 to 9 do
    if ChPon[Cn].Used = 1 then
      ChrDi(ChPon[Cn].Sban, ChPon[Cn].Xpos, ChPon[Cn].Ypos, Make_Bmap);
  //  显示在Form上
  Rei40_10.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_10.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_10.YScroll;
var
  X: Byte;
begin
  //  将背景分割并绘制在指定的点阵图上
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  if Spoint <= 16 then
  begin
    Rect_B := Rect(0, Spoint, DYoko, DTate + Spoint);
    Rect_D := Rect(16, 16, DYoko + 16, DTate + 16);
    Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  end
  else begin
    Rect_B := Rect(0, Spoint, DYoko, DTate + 16);
    Rect_D := Rect(16, 16, DYoko + 16, DTate + 32 - Spoint);
    Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
    Rect_B := Rect(0, 0, DYoko, Spoint - 16);
    Rect_D := Rect(16, DTate + 32 - Spoint, DYoko + 16, DTate + 16);
    Make_Bmap.Canvas.CopyRect(Rect_D, Back_Bmap.Canvas, Rect_B);
  end;
  //  卷动16点後新绘制1列横向点阵图
  Spoint := Spoint - ScDot;
  Ypoint := Ypoint - ScDot;
  if Spoint < 0 then
    Spoint := DTate + 16 - ScDot;
  if Ypoint < 0 then
    Ypoint := DTate + 16 - ScDot;
  if (Spoint and 15) = 0 then
  begin
    for X := 0 to (Yoko - 1) do
      PatDi(Smap[X, Mpoint], X * 16, Ypoint, Back_Bmap);
    Mpoint := Mpoint + 1;
    if Mpoint = MaxMap then
      Mpoint := 0;
  end;
end;

procedure TRei40_10.ChrDi(Sban: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定的复合图案绘制至指定点阵图上（重叠显示适用）
  case Sban of
    0: SbanDi(Spr00, X1 + 16, Y1 + 16, Bmap);
    1: SbanDi(Spr01, X1 + 16, Y1 + 16, Bmap);
    2: SbanDi(Spr02, X1 + 16, Y1 + 16, Bmap);
  end;
end;

procedure TRei40_10.SbanDi(Sary: array of Byte; X1, Y1: Integer;
  Bmap: TBitmap);
var
  X: Byte;
  Y: Word;
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_10.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_10.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、背景用、圆形模版图样用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Back_Bmap.Free;
  Make_Bmap.Free;
end;

end.