rei_06.pas

delhpi经典游戏程序设计40例,大家不防下载看看.源码全在项目文件里!

unit Rei_06;

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;
  end;

  TRei40_06 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private  }
    procedure ChrDi(Used: Byte; 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);
    procedure ChrCl(Used: Byte; Sban: Byte; X1, Y1: Integer; Bmap: TBitmap);
    procedure SbanCl(Xdot, Ydot: Word; X1, Y1: Integer; Bmap: TBitmap);
    procedure NewXY(var Mnum: Byte; var X1, Y1: Integer);
  public
    { Public  }
  end;

const
  Yoko = 37;            //显示的横向图案数
  Tate = 27;            //显示的纵向图案数
  DYoko = Yoko * 16;    //显示的横向点数
  DTate = Tate * 16;    //显示的纵向点数
  PtFull = 16;          //全面显示（不要重叠显示）的图案数

var
  Rei40_06: TRei40_06;
  //  定义载入用、去除模版用、背景用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义背景用数组、各种变量（Byte类型、Trect类型与TpatDt类型）
  BkImage: array[0..36, 0..26] of Byte;
  P, PX, PY, n: Byte;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  Chr0, Chr1, Chr2: TPatDt;
  //  复合图案的数组
  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_06.FormCreate(Sender: TObject);
var
  //  宣告区域变量
  X, Y: Byte;
begin
  //  设定Form属性
  Rei40_06.Height := 480;
  Rei40_06.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 (Tate - 1) do
    for X := 0 to (Yoko - 1) do
    begin
      if (X < 14) or (X > 22) or (Y < 9) or (Y > 17) then
        P := 14
      else if (X < 16) or (X > 20) or (Y < 11) or (Y > 15) then
        P := 12
      else
        P := 7;
      BkImage[X, Y] := P;
    end;
  //  储存背景用点阵图
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := DYoko + 32;
  Back_Bmap.Height := DTate + 32;
  //  将背景绘制至Back_Bmap上
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
      PatDi(BkImage[X, Y], X * 16 + 16, Y * 16 + 16, Back_Bmap);
  //  储存绘制用点阵图并复制背景(Back_Bmap)
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Back_Bmap.Width;
  Make_Bmap.Height := Back_Bmap.Height;
  Make_Bmap.Canvas.Draw(0, 0, Back_Bmap);
  //  设定角色的初始值
  with Chr0 do
  begin
    Used := 1;
    Sban := 0;
    Xpos := 279;
    Ypos := 199;
    Smov := 0;
  end;
  with Chr1 do
  begin
    Used := 1;
    Sban := 1;
    Xpos := 279;
    Ypos := 199;
    Smov := 1;
  end;
  with Chr2 do
  begin
    Used := 1;
    Sban := 2;
    Xpos := 279;
    Ypos := 199;
    Smov := 2;
  end;
end;

procedure TRei40_06.Timer1Timer(Sender: TObject);
begin
  //  将所有的角色绘制至Make_Bmap
  ChrDi(Chr0.Used, Chr0.Sban, Chr0.Xpos, Chr0.Ypos, Make_Bmap);
  ChrDi(Chr1.Used, Chr1.Sban, Chr1.Xpos, Chr1.Ypos, Make_Bmap);
  ChrDi(Chr2.Used, Chr2.Sban, Chr2.Xpos, Chr2.Ypos, Make_Bmap);
  //  将绘制用点阵图显示在Form上
  Rei40_06.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_06.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
  //  以背景去除所有的角色
  ChrCl(Chr0.Used, Chr0.Sban, Chr0.Xpos, Chr0.Ypos, Make_Bmap);
  ChrCl(Chr1.Used, Chr1.Sban, Chr1.Xpos, Chr1.Ypos, Make_Bmap);
  ChrCl(Chr2.Used, Chr2.Sban, Chr2.Xpos, Chr2.Ypos, Make_Bmap);
end;

procedure TRei40_06.Timer2Timer(Sender: TObject);
begin
  //  更改角色的座标
  NewXY(Chr0.Smov, Chr0.Xpos, Chr0.Ypos);
  NewXY(Chr1.Smov, Chr1.Xpos, Chr1.Ypos);
  NewXY(Chr2.Smov, Chr2.Xpos, Chr2.Ypos);
end;

procedure TRei40_06.NewXY(var Mnum: Byte; var X1, Y1: Integer);
begin
  //  依照移动编号更改座标
  case Mnum of
    1: begin
      X1 := X1 + 1;
      if X1 > DYoko then
      begin
        X1 := 279;
        Mnum := (Mnum and 3) + 1;
      end;
    end;
    2: begin
      Y1 := Y1 - 2;
      if Y1 < -31 then
      begin
        Y1 := 199;
        Mnum := (Mnum and 3) + 1;
      end;
    end;
    3: begin
      X1 := X1 - 3;
      if X1 < -31 then
      begin
        X1 := 279;
        Mnum := (Mnum and 3) + 1;
      end;
    end;
    4: begin
      Y1 := Y1 + 4;
      if Y1 > DTate then
      begin
        Y1 := 199;
        Mnum := (Mnum and 3) + 1;
      end;
    end;
  end;
end;

procedure TRei40_06.ChrDi(Used: Byte; Sban: Byte; X1, Y1: Integer;
  Bmap: TBitmap);
begin
  //  将被指定显示的角色绘制至指定的点阵图上（重叠显示适用）
  if Used = 1 then
  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;
end;

procedure TRei40_06.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_06.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_06.ChrCl(Used: Byte; Sban: Byte; X1, Y1: Integer;
  Bmap: TBitmap);
begin
  //  以背景去除编号指定的复合图案
  if Used = 1 then
    case Sban of
      0: SbanCl(Spr00[0] * 16, Spr00[1] * 16, X1 + 16, Y1 + 16, Bmap);
      1: SbanCl(Spr01[0] * 16, Spr01[1] * 16, X1 + 16, Y1 + 16, Bmap);
      2: SbanCl(Spr02[0] * 16, Spr02[1] * 16, X1 + 16, Y1 + 16, Bmap);
    end;
end;

procedure TRei40_06.SbanCl(Xdot, Ydot: Word; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定大小的背景复制至点阵图
  if X1 < 0 then
  begin
    Xdot := Xdot + X1;
    X1 := 0;
  end;
  if Y1 < 0 then
  begin
    Ydot := Ydot + Y1;
    Y1 := 0;
  end;
  if (X1 < DYoko + 32) and (Y1 < DTate + 32) then
  begin
    if (X1 + Xdot) >= (DYoko + 32) then
      Xdot := DYoko + 32 - X1;
    if (Y1 + Ydot) >= (DTate + 32) then
      Ydot := DTate + 32 - Y1;
    Bmap.Canvas.CopyMode := cmSrcCopy;
    Rect_B := Rect(X1, Y1, X1 + Xdot, Y1 + Ydot);
    Bmap.Canvas.CopyRect(Rect_B, Back_Bmap.Canvas, Rect_B);
  end;
end;

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

end.