rei_20.pas

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

unit Rei_20;

interface

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

type
  TRei40_20 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure Thunder(X1, Y1, X2, Y2: Integer; Col, Ran: Byte;
      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_20: TRei40_20;
  //  定义载入用、去除模版用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、LongInt 类型、TRect类型、数组类型）
  PX, PY, TC: Byte;
  RS: LongInt;
  Rect_L, Rect_B, Rect_M, Rect_D: TRect;
  Tree: array[0..200] of Integer;

implementation

{$R *.DFM}

procedure TRei40_20.FormCreate(Sender: TObject);
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  设定Form属性
  Rei40_20.Height := 480;
  Rei40_20.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);
  //  储存背景用点阵图并绘制
  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
    begin
      if Y <= 25 then
        PatDi(2, X * 16, Y * 16, Back_Bmap)
      else
        PatDi(7, X * 16, Y * 16, Back_Bmap);
      if Y = 25 then
        PatDi(16, X * 16, Y * 16, Back_Bmap);
    end;
  //  储存绘制用点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
  //  将随机数初始化
  Randomize;
end;

procedure TRei40_20.Timer1Timer(Sender: TObject);
begin
  //  将背景绘制至Back_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);
  //  依序将闪电绘制在Make_Bmap上，并显示在Form上
  TC := (TC + 1) and 31;
  case TC of
    0: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 1, 0, Make_Bmap);
    1: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 0, 1, Make_Bmap);
    2: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 1, 1, Make_Bmap);
    7: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 1, 1, Make_Bmap);
    8: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 0, 1, Make_Bmap);
    9: Thunder(10 + 16, 16, 582 + 16, 400 + 16, 1, 1, Make_Bmap);
  end;
  Rei40_20.Canvas.CopyMode := cmSrcCopy;
  Rect_D := Rect(0, 0, ClientWidth, ClientHeight);
  Rei40_20.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_20.Thunder(X1, Y1, X2, Y2: Integer; Col, Ran: Byte;
  Bmap: TBitmap);
const
  Tmax = 12;
var
  //  定义局部变量
  Xadd, TX, TY: Integer;
  Yadd, Tran, Tn, Mc: Byte;
begin
  //  制作闪电
  Tree[0] := 0;
  Bmap.Canvas.Pen.Width := 2;
  case Col of
    0: Bmap.Canvas.Pen.color := clYellow;
    1: Bmap.Canvas.Pen.color := clWhite;
  end;
  if Ran = 0 then
    RS := RandSeed
  else
    RandSeed := RS;
  for Tn := 0 to Tmax do
  begin
    Yadd := 12 + Random(20);
    if Tree[0] = 0 then
    begin
      TY := Y1;
      TX := X1 + 50 + Random(X2 - X1 - 100);
    end
    else begin
      Tran := Random(Tree[0]) + 1;
      TX := Tree[Tran * 2 - 1];
      TY := Tree[Tran * 2];
    end;
    if TX < X1 + (X2 - X1) div 3 then
      Xadd := 16 + Random(16 - Tn)
    else if TX > X2 - (X2 - X1) div 3 then
      Xadd := -16 - Random(16 - Tn)
    else
      Xadd := 16 + Tn - Random(33 + Tn * 2);
    Bmap.Canvas.Moveto(TX, TY);
    Mc := 0;
    while (TX + Xadd - 16 >= X1) and (TX + Xadd + 16 <= X2) and
      (TY + Yadd <= Y2) and (Random(Tmax - Tn + 1) + 4 > Mc) do
    begin
      Mc := Mc + 1;
      TY := TY + Yadd;
      TX := TX + Xadd - 16 + Random(33);
      Bmap.Canvas.Lineto(TX, TY);
      if (TX > X1 + 50) and (TX < X2 - 50) and (TY < Y2 - 100) and
        (Tree[0] < 100) then
      begin
        Tree[0] := Tree[0] + 1;
        Tree[Tree[0] * 2 - 1] := TX;
        Tree[Tree[0] * 2] := TY;
      end;
    end;
  end;
end;

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

end.