rei_19.pas

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

unit Rei_19;

interface

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

type
  TRei40_19 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    Button2: TButton;
    Button3: 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 Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 定义 }
    procedure Thunder(X1, Y1, X2, Y2: Integer; W1, W2, W3: Word;
      TM: Byte; Bmap: TBitmap);
    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_19: TRei40_19;
  //  定义载入用、去除模版用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte、Word、Integer、ShortInt、Trect等类型）
  PX, PY, Ray, TC: Byte;
  ChX: Word = 300;
  ChY: Word = 360;
  ChM: ShortInt = 2;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  //  复合图案（0～1）的数组
  SpDat: array[0..9] of Byte = (28,29,30,31, 64,65,80,81,96,97);

implementation

{$R *.DFM}

procedure TRei40_19.FormCreate(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  设定Form属性
  Rei40_19.Height := 480;
  Rei40_19.Width := 640;
  Button1.Height := 25;
  Button1.Left := 603;
  Button1.Top := 16;
  Button1.Width := 25;
  Button2.Height := 25;
  Button2.Left := 603;
  Button2.Top := 56;
  Button2.Width := 25;
  Button3.Height := 25;
  Button3.Left := 603;
  Button3.Top := 96;
  Button3.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);
//  储存背景用点阵图
  Back_Bmap := TBitmap.Create;
  Back_Bmap.Width := DYoko;
  Back_Bmap.Height := DTate;
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
      case Y of
        0..20: PatDi(1, X * 16, Y * 16, Back_Bmap);
        21..Tate - 1: PatDi(15, X * 16, Y * 16, Back_Bmap);
      end;
  for X := 0 to (Yoko - 1) do
    PatDi(16, X * 16, 20 * 16, Back_Bmap);
  ChrDi(2, 2, 0, 280, 10, Back_Bmap);
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
end;

procedure TRei40_19.Timer1Timer(Sender: TObject);
var
  //  定义局部变量
  Th1, Th2, Th3: Word;
  ThM: Byte;
begin
  //  将背景与角色绘制至Make_Bmap上
  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);
  ChX := ChX + ChM;
  if (ChX < 0) or (ChX > DYoko - 32) then
  begin
    ChM := -ChM;
    ChX := ChX + ChM;
  end;
  ChrDi(2, 3, 4, ChX + 16, ChY + 16, Make_Bmap);
  //  在Make_Bmap上绘制闪电并将其显示至Form上
  case Ray of
    1: begin
      Th1 := 0;
      Th2 := 16;
      Th3 := 0;
      ThM := 1;
    end;
    2: begin
      Th1 := 4;
      Th2 := 20;
      Th3 := 6;
      ThM := 4;
    end;
    3: begin
      Th1 := 8;
      Th2 := 32;
      Th3 := 286;
      ThM := 6;
    end;
  end;
  if Ray <> 0 then
    Thunder(296 + 16, 43 + 16, ChX + 32, ChY + 15, Th1, Th2, Th3,
      ThM, Make_Bmap);
  Rei40_19.Canvas.CopyMode := cmSrcCopy;
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_19.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_19.Thunder(X1, Y1, X2, Y2: Integer; W1, W2, W3: Word;
  TM:Byte; Bmap: TBitmap);
var
  //  定义局部变量
  Xadd, TX, TY, LX, RX: Integer;
  Yadd, Wadd, Wran, n: Byte;
begin
  //  制作闪电光线
  TC := TC xor 1;
  if TC = 0 then
    Bmap.Canvas.Pen.color := clWhite
  else
    Bmap.Canvas.Pen.color := clYellow;
  Bmap.Canvas.Pen.Width := 2;
  for n := 1 to TM do
  begin
    Wran := Random(4) + (Y2 - Y1) div 40 + 1;
    Xadd := (X2 - X1) div Wran;
    Yadd := (Y2 - Y1) div Wran + 1;
    Wadd := W3 div Wran;
    LX := X1;
    RX := X1;
    TX := X1 - W1 + Random(W1 * 2 + 1);
    TY := Y1;
    Bmap.Canvas.Moveto(TX, TY);
    while  TY < Y2 do
    begin
      TY := TY + Yadd;
      LX := LX + Xadd - Wadd;
      RX := RX + Xadd + Wadd;
      if TX - Wadd < LX then
        TX := LX - W2 + Random(W2 * 2 + Wadd + 1)
      else if  TX + Wadd > RX then
        TX := RX + W2 - Random(W2 * 2 + Wadd + 1)
      else
        TX := TX + Xadd - Wadd - W2 + Random((W2 + Wadd) * 2 + 1);
      if TY >= Y2 then
      begin
        TY := Y2;
        if TX < X2 - W3 then
          TX := X2 - W3 + Random(Wadd + 1)
        else if TX > X2 + W3 then
          TX := X2 + W3 - Random(Wadd + 1);
      end;
      Bmap.Canvas.Lineto(TX, TY);
    end;
  end;
end;

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

procedure TRei40_19.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  闪电光线(2)照射旗标
  Ray := 2;
end;

procedure TRei40_19.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  闪电光线(3)照射旗标
  Ray := 3;
end;

procedure TRei40_19.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  闪电光线(1)停止照射旗标
  Ray := 0;
end;

procedure TRei40_19.Button3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  闪电光线(2)停止照射旗标
  Ray := 0;
end;

procedure TRei40_19.Button2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //  闪电光线(3)停止照射旗标
  Ray := 0;
end;

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

end.