rei_09.pas

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

unit Rei_09;

interface

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

type
  TRei40_09 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private 定义 }
    procedure MakeSpot;
    procedure SbanDi(Sary: array of Byte; 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_09: TRei40_09;
  //  定义载入用、去除模版用、背景用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Back_Bmap: TBitmap;
  Spot_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、Word类型、Integer类型、TRect类型）
  PX, PY: Byte;
  n, SpotR: Word;
  SpotX, SpotY: Integer;
  Rect_L, Rect_B, Rect_S, Rect_M, Rect_D: TRect;
  //聚光灯的移动旗标、座标偏移量、半径变更旗标
  MoveS: Byte = 0;
  Xadd: Shortint = 2;
  Yadd: Shortint = 2;
  Radd: Shortint = 0;
  //  定义复合图案用的数组
  Spr00: array[0..(31 * 17 + 1)] of Byte = (
    31, 17,
    19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,
      19,19,19,19,19,19,19,19,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 0, 0, 0, 0, 0, 0, 0,
    0,19,19,19,19,19, 0, 0,19,19,19,19,19,19, 0, 0, 0,19,19,19,19,19, 0,
      0,19,19,19,19,19,19,19,
    19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
      0,19, 0, 0,19, 0, 0,19,
    19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0,19, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    0,19,19,19,19,19, 0, 0, 0,19,19,19,19,19, 0, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    0, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    19, 0, 0, 0, 0, 0,19, 0, 0,19, 0, 0, 0, 0, 0, 0,19, 0, 0, 0, 0, 0,19,
      0, 0, 0, 0,19, 0, 0, 0,
    0,19,19,19,19,19, 0, 0,19,19,19, 0, 0, 0, 0, 0, 0,19,19,19,19,19, 0,
      0, 0, 0,19,19,19, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
      0, 0, 0, 0, 0, 0, 0, 0,
    19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,
      19,19,19,19,19,19,19,19
  );
implementation

{$R *.DFM}

procedure TRei40_09.FormCreate(Sender: TObject);
var
  X, Y: Byte;
begin
  //  设定Form属性
  Rei40_09.Height := 480;
  Rei40_09.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;
  Button4.Height := 25;
  Button4.Left := 603;
  Button4.Top := 136;
  Button4.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 + 32;
  Back_Bmap.Height := DTate + 32;
  //  将背景绘制至Back_Bmap上
  for Y := 0 to (Tate - 1) do
    for X := 0 to (Yoko - 1) do
      PatDi(15, X * 16 + 16, Y * 16 + 16, Back_Bmap);
  SbanDi(Spr00, 66, 96, Back_Bmap);
  //  储存绘制用点阵图并涂黑
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Back_Bmap.Width;
  Make_Bmap.Height := Back_Bmap.Height;
  Make_Bmap.Canvas.Brush.Color := clBlack;
  Rect_M := Rect(0, 0, Make_Bmap.Width, Make_Bmap.Height);
  Make_Bmap.Canvas.FillRect(Rect_M);
  //  制作圆形模版图样点阵图
  Spot_Bmap := TBitmap.Create;
  Spot_Bmap.Width := DYoko + 32;
  Spot_Bmap.Height := DYoko + 32;
  SpotR := 16 * 6;
  MakeSpot;
  //  初始设定圆形座标
  SpotX := DYoko div 2;
  SpotY := DTate div 2;
end;

procedure TRei40_09.Timer1Timer(Sender: TObject);
var
  Spx1, Spy1, Spx2, Spy2, Sbx1, Sby1, Sbx2, Sby2: Integer;
begin
  //  改变聚光灯位置
  if MoveS = 1 then
  begin
    SpotX := SpotX + Xadd;
    SpotY := SpotY + Yadd;
    if SpotX <= 0 then
    begin
      SpotX := 0;
      Xadd := -Xadd;
    end
    else if SpotX >= DYoko then
    begin
      SpotX := DYoko;
      Xadd := -Xadd;
    end;
    if SpotY <= 0 then
    begin
      SpotY := 0;
      Yadd := -Yadd;
    end
    else if SpotY >= DTate then
    begin
      SpotY := DTate;
      Yadd := -Yadd;
    end;
  end;
  //  改变半径
  if Radd <> 0 then
  begin
    SpotR := SpotR + Radd;
    if (SpotR >= 1) and (SpotR <= (Spot_Bmap.Width - 32) div 2) then
      MakeSpot
    else begin
      SpotR := SpotR - Radd;
      Radd := 0;
    end;
  end;
  //  将圆形模版图样内的背景（四方形）复制至绘制点阵图
  Spx1 := SpotX - SpotR;
  Spy1 := SpotY - SpotR;
  Spx2 := SpotX + SpotR;
  Spy2 := SpotY + SpotR;
  if Spx1 < 0 then
    Spx1 := 0;
  if Spy1 < 0 then
    Spy1 := 0;
  if Spx2 > (Make_Bmap.Width - 32) then
    Spx2 := Make_Bmap.Width - 32;
  if Spy2 > (Make_Bmap.Height - 32) then
    Spy2 := Make_Bmap.Height - 32;
  Rect_B := Rect(Spx1 + 16, Spy1 + 16, Spx2 + 16, Spy2 + 16);
  Rect_M := Rect(Spx1 + 16, Spy1 + 16, Spx2 + 16, Spy2 + 16);
  Make_Bmap.Canvas.CopyMode := cmSrcCopy;
  Make_Bmap.Canvas.CopyRect(Rect_M, Back_Bmap.Canvas, Rect_B);
  //  将圆形模版图样复制至绘制点阵图
  Sbx1 := 0;
  Sby1 := 0;
  Sbx2 := SpotR * 2 + 32;
  Sby2 := SpotR * 2 + 32;
  if (SpotX - SpotR) < 0 then
    Sbx1 := -(SpotX - SpotR);
  if (SpotY - SpotR) < 0 then
    Sby1 := -(SpotY - SpotR);
  if (SpotX + SpotR) > (Make_Bmap.Width - 32) then
    Sbx2 := Sbx2 - (SpotX + SpotR - (Make_Bmap.Width - 32));
  if (SpotY + SpotR) > (Make_Bmap.Height - 32) then
    Sby2 := Sby2 - (SpotY + SpotR - (Make_Bmap.Height - 32));
  Make_Bmap.Canvas.CopyMode := cmSrcAnd;
  Rect_S := Rect(Sbx1, Sby1, Sbx2, Sby2);
  Rect_M := Rect(Spx1, Spy1, Spx2 + 32, Spy2 + 32);
  Make_Bmap.Canvas.CopyRect(Rect_M, Spot_Bmap.Canvas, Rect_S);
  //  显示在Form上
  Rei40_09.Canvas.CopyMode := cmSrcCopy;
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_09.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_09.MakeSpot;
begin
  //  在圆形模版图样点阵图上制作圆形
  Spot_Bmap.Canvas.Brush.Color := clBlack;
  Rect_S := Rect(0, 0, SpotR * 2 + 32, SpotR * 2 + 32);
  Spot_Bmap.Canvas.FillRect(Rect_S);
  Spot_Bmap.Canvas.Pen.Color := clWhite;
  Spot_Bmap.Canvas.Brush.Color := clWhite;
  Spot_Bmap.Canvas.Ellipse(16, 16, SpotR * 2 + 16, SpotR * 2 + 16);
end;

procedure TRei40_09.Button1Click(Sender: TObject);
begin
  //  增加半径
  Radd := 1;
end;

procedure TRei40_09.Button2Click(Sender: TObject);
begin
  //  减少半径
  Radd := -1;
end;

procedure TRei40_09.Button3Click(Sender: TObject);
begin
  //  固定半径
  Radd := 0;
end;

procedure TRei40_09.Button4Click(Sender: TObject);
begin
  //  聚光灯移动的开与关
  MoveS := MoveS xor 1;
end;

procedure TRei40_09.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_09.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_09.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、背景用、圆形模版图样用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Back_Bmap.Free;
  Spot_Bmap.Free;
  Make_Bmap.Free;
end;

end.