скачать рефераты
  RSS    

Меню

Быстрый поиск

скачать рефераты

скачать рефератыРеферат: Разработка игровой программы на языке программирования Turbo Pascal

    sector(getmaxx div 2,getmaxy div 2,270,270+i,400,400);

  end;

  setcolor(Magenta);

  settextstyle(7,0,8);

  outtextxy((getmaxx div 2)-(TextWidth('Good luck!!!') div 2),

            (getmaxy div 2)-180,'Good luck!!!');

  Delay(1000);

  closegraph;

end;

END.

UNIT Retrace;

INTERFACE

Procedure WaitRetraceMode;

IMPLEMENTATION

Procedure WaitRetraceMode;

begin

   While Port[$3DA] and 8<>0 do;

end;

END.

UNIT SiegeLogo;

INTERFACE

Uses Buttons, VGA13h;

Type

    PFont = ^TFont;

    TFont = Array [0..255,0..7] of Byte;

Var

   Font:PFont;

Procedure DrawString(Base:Word;xp,yp:Integer;Const s:String); Function Logo:Byte;                        

Procedure Info;                           

Procedure Story;                          

IMPLEMENTATION

Procedure DrawString;

Var

   x,y,l,t:Byte;

begin

   if Byte(s[0])>0 then

   begin

     for l:=1 to Byte(s[0]) do

     begin

       for y:=0 to 7 do

       begin

         t:=Font^[Byte(s[l])][y];

         for x:=0 to 7 do

         begin

           if t and 128=128 then PutPixel(Base,xp+x,yp+y,15);

           t:=t shl 1;

         end;

       end;

       xp:=xp+8;

     end;

   end;

end;

Function Logo;

Var

   Res,Old:Byte;

begin

   ClearKeys;

   Old:=0;

   Res:=1;

   ClearBase(Base1);

   DrawString(Base1,30,60,'Play the game');

   DrawString(Base1,30,70,'Instructions');

   DrawString(Base1,30,80,'Story');

   DrawString(Base1,30,90,'Exit to DOS');

   Repeat

     if Old<>Res then

     begin

       Bar(Base1,20,60,28,100,0);

       DrawString(Base1,20,60+(Res-1)*10,'>');

       Old:=Res;

     end;

     if Pressed(keyUp) then

     begin

       Res:=Res-1;

       if Res<1 then Res:=4;

     end;

     if Pressed(keyDown) then

     begin

       Res:=Res+1;

       if Res>4 then Res:=1;

     end;

   Until Key[keyEnter];

   Logo:=Res;

end;

Procedure Center(y:Integer;Const s:String);

begin

   DrawString(Base1,160-(Length(s)*8 div 2),y,s);

end;

Procedure Info;

begin

   ClearBase(Base1);

   Center(2,'Instructions');

   Center(20,'Arrows - moving Hero');

   Center(30,'Space - throw stone');

   Center(40,'Esc - exit the game');

   Center(190,'Press any key');

   ClearKeys;

   Repeat Until IsKeypressed;

end;

Procedure Story;

begin

 ClearBase(Base1);

 Center(2,'Предыстория');

 DrawString(Base1,1,20,'Много лет назад на Землю упал метеорит.');

 DrawString(Base1,1,30,'При исследовании в лаборатории ученые  ');

 DrawString(Base1,1,40,'обнаружили в нем биологическое вещес-  ');

 DrawString(Base1,1,50,'тво внеземного происхождения. Поняв всю');

 DrawString(Base1,1,60,'опасность этого вируса, они попытались ');

 DrawString(Base1,1,70,'нейтрализовать его.Но вирус стал быстро');

 DrawString(Base1,1,80,'распространяться и заразил всех участни ');

 DrawString(Base1,1,90,'ков исследования. Выйдя за стены лабора-');

 DrawString(Base1,1,100,' тории он стал зарожать людей.Зараженные');

 DrawString(Base1,1,110,'вирусом внешне не отличались от обычных');

 DrawString(Base1,1,120,'людей, но подчинялись внеземному разуму.');

 DrawString(Base1,1,130,'Их задачей было:уничтожить оставшееся ');

 DrawString(Base1,1,140,'население.Тогда люди стали объединять- ');

 DrawString(Base1,1,150,'ся,чтобы защитить себя. Они устроили ');

 DrawString(Base1,1,160,'засаду в крепости. Но агрессивных "лик-');

 DrawString(Base1,1,170,'видаторов ничто не могло остановить.....');

 ClearKeys;

   Repeat Until IsKeypressed;

end;

END.

UNIT SiegeSpr;

INTERFACE

Const 

     BrickHgt = 10;

     BrickWdt = 10;

     BrickSpr:Array [1..BrickHgt,1..BrickWdt] of Byte =

     ((7,7,7,7,7,7,7,7,7,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (7,7,7,7,7,7,7,7,7,7),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4));

Const 

     StoneHgt = 8;

     StoneWdt = 8;

     StoneSpr:Array [1..StoneHgt,1..StoneWdt] of Byte =

     ((0,0,8,8,8,8,0,0),

      (0,8,7,7,8,8,8,0),

      (8,7,8,8,8,8,8,8),

      (8,7,8,8,8,8,8,8),

      (8,8,8,8,8,8,8,8),

      (8,8,8,8,8,8,8,8),

      (0,8,8,8,8,8,8,0),

      (0,0,8,8,8,8,0,0));

Const 

     ManHgt = 20;

     ManWdt = 16;

     ManSpr:Array [1..2,1..ManHgt,1..ManWdt] of Byte =

     (((00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00, 7, 7, 7, 7,00,00,00,00,00,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

       (00,00,00,00,00, 7,15,15,15,15, 7,00,00,00,00,00),

       (00,00,00,00,00,15, 3, 1, 1, 3,15,00,00,00,00,00),

       (00,00,00,00,00,15,15,15,15,15,15,00,00,00,00,00),

       (00,00,00,00,00,15,15, 8, 8,15,15,00,00,00,00,00),

       (00,00,00,00,00,15,15,13,13,15,15,00,00,00,00,00),

       (00,00,00,00,00,00,15,15,15,15,00,00,00,00,00,00),

       (00,00,00,00,12,12,15,15,15,15,12,12,00,00,00,00),

       (00,12,12,12,12,12,12,14,14,12,12,12,12,12,12,00),

       (12,12,12,12,12,12,12,14,14,12,12,12,12,12,12,12),

       (12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),

       (12,12, 8,12,12,12,12,12,12,12,12,12,12, 8,12,12),

       (12,12, 8,12,12,12,12,12, 8,12,12,12,12, 8,12,12),

       (12,12, 8,12,12,12,12,12,12,12,12,12,12, 8,12,12),

       (12,12, 8,12,12,12,12,12, 8,12,12,12,12, 8,12,12)),

      ((00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

       (00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

       (00,00,12,12,00,00,00,00,00,00,00,00,12,12,00,00),

       (00,00,12,12,00,00,00,00,00,00,00,00,12,12,00,00),

       (00,00,12,12,00,00, 7, 7, 7, 7,00,00,12,12,00,00),

       (00,00,12,12,00, 7, 7, 7, 7, 7, 7,00,12,12,00,00),

       (00,12,12,00,00, 7,15,15,15,15, 7,00,00,12,12,00),

       (00,12,12,00,00,15, 3, 1, 1, 3,15,00,00,12,12,00),

       (00,12,12,00,00,15,15,15,15,15,15,00,00,12,12,00),

       (00,12,12,00,00,15,15, 8, 8,15,15,00,00,12,12,00),

       (00,12,12,00,00,15,15,13,13,15,15,00,00,12,12,00),

       (00,12,12,12,00,00,15,15,15,15,00,00,12,12,12,00),

       (00,00,12,12,12,12,15,15,15,15,12,12,12,12,00,00),

       (00,00,12,12,12,12,12,14,14,12,12,12,12,12,00,00),

       (00,00,12,12,12,12,12,14,14,12,12,12,12,12,00,00),

       (00,00,12,12,12,12,12,12,12,12,12,12,12,12,00,00),

       (00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

       (00,00,00,12,12,12,12,12, 8,12,12,12,12,00,00,00),

       (00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

       (00,00,00,12,12,12,12,12, 8,12,12,12,12,00,00,00)));

Const

     EnemyHgt = 42;

     EnemyWdt = 16;

     EnemySpr:Array [1..2,1..EnemyHgt,1..EnemyWdt] of Byte =

     (((00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,10,10,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,10,10,00),

       (00,00,00,00,00,00, 7, 7, 7, 7,00,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,10,10,00),

       (00,00,00,00,00,15, 7, 7, 7, 7,15,00,00,10,10,00),

       (00,00,00,00,00,15, 7, 7, 7, 7,15,00,00,10,10,00),

       (00,00,00,00,00,00,15,15,15,15,00,00,10,10,10,00),

       (00,00,00,00,10,10,15,15,15,15,10,10,10,10,00,00),

       (00,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

       (10,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

       (10,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

       (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

       (00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

       (00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

       (00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

       (00, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,00,00,00),

       ( 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8, 8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

       (00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

       (00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00)),

      ((00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,10,10,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,10,10,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,10,10,00,00,00, 7, 7, 7, 7,00,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

       (00,10,10,00,00,15, 7, 7, 7, 7,15,00,00,00,00,00),

       (00,10,10,00,00,15, 7, 7, 7, 7,15,00,00,00,00,00),

       (00,10,10,10,00,00,15,15,15,15,00,00,00,00,00,00),

       (00,00,10,10,10,10,15,15,15,15,10,10,10,10,00,00),

       (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,00),

       (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,10),

       (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,10),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00),

       (00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,00),

       (00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8, 8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00)));

IMPLEMENTATION

END.

UNIT VGA13h;

INTERFACE

Type

    PScreen = ^TScreen;

    TScreen = Array [0..199,0..319] of Byte;

Const

     ScreenHeight               = 200;

     ScreenWidth                = 320;

     GetMaxY                    = ScreenHeight-1;

     GetMaxX                    = ScreenWidth-1;

     MidX                       = GetMaxX div 2;

     MidY                       = GetMaxY div 2;

     PageSize                   = ScreenHeight*ScreenWidth;

     QuarterSize                = PageSize div 4;

     VideoSegment:Word          = 0;

     Base1:Word                 = 0;

     Base2:Word                 = 0;

     Page1:PScreen              = NIL;

     Page2:PScreen              = NIL;

Function  DetectVGA:Boolean;

Procedure SetGraphMode;

Procedure SetTextMode;

Procedure MakePixelSquare;                                    

Procedure CopyBase(Source,Destin:Word);

Procedure ClearBase(Base:Word);

Procedure FillBase(Base,Ofs,Count:Word;Color:Longint);

Procedure MoveBase(Source,Destin,Count:Word);

Procedure TileBase(Base,Ofs,Count:Word;Tile:Pointer;Len:Word);

Procedure PutPixel(Base:Word;x,y:Integer;Color:Byte);

Function  GetPixel(Base:Word;x,y:Integer):Byte;               

Procedure Line(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);

Procedure VLine(Base:Word;x,y1,y2:Integer;Color:Byte);

Procedure HLine(Base:Word;y,x1,x2:Integer;Color:Byte);        

Procedure Bar(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);      

Procedure Polygon(Base:Word;x1,y1,x2,y2,x3,y3,x4,y4:Integer;c:Byte);

Function  InitVirtualPage:Boolean;

Procedure DoneVirtualPage;                                    

IMPLEMENTATION

Var

   VirtualPage:Pointer;

{$L VGA13H.OBJ}

Function  DetectVGA;       external;

Procedure SetGraphMode;    external;

Procedure SetTextMode;     external;

Procedure MakePixelSquare; external;

Procedure CopyBase;        external;

Procedure ClearBase;       external;

Procedure FillBase;        external;

Procedure MoveBase;        external;

Procedure TileBase;        external;

Procedure PutPixel;        external;

Function  GetPixel;        external;

Procedure HLine;           external;

Procedure VLine;           external;

Procedure Polygon;

Var

  xpos:array [0..199,0..1] of Word;

  mny,mxy,y:Integer;

  i:Word;

  s1,s2,s3,s4:Shortint;

begin

  mny:=y1;

  if y2<mny then mny:=y2;

  if y3<mny then mny:=y3;

  if y4<mny then mny:=y4;

  mxy:=y1;

  if y2>mxy then mxy:=y2;

  if y3>mxy then mxy:=y3;

  if y4>mxy then mxy:=y4;

  s1:=byte(y1<y2)*2-1;

  s2:=byte(y2<y3)*2-1;

  s3:=byte(y3<y4)*2-1;

  s4:=byte(y4<y1)*2-1;

  y:=y1;

  if y1<>y2 then

  Repeat

    xpos[y,byte(y1<y2)]:=integer(x2-x1)*(y-y1) div (y2-y1)+x1;

    y:=y+s1;

  Until y=y2+s1

  else xpos[y,byte(y1<y2)]:=x1;

  y:=y2;

  if y2<>y3 then

  Repeat

    xpos[y,byte(y2<y3)]:=integer(x3-x2)*(y-y2) div (y3-y2)+x2;

    y:=y+s2;

  Until y=y3+s2

  else xpos[y,byte(y2<y3)]:=x2;

  y:=y3;

  if y3<>y4 then

  Repeat

    xpos[y,byte(y3<y4)]:=integer(x4-x3)*(y-y3) div (y4-y3)+x3;

    y:=y+s3;

  Until y=y4+s3

  else xpos[y,byte(y3<y4)]:=x3;

  y:=y4;

  if y4<>y1 then

  Repeat

    xpos[y,byte(y4<y1)]:=integer(x1-x4)*(y-y4) div (y1-y4)+x4;

    y:=y+s4;

  Until y=y1+s4

  else xpos[y,byte(y1<y4)]:=x4;

  for y:=mny to mxy do HLine(Base,y,xpos[y,0],xpos[y,1],c);

end;

Procedure Line;

Var

   dx,dy,sx,sy,d,d1,d2,x,y,i:Integer;

begin

   dx:=Abs(x2-x1);

   dy:=Abs(y2-y1);

   if x2>=x1 then sx:=+1 else sx:=-1;

   if y2>=y1 then sy:=+1 else sy:=-1;

   Mem[Base:(y1 shl 8)+(y1 shl 6)+x1]:=Color;

   if dy<=dx then

   begin

     d:=(dy shl 1)-dx;

     d1:=dy shl 1;

     d2:=(dy-dx) shl 1;

     x:=x1+sx;

     y:=y1;

     for i:=1 to dx do

     begin

       if d>0 then

       begin

         d:=d+d2;

         y:=y+sy;

       end else d:=d+d1;

       Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;

       x:=x+sx;

     end;

   end

   else begin

     d:=(dx shl 1)-dy;

     d1:=dx shl 1;

     d2:=(dx-dy) shl 1;

     x:=x1;

     y:=y1+sy;

     for i:=1 to dy do

     begin

       if d>0 then

       begin

         d:=d+d2;

         x:=x+sx;

       end else d:=d+d1;

       Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;

       y:=y+sy;

     end;

   end;

end;

Procedure Bar;

Var

   Row,Column:Integer;

begin

  for Row:=y1 to y2 do

    for Column:=x1 to x2 do

      Mem[Base:(Row shl 8)+(Row shl 6)+Column]:=Color;

end;

Function InitVirtualPage;

Var

   Temp:Longint;

begin

   VirtualPage:=NIL;

   Base2:=0;

   Page2:=NIL;

   InitVirtualPage:=false;

   GetMem(VirtualPage,PageSize+15);

   Temp:=(Longint(Seg(VirtualPage^)) shl 4)+Longint(Ofs(VirtualPage^));

   if Temp and $F<>0 then Temp:=(Temp shr 4)+1 else Temp:=Temp shr 4;

   Base2:=Temp;

   Page2:=Ptr(Base2,0);

   ClearBase(Base2);

   InitVirtualPage:=true;

end;

Procedure DoneVirtualPage;

begin

   FreeMem(VirtualPage,PageSize+15);

   VirtualPage:=NIL;

   Base2:=0;

   Page2:=NIL;

end;

{==================================================================}

BEGIN

   VideoSegment:=SegA000;

   Base1:=VideoSegment;

   Page1:=Ptr(Base1,0);

   InitVirtualPage;

END.

UNIT VGASpr;

INTERFACE

Uses VGA13h;

Type

    BA=Array [0..$FFF0] of Byte;

Var

   TopX,TopY,BotX,BotY:Integer;

Procedure SetClipRect(x1,y1,x2,y2:Integer);

Procedure DrawTSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); Procedure DrawOSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); IMPLEMENTATION

Procedure SetClipRect;

  Function Max(a,b:Integer):Integer;

  begin

     if a>b then Max:=a else Max:=b;

  end;

  Function Min(a,b:Integer):Integer;

  begin

     if a<b then Min:=a else Min:=b;

  end;

begin

   TopX:=Max(0,Min(x1,x2));

   BotX:=Min(GetMaxX,Max(x1,x2));

   TopY:=Max(0,Min(y1,y2));

   BotY:=Min(GetMaxY,Max(y1,y2));

end;

Procedure DrawTSpr;

Var

   fx,fy,x1,y1,x2,y2:Word;

   c:Byte;

begin

   if (x+w-1<TopX) or (y+h-1<TopY) or (x>BotX) or (y>BotY) then Exit;

   if x<TopX then x1:=Abs(x) else x1:=0;

   if y<TopY then y1:=Abs(y) else y1:=0;

   if x+w>BotX then x2:=BotX-x else x2:=w-1;

   if y+h>BotY then y2:=BotY-y else y2:=h-1;

   for fy:=y1 to y2 do

     for fx:=x1 to x2 do

     begin

       c:=BA(Image^)[fy*w+fx];

       if c<>0 then Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=c;

     end;

end;

Procedure DrawOSpr;

Var

   fx,fy,x1,y1,x2,y2:Word;

begin

   if (x+w-1<TopX) or (y+h-1<TopY) or (x>BotX) or (y>BotY) then Exit;

   if x<TopX then x1:=Abs(x) else x1:=0;

   if y<TopY then y1:=Abs(y) else y1:=0;

   if x+w>BotX then x2:=BotX-x else x2:=w-1;

   if y+h>BotY then y2:=BotY-y else y2:=h-1;

   for fy:=y1 to y2 do

     for fx:=x1 to x2 do

       Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=BA(Image^)[fy*w+fx];

end;

BEGIN

   SetClipRect(0,0,GetMaxX,GetMaxY);

END.


Страницы: 1, 2, 3


Новости

Быстрый поиск

Группа вКонтакте: новости

Пока нет

Новости в Twitter и Facebook

  скачать рефераты              скачать рефераты

Новости

скачать рефераты

Обратная связь

Поиск
Обратная связь
Реклама и размещение статей на сайте
© 2010.