rei_11.pas

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

unit Rei_11;

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;
    Scon: Byte;
  end;

  TRei40_11 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure LoReg(Sban: Byte; X1, Y1: Integer);
    procedure MiReg(Sban: Byte; X1, Y1: Integer);
    procedure HiReg(Sban: Byte; X1, Y1: Integer);
    Procedure DpSprite;
    Procedure ClSprite;
    procedure ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
      Bmap: TBitmap);
    procedure PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
    procedure ChrCl(Sban: Byte; X1, Y1: Integer; Bmap: TBitmap);
  public
    { Public 定义 }
  end;

const
  Yoko = 37;            //显示的横向图案数
  Tate = 27;            //显示的纵向图案数
  DYoko = Yoko * 16;    //显示的横向点数
  DTate = Tate * 16;    //显示的纵向点数
  PtFull = 16;          //全面显示（不要重叠显示）的图案数
  MaxSp = 6;            //本次使用的复合图案总数
  MaxChr = 12;          //本次登场的角色总数
  Mdots = 3;            //角色移动的点数

var
  Rei40_11: TRei40_11;
  //  定义载入用、去除模版用、背景用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte、Word、TRect、Integer、数组类型）
  P, PX, PY, Sn, Rn: Byte;
  Sc, Xdot, Ydot: Word;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  Y2: Integer;
  ChPon: array[0..255] of TPatDt;
  DipLo: array[0..(3 * 255)] of Integer;
  DipMi: array[0..(4 * 255)] of Integer;
  DipHi: array[0..(3 * 255)] of Integer;
  //  复合图案数组
  SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (
    2,2, 2,2, 2,2, 2,3, 3,3, 31,1
  );
  SpPon: array[0..(MaxSp - 1)] of Word;
  SpDat: array[0..57] of Byte = (
    24,25,26,27,
    28,29,30,31,
    32,33,48,49,
    64,65,80,81,96,97,
    0,19,0,19,0,19,0,19,0,
    16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,
    16,16,16,16,16,16,16,16,16,16,16,16,16,16,16
  );

implementation

{$R *.DFM}

procedure TRei40_11.FormCreate(Sender: TObject);
var
  //  定义局部变量
  X, Y, Cn, n: Byte;
begin
  //  设定Form属性
  Rei40_11.Height := 480;
  Rei40_11.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);
  //  零件贴图用指标数组的初始设定
  Sc := 0;
  for n := 0 to (MaxSp - 1) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + SpSiz[n * 2] * SpSiz[n * 2 + 1];
  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
    begin
      if (X = 0) or (Y = 0) or (X = Yoko - 1) or (Y = Tate - 1) then
        P := 7
      else
        P := 15;
      PatDi(P, X * 16 + 16, Y * 16 + 16, Back_Bmap);
    end;
  //  储存绘制用点阵图并复制背景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);
  //  角色用数组的初始设定
  for Cn := 0 to (MaxChr - 1) do
  begin
    ChPon[Cn].Used := 1;
    ChPon[Cn].Sban := Cn and 1 + 1;
    ChPon[Cn].Xpos := Random(528) + 32;
    ChPon[Cn].Ypos := Cn * 24 + 20;
    ChPon[Cn].Smov := Random(4);
    ChPon[Cn].Scon := Random(20) + 20;
  end;
  //  零件贴图登录的初始设定
  DipLo[0] := 0;
  DipMi[0] := 0;
  DipHi[0] := 0;
end;

procedure TRei40_11.Timer1Timer(Sender: TObject);
var
  //  定义局部变量
  Cn: Byte;
begin
  //  所有角色的动作管理与零件贴图显示的登录
  for Cn := 0 to (MaxChr - 1) do
    if ChPon[Cn].Used = 1 then
    begin
      ChPon[Cn].Scon := ChPon[Cn].Scon - 1;
      if ChPon[Cn].Scon = 0 then
      begin
        ChPon[Cn].Scon := Random(20) + 20;
        ChPon[Cn].Smov := Random(4);
      end;
      case ChPon[Cn].Smov of
        0: ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
        1: ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
        2: ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
        3: ChPon[Cn].Ypos := ChPon[Cn].Ypos - Mdots;
      end;
      if ChPon[Cn].Xpos < 17 then
      begin
        ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
        ChPon[Cn].Smov := 0;
      end
      else if ChPon[Cn].Xpos > DYoko - 49 then
      begin
        ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
        ChPon[Cn].Smov := 1;
      end
      else if ChPon[Cn].Ypos < 17 then
      begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
        ChPon[Cn].Smov := 2;
      end
      else if ChPon[Cn].Ypos > DTate - 49 then
      begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos - Mdots;
        ChPon[Cn].Smov := 3;
      end;
      MiReg(ChPon[Cn].Sban, ChPon[Cn].Xpos, ChPon[Cn].Ypos);
    end;
  //  其他零件贴图显示的登录
  MiReg(5, 3 * 16, 13 * 16);
  MiReg(3, 80, 11 * 16 - 6);
  MiReg(3, 200, 11 * 16 + 12);
  MiReg(3, 330, 11 * 16 - 8);
  MiReg(3, 480, 11 * 16 + 16);
  LoReg(0, 32, 32);
  LoReg(0, 32, 23 * 16);
  LoReg(0, 33 * 16, 32);
  LoReg(0, 33 * 16, 23 * 16);
  HiReg(4, 17 * 16, 12 * 16);
  //  零件贴图绘制～Form显示～去除零件贴图
  DpSprite;
  Rei40_11.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_11.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
  ClSprite;
end;

procedure TRei40_11.LoReg(Sban: Byte; X1, Y1: Integer);
begin
  //  零件贴图显示的登录(DipLo)
  Sn := DipLo[0];
  if Sn <> 255 then
  begin
    DipLo[Sn * 3 + 1] := Sban;
    DipLo[Sn * 3 + 2] := X1;
    DipLO[Sn * 3 + 3] := Y1;
    DipLo[0] := Sn + 1;
  end;
end;

procedure TRei40_11.MiReg(Sban: Byte; X1, Y1: Integer);
var
  //  定义局部变量
  n: Byte;
begin
  //  零件贴图显示的登录(DipMi)
  Sn := DipMi[0];
  if Sn <> 255 then
  begin
    Rn := 0;
    Y2 := Y1 + SpSiz[Sban * 2 + 1] * 16;
    while (Rn < Sn) and (Y2 >= DipMi[Rn * 4 + 4]) do
      Rn := Rn + 1;
    if Rn < Sn then
      for n := Sn downto (Rn + 1) do
      begin
        DipMi[n * 4 + 4] := DipMi[(n - 1) * 4 + 4];
        DipMi[n * 4 + 3] := DipMi[(n - 1) * 4 + 3];
        DipMi[n * 4 + 2] := DipMi[(n - 1) * 4 + 2];
        DipMi[n * 4 + 1] := DipMi[(n - 1) * 4 + 1];
      end;
    DipMi[0] := Sn + 1;
    DipMi[Rn * 4 + 1] := Sban;
    DipMi[Rn * 4 + 2] := X1;
    DipMi[Rn * 4 + 3] := Y1;
    DipMi[Rn * 4 + 4] := Y2;
  end;
end;

procedure TRei40_11.HiReg(Sban: Byte; X1, Y1: Integer);
begin
  //  零件贴图显示的登录(DipHi)
  Sn := DipHi[0];
  if Sn <> 255 then
  begin
    DipHi[Sn * 3 + 1] := Sban;
    DipHi[Sn * 3 + 2] := X1;
    DipHi[Sn * 3 + 3] := Y1;
    DipHi[0] := Sn + 1;
  end;
end;

procedure TRei40_11.DpSprite;
var
  //  定义局部变量
  n, Dpn: Byte;
begin
  //  显示已登录的零件贴图
  for DPn := 1 to DipLO[0] do
  begin
    n := DipLo[DPn * 3 - 2];
    ChrDi(SpSiz[n * 2], SpSiz[n * 2 + 1], SpPon[n],
      DipLo[DPn * 3 - 1] + 16, DipLO[DPn * 3] + 16, Make_Bmap);
  end;
  for DPn := 1 to DipMi[0] do
  begin
    n := DipMi[DPn * 4 - 3];
    ChrDi(SpSiz[n * 2], SpSiz[n * 2 + 1], SpPon[n],
      DipMi[DPn * 4 - 2] + 16, DipMi[DPn * 4 - 1] + 16, Make_Bmap);
  end;
  for DPn := 1 to DipHi[0] do
  begin
    n := DipHi[DPn * 3 - 2];
    ChrDi(SpSiz[n * 2], SpSiz[n * 2 + 1], SpPon[n],
      DipHi[DPn * 3 - 1] + 16, DipHi[DPn * 3] + 16, Make_Bmap);
  end;
end;

procedure TRei40_11.ClSprite;
var
  //  定义局部变量
  Dpn: Byte;
begin
  //  已登录的零件贴图的去除与抹除
  for DPn := 1 to DipLO[0] do
    ChrCl(DipLo[DPn * 3 - 2], DipLo[DPn * 3 - 1] + 16,
      DipLO[DPn * 3] + 16, Make_Bmap);
  for DPn := 1 to DipMi[0] do
    ChrCl(DipMi[DPn * 4 - 3], DipMi[DPn * 4 - 2] + 16,
      DipMi[DPn * 4 - 1] + 16, Make_Bmap);
  for DPn := 1 to DipHi[0] do
    ChrCl(DipHi[DPn * 3 - 2], DipHi[DPn * 3 - 1] + 16,
      DipHi[DPn * 3] + 16, Make_Bmap);
  DipLo[0] := 0;
  DipMi[0] := 0;
  DipHi[0] := 0;
end;

procedure TRei40_11.ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
  Bmap: TBitmap);
var
  //  定义局部变量
  CDX, CDY: Byte;
begin
  //  将指定的角色绘制至指定点阵图上（重叠显示适用）
  for CDY := 0 to (Ysiz - 1) do
    for CDX := 0 to (Xsiz - 1) do
    begin
      if (X1 + CDX * 16 >= 0) and (X1 + CDX * 16 <= DYoko + 16) and
        (Y1 + CDY * 16 >= 0) and (Y1 + CDY * 16 <= DTate + 16) then
          PatDi(SpDat[Dpon], X1 + CDX * 16, Y1 + CDY * 16, Bmap);
      Dpon := Dpon + 1;
    end;
end;

procedure TRei40_11.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_11.ChrCl(Sban: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  以背景将指定的图案去除掉
  Xdot := SpSiz[Sban * 2] * 16 + 16;
  Ydot := SpSiz[Sban * 2 + 1] * 16 + 16;
  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_11.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、背景用、绘制用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Back_Bmap.Free;
  Make_Bmap.Free;
end;

end.