Листинг 2

unit sprites;
interface

uses  bmpread;

const
   Xsize = 20;                {размеры спрайта, точек}
   Ysize = 20;
   TransparentColor = $FF;         {?прозрачный? цвет}
type
   SpriteArrayType =
             array[0..Ysize-1,0..Xsize-1]of byte;
                    {массив, равный по размеру спрайту}
   SpriteType = record
     x,y  : word;         {текущие координаты спрайта}
     dx,dy : integer;   {приращения координат спрайта}
     Img  : ^SpriteArrayType;
                  {для массива с изображением спрайта}
     Back : ^SpriteArrayType;
             {для массива, хранящего фон под спрайтом}
   end;
   ScreenType = array[0..199,0..319]of byte;
                                          {для экрана}
var
   Scr  : ^ScreenType;                         {экран}
   p    : array[0..767]of byte;

procedure GetBuffer(Sprite:SpriteType);
               {сохранение фона под спрайтом в буфере}
procedure PutBuffer(Sprite:SpriteType);
                                 {восстановление фона}
procedure PutSprite(Sprite:SpriteType);
                              {вывод спрайта на экран}
procedure CreateSprite(s:string; x,y,dx,dy:integer;
         var Sprite:SpriteType);  {?создание? спрайта}
procedure DestroySprite(Sprite:SpriteType);
                               {?уничтожение? спрайта}
procedure CalcSpritePosition(var Sprite:SpriteType);
                  {вычисление новых координат спрайта}
procedure PutBackground;     {создание фона на экране}

implementation

procedure GetBuffer(Sprite:SpriteType);
               {сохранение фона под спрайтом в буфере}
var
   i,j    : word;      {переменные цикла}
begin
   for j := 0 to Ysize-1 do
      for i := 0 to Xsize-1 do
         with Sprite do
            Back^[j,i] := Scr^[j+y,i+x];
end;

procedure PutBuffer(Sprite:SpriteType);
                                 {восстановление фона}
var
   i,j    : word;      {переменные цикла}
begin
   for j := 0 to Ysize-1 do
      for i := 0 to Xsize-1 do
         with Sprite do
            Scr^[j+y,i+x] := Back^[j,i];
end;

procedure PutSprite(Sprite:SpriteType);
                              {вывод спрайта на экран}
var
   i,j    : word;      {переменные цикла}
begin
   for j := 0 to Ysize-1 do
      for i := 0 to Xsize-1 do
         with Sprite do
            if Img^[j,i] <> TransparentColor then
                    {ставим только точки,}
            {цвет которых отличается от ?прозрачного?}
               Scr^[j+y,i+x] := Img^[j,i];
end;

procedure CreateSprite(s:string; x,y,dx,dy:integer;
         var Sprite:SpriteType);  {?создание? спрайта}
var
   f : file;      {файл с изображением спрайта}
begin
   getmem(Sprite.Img,sizeof(SpriteArrayType));
                         {выделяем память для спрайта}
   getmem(Sprite.Back,sizeof(SpriteArrayType));
                          {выделяем память для буфера}
   Readbmp(@(Sprite.Img^),Xsize,Ysize,@p,s);
   Sprite.x := x;
   Sprite.y := y;     { задаем начальные значения }
   Sprite.dx := dx;    {  координат и приращений   }
   Sprite.dy := dy;
end;

procedure DestroySprite(Sprite:SpriteType);
                               {?уничтожение? спрайта}
begin
 { возвращаем память }
   freemem(Sprite.Back,sizeof(SpriteArrayType));
   freemem(Sprite.Img,sizeof(SpriteArrayType));
end;

procedure CalcSpritePosition(var Sprite:SpriteType);
                  {вычисление новых координат спрайта}
begin                       { спрайта и их приращений}
 {по достижении границы экрана делаем,}
   { чтобы спрайт ?отразился? от нее}
   with Sprite do begin
      if (x + Xsize + dx) >= 319 then
         dx := -dx;       {вычисляем новые приращения}
      if (x + dx) <= 0 then
         dx := -dx;          {реализующие ?отражение?}
      if (y + Ysize + dy) >= 199 then
         dy := -dy;                {спрайта от стенок}
      if (y + dy) <= 0 then
         dy := -dy;
      x := x+dx;                {   вычисляем новые  }
      y := y+dy;                { координаты спрайта }
   end;
end;

procedure PutBackground;     {создание фона на экране}
var
   i,j    : word;      {переменные цикла}
begin
   for j := 0 to 199 do
      for i := 0 to 319 do
         Scr^[j,i] := lo(i+j*8);
end;

begin
   scr := ptr(SegA000,0);         {указатель на экран}
end.

назад