Delphi 经典游戏程序设计40例 的学习 例8 多重滚动

unit rei08;

interface

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

type
  TR08 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure ScrolX(var SX :Word;Y1,Y2:Word;Bmap:TBitmap);
    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;
  DTate = Tate * 16;
  PtFull = 16;
  SY1 = 160;    // 滚动块的Y 坐标
  SY2 = 260;
  SY3 = 340;


var
  R08: TR08;
  BackBmap,LoadBmap,XpatBmap,MakeBmap : TBitmap;
  PX,PY :Byte;
  n,SX1,SX2,SX3,SX4 :Word;
  RectL,RectB,RectM,RectD :TRect;
   //复合图案数组
  Spr00 : array[0..(31*11+1)] of Byte = (
  31, 11,
    12,12,12,12,12,12,12, 0,12,12,12, 0,12,12,12,12,12,12,12,
      0,12, 0, 0, 0, 0, 0,12,12,12,12,12,
    12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12, 0, 0,12,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,12,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12,12,12,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0,12, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0,
    0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0,12, 0, 0, 0,
      0,12, 0, 0, 0,12, 0,12, 0, 0, 0,12,
    0, 0,12,12,12, 0, 0, 0,12,12,12, 0, 0, 0,12,12,12, 0, 0,
      0,12,12,12,12,12, 0,12,12,12,12,12);
  

implementation

{$R *.dfm}

procedure TR08.FormCreate(Sender: TObject);
begin
  R08.Height := 480;
  R08.Width := 640;
   // 载入 背景 图案
  BackBmap := TBitmap.Create;
  BackBmap.LoadFromFile(GetCurrentDir + '\Back_Sample.bmp');
  // 载入图库图案
  LoadBmap := TBitmap.Create;
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');
  LoadBmap.Palette := BackBmap.Palette;
  // 去除用模板点阵图
  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 );
   //建立绘制用点阵图，复制背景
  MakeBmap := TBitmap.Create;
  MakeBmap.Width := DYoko + 32;
  MakeBmap.Height := DTate + 32;
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  RectB := Rect(0,0,DYoko,DTate);
  RectM := Rect(16,16,DYoko + 16,DTate+ 16);
  MakeBmap.Canvas.CopyRect(RectM,BackBmap.Canvas,RectB );

  SX1 := 0; // 初始滚动点
  SX2 := 0;
  SX3 := 0;
  

end;

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

procedure TR08.tmr1Timer(Sender: TObject);
begin
   SX1 := SX1 + 4;
   SX2 := SX2 + 2;
   SX3 := SX3 + 1;
   ScrolX(SX1,0,SY1,MakeBmap);
   ScrolX(SX2,SY1,SY2,MakeBmap);
   ScrolX(SX3,SY2,SY3,MakeBmap);
   SbanDi(Spr00,66,66,MakeBmap);

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


//滚动核心，方块挪动  ,
procedure TR08.ScrolX(var SX :Word;Y1,Y2:Word;Bmap:TBitmap);
begin
  RectB := Rect(0,Y1,SX,Y2 ) ;
  RectD := Rect(DYoko - SX + 16,Y1 + 16,DYoko + 16,Y2 +16);
  Bmap.Canvas.CopyMode := cmSrcCopy;
  Bmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB );

 if SX = DYoko then
    SX :=0
 else begin
    RectB := Rect(SX ,Y1,DYoko,Y2 );
    RectD := Rect(16,Y1 + 16,DYoko- SX + 16,Y2 + 16);
    Bmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB );
  end;
end;

 // 指定复合图案贴图，数组图案，自定义格式，数组0，1元素为 X,Y 图案个数
procedure TR08.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 TR08.PatDi(Pnum : Byte;X1,Y1 : Integer;Bmap:TBitmap);
begin
  PX := (Pnum mod 16 ) * 16;
  PY := (Pnum div  16 ) * 16;

  RectL := Rect(PX,PY,PX+ 16,PY + 16);
  RectD := Rect(X1,Y1,X1 + 16,Y1 + 16);
  if Pnum <> 0  then
  if Pnum >= 16 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;

end.

背景图片的处理，分割的很巧妙，需要预先设计好图片

云层的近大远小，近快远慢，让视觉上出现了立体效果？

图案的特定 数组格式 出现大数组了。前2元素为XY 大小，所以出现了一个 算术表达式来 直观的 表达？

用了4个内存点阵图来处理

还有单个的图案贴图方法，复合图案的贴图方法，