rei_18.pas

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

unit Rei_18;

interface

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

type
  //  定义管理角色的记录类型
  TPatDt = record
    Used: Byte;
    Sban: Byte;
    Xpos: Integer;
    Ypos: Integer;
    Scon: Byte;
  end;

  TRei40_18 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 定义 }
    procedure LineRay;
    procedure MStars;
    procedure ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; 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;         //全面显示（不要重叠显示）的图案数

var
  Rei40_18: TRei40_18;
  //  定义载入用、去除模版用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Make_Bmap: TBitmap;
   //  定义各种变量（Byte类型、Word类型、TRect类型）
  PX, PY, Bn, Ray, TM: Byte;
  BX, RX, BY, RY: Word;
  Rect_L, Rect_M, Rect_D: TRect;
  ChPon: array[1..5] of TPatDt;
  //  复合图案（0～2）数组
  SpDat: array[0..5] of Byte = (0, 76,77,92,93, 19);

implementation

{$R *.DFM}

procedure TRei40_18.FormCreate(Sender: TObject);
var
  //  定义局部变量
  Cn: Byte;
begin
  //  设定Form属性
  Rei40_18.Height := 480;
  Rei40_18.Width := 640;
  Button1.Height := 25;
  Button1.Left := 603;
  Button1.Top := 16;
  Button1.Width := 25;
  //  载入图样
  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);
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  //  角色数组的初始设定
  Randomize;
  for Cn := 1 to 5 do
  begin
    ChPon[Cn].Used := 0;
    ChPon[Cn].Scon := Random(100) + 60;
  end;
end;

procedure TRei40_18.Timer1Timer(Sender: TObject);
begin
  //  显示线条光线或星星
  if Ray = 1 then
    LineRay
  else
    MStars;
end;

procedure TRei40_18.LineRay;
var
  //  定义局部变量
  n: Byte;
begin
  //  线条光线的处理
  TM := (TM + 1) and 3;
  if Bn <> 0 then
  begin
    ChPon[Bn].Scon := ChPon[Bn].Scon + 1;
    if ChPon[Bn].Scon > 20 then
    begin
      for n := 0 to 8 do
      begin
        Rei40_18.Canvas.Pen.Width := 3;
        Rei40_18.Canvas.Pen.color := clBlack;
        Rei40_18.Canvas.Moveto(DYoko div 2, DTate - 34);
        Rei40_18.Canvas.Lineto(RX + n * 3, BY);
      end;
      ChPon[Bn].Used := 0;
      ChPon[Bn].Scon := Random(80) + 60;
      Bn := 0;
      BY := 0;
    end;
  end;
  RX := BX + Random(9);
  for n := 0 to 8 do
  begin
    RY := BY;
    if (n < 2) or (n > 6) then
    begin
      Rei40_18.Canvas.Pen.Width := 2;
      Rei40_18.Canvas.Pen.color := clBlack;
    end
    else begin
      Rei40_18.Canvas.Pen.Width := 1;
      if (n = 2) or (n = 6) then
        RY := BY + 2;
      case TM of
        0: Rei40_18.Canvas.Pen.Color := clYellow;
        1: Rei40_18.Canvas.Pen.Color := clAqua;
        2: Rei40_18.Canvas.Pen.Color := clWhite;
        3: Rei40_18.Canvas.Pen.Color := clMaroon;
      end;
    end;
    Rei40_18.Canvas.Moveto(DYoko div 2, DTate - 34);
    Rei40_18.Canvas.Lineto(RX + n * 3, RY);
  end;
end;

procedure TRei40_18.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  线条光线照射旗标
  Ray := 1;
end;

procedure TRei40_18.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  线条光线停止旗标
  Ray := 0;
end;

procedure TRei40_18.MStars;
var
  //  定义局部变量
  Cn: Byte;
begin
  //  检查星星是否出现并绘制显示至Make_Bmap上
  for Cn := 1 to 5 do
    if ChPon[Cn].Used = 0 then
    begin
      ChPon[Cn].Scon := ChPon[Cn].Scon + 1;
      if ChPon[Cn].Scon > 150 then
      begin
        ChPon[Cn].Used := 1;
        ChPon[Cn].Sban := 2;
        ChPon[Cn].Xpos := (Cn - 1) * 120 + Random(60) + 20;
        ChPon[Cn].Ypos := Random(20) + 10;
        ChPon[Cn].Scon := 0;
      end;
    end
    else if Bn = 0 then
    begin
      BX := ChPon[Cn].Xpos;
      if BX < DYoko div 2 then
        BX := BX - 12
      else
        BX := BX - 4;
      BY := ChPon[Cn].Ypos - 4;
      Bn := Cn;
    end;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Make_Bmap.Canvas.Brush.Color := clBlack;
  Make_Bmap.Canvas.Fillrect(Rect_M);
  ChrDi(2, 2, 1, DYoko div 2, DTate - 16, Make_Bmap);
  for Cn := 1 to 5 do
    if ChPon[Cn].Used = 1 then
      ChrDi(1, 1, 5, ChPon[Cn].Xpos + 16, ChPon[Cn].Ypos + 16, Make_Bmap);
  Rei40_18.Canvas.CopyMode := cmSrcCopy;
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_18.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_18.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_18.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_18.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用与绘制用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Make_Bmap.Free;
end;

end.