ICode9

精准搜索请尝试: 精确搜索
首页 > 编程语言> 文章详细

Delphi 经典游戏程序设计40例 的学习 例10 自动滚动功能与简易零件贴图

2022-02-05 17:02:55  阅读:169  来源: 互联网

标签:贴图 10 Canvas Cn 16 ChPon Delphi Byte Yoko


unit rei10;

interface

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

type // 定义精灵 记录类型
  TpatDt = record
    Used : Byte;
    Sban : Byte;
    Xpos : Integer;
    Ypos : Integer;
    Smov : Byte;
    Sadd : Byte;
  end;

  TR10 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure YScroll;
    procedure ChrDi(Sban:Byte;X1,Y1:Integer;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;   //全面显示 图案数,
  MaxMap = 370;      //图案最大数
  ScDot = 2;           // 滚动点数

var
  R10: TR10;
  // 定义 载入用,去除模板用,背景用,绘制用 点阵图,
  LoadBmap,XpatBmap,BackBmap,MakeBmap: TBitmap;
  P,PX,PY,n :Byte;
  RectL,RectB,RectM,RectD :TRect;
  ChPon :array[0..9] of TpatDt;


  Yplus :array[0..20] of Byte = (
  0,10,19,27,34,40,45,49,52,54,55,
  55,54,52,49,45,40,34,27,19,10);
  Smap :array[0..(Yoko -1),0..(MaxMap -1)] of Byte;
   // 图案点,滚动点,绘制点 的定义,初始 设置
  Mpoint : Word = 0;
  Spoint : Integer = 16;
  Ypoint : Integer = 0;
   //复合图案 数组
  Spr00 : array[0..5] of Byte =(2,2,24,25,26,27);
  Spr01 : array[0..5] of Byte = (2,2,28,29,30,31);
  Spr02 : array[0..5] of Byte = (2,2,32,33,48,49);






implementation

{$R *.dfm}

procedure TR10.YScroll;      //图像滚动
var
   X : Byte;

begin
  MakeBmap.Canvas.CopyMode := cmSrcCopy;
  if Spoint <= 16 then
  begin
    RectB := Rect(0,Spoint,DYoko,Dtate + Spoint);
    RectD := Rect(16,16,DYoko + 16,Dtate + 16);
    MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);
  end
  else begin
    RectB := Rect(0,Spoint,DYoko,Dtate + 16);
    RectD := Rect(16,16,Dyoko + 16,Dtate + 32- Spoint);
    MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);
    RectB := Rect(0,0,DYoko,Spoint - 16);
    RectD := Rect(16,Dtate + 32 - Spoint,DYoko + 16,Dtate + 16);
    MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);


  end;
   //ScDot:=2,单次滚动点数  ,Spoint 累计 滚动点数
  Spoint := Spoint - ScDot;
  Ypoint := Ypoint - ScDot;

  if Spoint < 0 then
    Spoint := Dtate + 16 - ScDot;
  if Ypoint < 0  then
    Ypoint := Dtate + 16 - ScDot;

   //累计滚动过16点,绘制一行
  if (Spoint and 15 ) = 0 then
  begin
    for X := 0 to (Yoko -1 ) do
      PatDi(Smap[X, Mpoint],X * 16,Ypoint,BackBmap );
    Mpoint := Mpoint + 1;
    // 最大 绘制 ,归零
    if Mpoint = MaxMap then
      Mpoint := 0 ;

  end;

end;

procedure TR10.ChrDi(Sban:Byte;X1,Y1:Integer;Bmap:TBitmap);
begin
  case Sban of
   0: SbanDi(Spr00,X1 + 16,Y1+ 16,Bmap);
   1: SbanDi(Spr01,X1 + 16,Y1 + 16,Bmap);
   2: SbanDi(Spr02, X1 + 16,Y1 + 16,Bmap);
  end;
end;

procedure TR10.SbanDi(Sary:array of Byte;X1,Y1:Integer;Bmap:TBitmap );
var
  X :Byte;
  Y :Word;

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 <= Date + 16)  then
       PatDi(Sary[n],X1 + X * 16, Y1 + Y *16,Bmap);
       n := n +1;

    end;
end;

procedure TR10.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 TR10.FormCreate(Sender: TObject);
var
  X,Cn :Byte;
  Y    :Word;

begin
  R10.Height := 480;
  R10.Width  := 640;

  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 );
   //设置背景图案
  for Y := 0 to (MaxMap -1) do
    for X := 0 to (Yoko -1 ) do
    begin
      if(X>(Y mod Yoko)) and ((X+ (Y mod Yoko)+1)< Yoko) then
      P := 15
      else if (X < ( Y mod Yoko ))and ((X + (Y mod Yoko )+1) > Yoko)  then
      P := 15
      else if Y < Yoko then
      P := 12
      else if Y < Yoko *2 then
      P := 13
      else if Y < Yoko *3 then
      P := 14
      else if Y < Yoko * 4 then
      P:= 2
      else if  Y < Yoko * 5 then
      P:= 14
      else if Y < Yoko *6 then
      P := 13
      else if Y < Yoko * 7 then
      P:= 12
      else if  Y < Yoko * 8 then
      P:= 13
      else if  Y < Yoko * 9 then
      P:= 14
      else
      P := 15;
      Smap[X,Y ] := P;
    end;

    BackBmap := TBitmap.Create;
    BackBmap.Width:= DYoko;
    BackBmap.Height:= Dtate + 16;

    for Y := 0 to Tate do
    begin
      for X := 0 to ( Yoko  -1 ) do
        PatDi(Smap[X,Y ],X * 16,(Tate - Y )* 16,BackBmap);
      Mpoint := Mpoint + 1;
    end;

    MakeBmap := TBitmap.Create;
    MakeBmap.Width := DYoko + 32;
    MakeBmap.Height := Dtate + 32;
     //设置精灵
    for Cn := 0 to 4 do
    begin
      ChPon[Cn *2 ].Used := 1;
      ChPon[Cn * 2].Sban := 0 ;
      ChPon[Cn * 2].Xpos := Cn *90 + 100;
      ChPon[Cn *2 ].Ypos := (Cn and 1 )* 100 + 200;
      ChPon[Cn *2 ].Smov := 0;
      ChPon[Cn *2 ].Sadd := 0;
      ChPon[Cn *2 + 1].Used := 1;
      ChPon[Cn * 2+1 ].Sban := (Cn and 1 ) +1 ;
      ChPon[Cn * 2+1 ].Xpos := Cn *90 + 100;
      ChPon[Cn *2 +1 ].Ypos := 0;
      ChPon[Cn *2 +1 ].Smov := 1;
      ChPon[Cn *2 +1 ].Sadd := Random(21);
    end;



end;

procedure TR10.tmr1Timer(Sender: TObject);
var
  Cn : Byte;

begin
  // 计算精灵的位置
  for Cn := 0 to 4 do
    if (ChPon[Cn *2 +1].Used = 1) and (ChPon[Cn *2 +1 ].Smov =1) then
    begin
      ChPon[Cn *2 + 1 ].Ypos := ChPon[Cn *2].Ypos - Yplus[ChPon[Cn *2 +1].Sadd];
      ChPon[Cn *2 +1 ].Sadd := ChPon[Cn *2 +1].Sadd +1;
      if ChPon[Cn *2+1].Sadd > 20 then
        ChPon[Cn *2 +1].Sadd := 0;
    end;

  YScroll;
  // 绘制精灵
  for Cn := 0 to 9 do
    if ChPon[Cn].Used = 1 then
      ChrDi(ChPon[Cn].Sban,ChPon[Cn].Xpos, ChPon[Cn].Ypos,MakeBmap);

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


end;

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

end.

 

标签:贴图,10,Canvas,Cn,16,ChPon,Delphi,Byte,Yoko
来源: https://www.cnblogs.com/D7mir/p/15864417.html

本站声明: 1. iCode9 技术分享网(下文简称本站)提供的所有内容,仅供技术学习、探讨和分享;
2. 关于本站的所有留言、评论、转载及引用,纯属内容发起人的个人观点,与本站观点和立场无关;
3. 关于本站的所有言论和文字,纯属内容发起人的个人观点,与本站观点和立场无关;
4. 本站文章均是网友提供,不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属;如您发现该文章侵犯了您的权益,可联系我们第一时间进行删除;
5. 本站为非盈利性的个人网站,所有内容不会用来进行牟利,也不会利用任何形式的广告来间接获益,纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。

专注分享技术,共同学习,共同进步。侵权联系[81616952@qq.com]

Copyright (C)ICode9.com, All Rights Reserved.

ICode9版权所有