Delphi 经典游戏程序设计40例的学习例9 可大可小随处移动的聚光灯处理

本文主要是介绍Delphi 经典游戏程序设计40例的学习例9 可大可小随处移动的聚光灯处理，对大家解决编程问题具有一定的参考价值，需要的程序猿们随着小编来一起学习吧！

unit rei09;

interface

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

type
  TR09 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure MakeSpot;
    procedure SbanDi(Sary:array of Byte; X1,Y1:Integer;Bmap:TBitmap);
    procedure PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);

  public
    { Public declarations }
  end;
const
  Yoko = 37;
  Tate = 27;
  DYoko = Yoko * 16;      //592
  DTate = Tate * 16;      //432
  PtFull = 16;

var
  R09: TR09;
  LoadBmap,XpatBmap,BackBmap,SpotBmap,MakeBmap : TBitmap;
  PX,PY :Byte;
  n,SpotR: Word;
  SpotX,SpotY : Integer;
  RectL,RectB,RectS,RectM,RectD : 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 TR09.FormCreate(Sender: TObject);
var
  X,Y :Byte;


begin

  //装载图案
  LoadBmap :=TBitmap.Create;
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');
  //   去除用点阵图
  XpatBmap := TBitmap.Create;
  XpatBmap.Width := 256;
  XpatBmap.Height := 256;

  RectL := Rect(0,0,256,256);
  XpatBmap.Canvas.CopyMode :=cmSrcCopy;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
  XpatBmap.Canvas.Brush.Color := clBlack;
  XpatBmap.Canvas.BrushCopy(RectL,LoadBmap ,RectL,clWhite);
  XpatBmap.Canvas.CopyMode := cmMergePaint;
  XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
   //背景点阵图
  BackBmap := TBitmap.Create;
  BackBmap.Width := DYoko + 32;
  BackBmap.Height := DTate + 32;

  for Y:=0 to (Tate -1) do
    for X:=0 to (Yoko -1) do
      PatDi(15,X*16+16,Y*16 +16,BackBmap);
   // 绘制SPR00 图案
  SbanDi( Spr00,66,96,BackBmap);

  //制作用点阵图，涂黑
  MakeBmap := TBitmap.Create;
  MakeBmap.Width := BackBmap.Width;
  MakeBmap.Height := BackBmap.Height;
  MakeBmap.Canvas.Brush.Color := clBlack;
  RectM := Rect(0,0,MakeBmap.Width,MakeBmap.Height);
  MakeBmap.Canvas.FillRect(RectM);

    //圆形模板 点阵图
  SpotBmap := TBitmap.Create;
  SpotBmap.Width := DYoko +32;

  // 神奇的地方，此点阵图 高度  为Dyoko 宽度 ,否则最大圆 放 不下
  SpotBmap.Height := DYoko +32;
  SpotR := 16 *6;

  // 画圆
  MakeSpot;
  //图形初始坐标
  SpotX := DYoko div 2;
  SpotY := DTate div 2;




end;


procedure TR09.MakeSpot;
begin   //在圆形模板点阵图上 制作圆形
  //涂黑
  SpotBmap.Canvas.Brush.Color := clBlack;
  RectS := Rect(0,0,SpotR *2 + 32, SpotR *2 +32);
  SpotBmap.Canvas.FillRect(RectS);
  //画圆
  SpotBmap.Canvas.Pen.Color := clWhite;
  SpotBmap.Canvas.Brush.Color := clWhite;
  SpotBmap.Canvas.Ellipse(16,16,SpotR *2 +16,SpotR * 2 +16);
end;


procedure TR09.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 TR09.PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap);
begin
  PX := (Pnum and $F ) * 16;
  PY := Pnum and $F0;
  RectL := Rect(PX ,PY ,PX + 16,PY +16);
  RectD := Rect(X1 ,Y1 ,X1 +16,Y1 +16);
  if Pnum <> 0 then
    if Pnum >= PtFull then
    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(RectD ,XpatBmap.Canvas,RectL );
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL   );

    end
    else begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
    end;

end;


procedure TR09.tmr1Timer(Sender: TObject);
var
  Spx1,Spy1,Spx2,Spy2,Sbx1,Sbx2,Sby1,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 <= (SpotBmap.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;
       // MakeBmap.Width = BackBmap.Width = DYoko + 32
     if Spx2 >(MakeBmap.Width  -32)  then
       Spx2 := MakeBmap.Width -32;
     if Spy2 > (MakeBmap.Height - 32 ) then
       Spy2 := MakeBmap.Height-32 ;

     RectB := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16);
     RectM := Rect(Spx1 + 16,Spy1 + 16,Spx2 + 16,Spy2 + 16);
     MakeBmap.Canvas.CopyMode := cmSrcCopy;
     MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas ,RectB );

     //将圆形模板图样复制 到绘制点阵图
     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 )> (MakeBmap.Width -32) then
       Sbx2 := Sbx2 - (SpotX + SpotR -(MakeBmap.Width -32));
     if (SpotY + SpotR ) > (MakeBmap.Height  -32) then
       Sby2 := Sby2 - (SpotY + SpotR - (MakeBmap.Height -32 ));

     MakeBmap.Canvas.CopyMode := cmSrcAnd;
     RectS := Rect(Sbx1 ,Sby1,Sbx2,Sby2 );
     RectM := Rect(Spx1 ,Spy1,Spx2 + 32,Spy2 + 32);
     MakeBmap.Canvas.CopyRect(RectM,SpotBmap.Canvas,RectS );

     R09.Canvas.CopyMode := cmSrcCopy;
     RectM := Rect(16,16, DYoko + 16,DTate + 16) ;
     RectD := Rect(0,0,DYoko,DTate);
     R09.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM )  ;





end;

procedure TR09.Button1Click(Sender: TObject);
begin
  Radd := 1;
end;

procedure TR09.Button2Click(Sender: TObject);
begin
  Radd := -1;
end;

procedure TR09.Button3Click(Sender: TObject);
begin
  Radd  := 0 ;
  
end;

procedure TR09.Button4Click(Sender: TObject);
begin
  MoveS := MoveS xor 1;
end;

procedure TR09.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  XpatBmap.Free;
  BackBmap.Free;
  SpotBmap.Free;
  MakeBmap.Free;
end;

end.

patdi ,sbandi 贴图

makespot 画圆

在 time1里面执行所有的动作。

圆形模板要裁剪

会有一个越界的现象，这个时候需要对圆形模板进行裁剪

可以拿2张纸来进行理解，

想象力不行，不能在脑袋里抽象的想象。

基本是对着书敲代码的，并没有自己编写。

开始圆形模板要设置成

这篇关于Delphi 经典游戏程序设计40例的学习例9 可大可小随处移动的聚光灯处理的文章就介绍到这儿，希望我们推荐的文章对大家有所帮助，也希望大家多多支持为之网！

Java教程

Delphi 经典游戏程序设计40例的学习例9 可大可小随处移动的聚光灯处理

前端开发

后端开发

移动端开发

数据库

服务器运维

人工智能

区块链

游戏开发

网站运营

大数据/云计算

软件工程

软件/开发工具使用

资讯

Delphi 经典游戏程序设计40例 的学习 例9 可大可小 随处移动的聚光灯处理

前端开发

后端开发

移动端开发

数据库

服务器运维

人工智能

区块链

游戏开发

网站运营

大数据/云计算

软件工程

软件/开发工具使用

资讯

Delphi 经典游戏程序设计40例的学习例9 可大可小随处移动的聚光灯处理