Delphi 经典游戏程序设计40例的学习例26 Image List 的实力与用法

标签：26 end Cn 16 ChPon Delphi List begin Dpn

unit R26;

interface

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

type
  TPatDt = record     //角色记录
    Used : Byte;
    Sban : Byte;
    Xpos : Integer;
    Ypos : Integer;
    Smov : Byte;
    Scon : Byte;
  end;

  TRei26 = class(TForm)
    ImageList1: TImageList;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure LoReg(Sban : Byte;X1,Y1 : Integer);
    procedure MiReg(Sban : Byte;X1,Y1 : Integer);
    procedure HiReg(Sban : Byte;X1,Y1 : Integer);
    procedure DpSprite;
    procedure ClSprite;
    procedure ChrDi(Xsiz,Ysiz : Byte;Dpon : Word;X1,Y1 : Integer;Bmap : TBitmap);
    procedure ChrCl(Sban : Byte;X1,Y1 : Integer;Bmap : TBitmap);
  public
    { Public declarations }
  end;

const
  Yoko = 37;
  Tate = 27;
  DYoko = Yoko * 16;
  DTate = Tate * 16;
  MaxSp = 6;           //复合图样数
  MaxChr = 12;         //角色数
  Mdots = 3;           //角色移动点数

var
  Rei26: TRei26;
  LoadBmap,IpatBmap,BackBmap,MakeBmap : TBitmap;  //ImageList传送用点阵图
  RectL,RectI,RectB,RectM,RectD : TRect;
  P,Sn,Rn : Byte;
  Sc,Xdot,Ydot : Word;
  Y2 : Integer;
  ChPon : array[0..255] of TPatDt;
  DipLo : array[0..(3 * 255)] of Integer;
  DipMi : array[0..(4 * 255)] of Integer;
  DipHi : array[0..(3 * 255)] of Integer;
  //复合图样数组
  SpSiz : array[0..(MaxSp * 2 - 1)] of Byte = (
    2,2, 2,2, 2,2, 2,3, 3,3, 31,1 );
  SpPon : array[0..(MaxSp - 1)] of Word;
  SpDat : array[0..57] of Byte = (
    24,25,26,27,
    28,29,30,31,
    32,33,48,49,
    64,65,80,81,96,97,
    0,19,0,19,0,19,0,19,0,
    16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,
    16,16,16,16,16,16,16,16,16,16);
  



implementation

{$R *.dfm}

procedure TRei26.FormCreate(Sender: TObject);
var
  X,Y,n, Cn : Byte;

begin
  Rei26.Canvas.CopyMode := cmSrcCopy;
  //载入图案库文件
  LoadBmap := TBitmap.Create;
  LoadBmap.LoadFromFile(GetCurrentDir + '\Pat_Sample.bmp');
  //登陆至ImageList
  IpatBmap := TBitmap.Create;
  IpatBmap.Width := 16;
  IpatBmap.Height := 16;
  IpatBmap.Canvas.CopyMode := cmSrcCopy;
  RectI := Rect(0,0,16,16);
  for Y := 0 to 15 do
    for X := 0 to 15 do
    begin
      RectL := Rect(X * 16,Y * 16,X * 16 + 16,y * 16 + 16);
      IpatBmap.Canvas.CopyRect(RectI,LoadBmap.Canvas,RectL);
      ImageList1.AddMasked(IpatBmap,clWhite);
    end;
  IpatBmap.Free;    //此处可以释放传送用点阵图

  Sc := 0;
  for n := 0 to (MaxSp -1 ) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + SpSiz[n * 2] * SpSiz[n * 2 + 1];
  end;
   //背景点阵图
  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
    begin
      if (X = 0) or (Y = 0) or (X = Yoko - 1) or (Y = Tate - 1) then
        P := 7
      else
        P := 15;
      ImageList1.Draw(BackBmap.Canvas,X * 16 + 16,Y * 16 + 16,P);
    end;
  //绘制点阵图
  MakeBmap := TBitmap.Create;
  MakeBmap.Width := BackBmap.Width;
  MakeBmap.Height := BackBmap.Height;
  MakeBmap.Canvas.Draw(0,0,BackBmap);
  //角色初始化
  for Cn := 0 to (MaxChr - 1) do
  begin
    ChPon[Cn].Used := 1;
    ChPon[Cn].Sban := (Cn and 1) + 1;
    ChPon[Cn].Xpos := Random(528) + 32;
    ChPon[cn].Ypos := Cn * 24 + 20;
    ChPon[Cn].Smov := Random(4);
    ChPon[Cn].Scon := Random(20) + 20;
  end;
  //零件贴图登陆初始化
  DipLo[0] := 0;
  DipMi[0] := 0;
  DipHi[0] := 0;
end;
//低层零件贴图登陆
procedure TRei26.LoReg(Sban : Byte;X1,Y1 : Integer);
begin
  Sn := DipLo[0];
  if Sn <> 255 then
  begin
    DipLo[Sn * 3 + 1] := Sban;
    DipLo[Sn * 3 + 2] := X1;
    DipLo[Sn * 3 + 3] := Y1;
    DipLo[0] := Sn + 1;
  end;
end;
 //中层零件贴图登陆，需要比较Y坐标，体现前后感
procedure TRei26.MiReg(Sban : Byte;X1,Y1 : Integer);
var
  n : Byte;
begin
  Sn := DipMi[0];
  if Sn <> 255 then
  begin
    Rn := 0 ;
    Y2 := Y1 + SpSiz[Sban * 2 + 1] * 16;
    while (Rn < Sn) and (Y2 >= DipMi[Rn * 4 + 4]) do
      Rn := Rn + 1;
    if Rn < Sn then
      for n := Sn downto (Rn + 1) do
      begin
        DipMi[n * 4 + 4] := DipMi[(n - 1) * 4 + 4];
        DipMi[n * 4 + 3] := DipMI[(n - 1) * 4 + 3];
        DipMi[n * 4 + 2] := DipMi[(n - 1) * 4 + 2];
        DipMi[n * 4 + 1] := DipMi[(n - 1) * 4 + 1];
      end;
    DipMi[0] := Sn + 1;
    DipMi[Rn * 4 + 1] := Sban;
    DipMi[Rn * 4 + 2] := X1;
    DipMi[Rn * 4 + 3] := Y1;
    DipMi[Rn * 4 + 4] := Y2;

  end;
end;

 //高层零件贴图登陆
procedure TRei26.HiReg(Sban : Byte;X1,Y1 : Integer);
begin
  Sn := DipHi[0];
  if Sn <> 255 then
  begin
    DipHi[Sn * 3 + 1] := Sban;
    DipHi[Sn * 3 + 2] := X1;
    DipHi[Sn * 3 + 3] := Y1;
    DipHi[0] := Sn + 1;
  end;
end;

procedure TRei26.DpSprite;
var
  Dpn,n : Byte;
begin   //由低到高显示零件贴图
  for Dpn := 1 to DipLo[0] do
  begin
    n := DipLo[Dpn * 3 - 2];
    ChrDi(SpSiz[n * 2],SpSiz[n * 2 + 1],SpPOn[n],
      DipLo[Dpn * 3 - 1] + 16,DipLo[Dpn * 3] + 16,MakeBmap);
  end;
  for Dpn := 1 to DipMi[0] do
  begin
    n := DipMi[Dpn * 4 - 3];
    ChrDi(SpSiz[n * 2],SpSiz[n * 2 + 1],SpPon[n],
      DipMI[Dpn * 4 - 2] + 16,DipMi[Dpn * 4 - 1] + 16,MakeBmap);
  end;
  for Dpn := 1 to DipHi[0] do
  begin
    n := DipHi[Dpn * 3 - 2];
    ChrDi(SpSiz[n * 2],SpSiz[n * 2 + 1],SpPon[n],
      DipHi[Dpn * 3 -1] + 16,DipHi[Dpn * 3] + 16,MakeBmap);
  end;
end;

procedure TRei26.ClSprite;
var
  Dpn : Byte;
begin     //由低到高去除零件贴图，实际是恢复背景 ，登陆数组清零。
  for Dpn := 1 to DipLo[0] do
    ChrCl(DipLo[Dpn * 3 - 2],DipLo[Dpn * 3 -1] + 16,
      DipLo[Dpn * 3] + 16,MakeBmap);
  for Dpn := 1 to DipMi[0] do
    ChrCl(DipMi[Dpn * 4 - 3],DipMi[Dpn * 4 -2] + 16,
      DipMi[Dpn * 4 -1] + 16,MakeBmap);
  for Dpn := 1 to DipHi[0] do
    ChrCl(DipHi[Dpn * 3 - 2],DipHi[Dpn * 3 -1] + 16,
      DipHi[Dpn * 3] + 16,MakeBmap);
  DipLo[0] := 0;
  DipMi[0] := 0;
  DipHi[0] := 0;

end;
procedure TRei26.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

    ImageList1.Draw(Bmap.Canvas,X1 + CDX * 16,Y1 + CDY * 16,SpDat[Dpon]);
    Dpon := Dpon + 1;
    end;
end;
     //以背景去除指定的复合图样
procedure TRei26.ChrCl(Sban : Byte;X1,Y1 : Integer;Bmap : TBitmap);
begin
  Xdot := SpSiz[Sban * 2] * 16 + 16;
  Ydot := SpSiz[Sban * 2 + 1] * 16 + 16;
  if X1 < 0 then
  begin
    Xdot := Xdot + X1;
    X1 := 0;
  end;
  if Y1 < 0 then
  begin
    Ydot := Ydot + 1;
    Y1 := 0;
  end;
  if (X1 < DYoko + 32) and (Y1 < DTate + 32) then
  begin
    if (X1 + Xdot) >= (DYoko + 32) then
      Xdot := DYoko + 32 - X1;
    if (Y1 + Ydot) >= (DTate + 32) then
      Ydot := DTate + 32 - Y1;

    Bmap.Canvas.CopyMode := cmSrcCopy;
    RectB := Rect(X1,Y1,X1 + Xdot,Y1 + Ydot);
    Bmap.Canvas.CopyRect(RectB,BackBmap.Canvas,RectB);

  end;
end;

procedure TRei26.Timer1Timer(Sender: TObject);
var
  Cn : Byte;
begin      //处理角色移动方向改变，记录其XY坐标
 for Cn := 0 to (MaxChr - 1) do
    if ChPon[Cn].Used = 1 then
    begin
      ChPon[cn].Scon := ChPon[Cn].Scon - 1;
      if ChPon[Cn].Scon = 0 then
      begin
        ChPon[Cn].Scon := Random(20) + 20;
        ChPon[Cn].Smov := Random(4);
      end;
      case ChPon[Cn].Smov of
        0: ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
        1: ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
        2: ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
        3: ChPon[Cn].Ypos := ChPon[Cn].Ypos - Mdots;
      end;
      if ChPon[Cn].Xpos < 17 then
      begin
        ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
        ChPon[cn].Smov := 0;
      end
      else if ChPon[Cn].Xpos > DYoko - 49 then
      begin
        ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
        ChPon[Cn].Smov := 1;
      end
      else if ChPon[Cn].Ypos < 17 then
      begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
        ChPon[Cn].Smov := 2;
      end
      else if ChPon[Cn].Ypos > DTate- 49 then
      begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos - Mdots;
        ChPon[Cn].Smov := 3;
      end;   //可移动角色登陆
      MIReg(ChPon[Cn].Sban,ChPon[Cn].Xpos,ChPon[Cn].Ypos);
    end;
    //背景角色登陆，
   MIReg(5,3 * 16,13 * 16);
   MIReg(3,80,11 * 16 - 6);
    MIReg(3,200,11 * 16 + 12);
    MIReg(3,330,11 * 16 - 8);
   MIReg(3,480,11 * 16 + 16);
    LoReg(0,32,32);
    LoReg(0,32,23 * 16);
    LoReg(0,33 * 16,32);
    LoReg(0,33 * 16,23 * 16);
    HiReg(4,17 * 16,12 * 16);

    DpSprite;
    RectM := Rect(16,16,DYoko + 16,DTate + 16);
    RectD := Rect(0,0,DYoko,DTate);
    Rei26.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);
    ClSprite;


end;

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

end;

end.

1，程序大体结构和之前例子差不多，在TIMER中计算角色位置，绘制，刷新。

2，用了IMAGE LIST这个组件来实现零件贴图，

使用了这个组件的2个函数，

ImageList1.AddMasked(IpatBmap,clWhite);这个是添加图片进组件，方式MASK,指定背景色是白色

ImageList1.Draw(BackBmap.Canvas,X * 16 + 16,Y * 16 + 16,P);

ImageList1.Draw(Bmap.Canvas,X1 + CDX * 16,Y1 + CDY * 16,SpDat[Dpon]);

　　这个是单个贴图，最后参数是图样的序号，取代了之前例题中的单个贴图函数。

3，

代码是照着 PDF 书敲的，大部分的编译提示错误可以发现是语法错误，但是在编译通过后出现的BUG 不好排除

现在是出现BUG 后会再三的对照 PDF 检查代码，这不是真正的DEBUG的办法。

通过//减少部分语句的运行，大体确定了是那个函数有问题，最后找出是这个HiReg函数的问题

应该是自动补全功能，但是又没有仔细核对代码。

其实应该还是看变量？设置断点来检查BUG 吗？

发现有很少的书来将这个功能的。

标签：26,end,Cn,16,ChPon,Delphi,List,begin,Dpn
From： https://www.cnblogs.com/D7mir/p/16650119.html

Delphi 经典游戏程序设计40例的学习例26 Image List 的实力与用法

相关文章

赞助商

阅读排行

Delphi 经典游戏程序设计40例 的学习 例26 Image List 的实力与用法

相关文章

赞助商

阅读排行

Delphi 经典游戏程序设计40例的学习例26 Image List 的实力与用法