RSS    

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

     FillChar(WasPressed,SizeOf(WasPressed),FALSE);

     CheckWarmReboot:=TRUE;

     WarmRebootFlag:=FALSE;

     Init:=TRUE;

   end;

end;

Procedure DoneButtons;

begin

   if Init then

   begin

     SetIntVec($9,OldKbdHandler);

     WarmRebootFlag:=FALSE;

     Init:=FALSE;

   end;

end;

Function ButtonsInited;

begin

   ButtonsInited:=Init;

end;

Function IsKeypressed;

Var

   i:Byte;

   f:Boolean;

begin

   f:=false;

   i:=1;

   While (i<=128) and not f do

   begin

     f:=Key[i];

     Inc(i);

   end;

   IsKeypressed:=f;

end;

Function Pressed;

begin

   if WasPressed[Index] then

   begin

     WasPressed[Index]:=FALSE;

     Pressed:=TRUE;

   end else Pressed:=FALSE;

end;

Procedure ClearKeys;

begin

   FillChar(Key,SizeOf(Key),false);

   FillChar(WasPressed,SizeOf(WasPressed),false);

end;

END.

UNIT LogoScreen;

INTERFACE

IMPLEMENTATION

uses graph,crt;

const

     a = 'Vera & Yulya presents';

     b = '           science game';

     d = '               for kids';

     e = 'Magnitogorsk - 2001';

     t = 'Siege';

var driver,mode,x1,x,y,

color:integer;i,j:word;

    x2,y2,o:array[1..500] of integer; g,n:integer;

    label 1;

begin

  detectgraph(driver,mode);

  initgraph(driver,mode,'c:\');

  if graphresult<>0 then write('Ошибка!')

  else for g:=1 to 500 do

  begin

    n:=random(18);

    case n of

         1: o[g]:=1;

         2: o[g]:=3;

         3: o[g]:=4;

         4: o[g]:=5;

         5: o[g]:=9;

         6: o[g]:=11;

         7: o[g]:=12;

         8: o[g]:=13;

         9: o[g]:=14;

        10: o[g]:=15

    end;

    x2[g]:=random(640);

    y2[g]:=random(480);

    putpixel(x2[g],y2[g],o[g])

   end;

   setcolor(9);

begin

  j:=getmaxx-250;

  i:=1;

  settextstyle(7,0,4);

  while i<=getmaxx-length(a)-400 do

  begin

    setcolor(black);

    outtextxy(i-length(a)-2,10,a);

    outtextxy(j+2,50,b);

    outtextxy(j+2,90,d);

    setcolor(1+random(14));

    outtextxy(i-length(a),10,a);

    outtextxy(j,50,b);

    outtextxy(j,90,d);

    j:=j-2;

    i:=i+2;

    if keypressed then goto 1;

  end;

  color:=getcolor;

  settextstyle(4,0,1);

  for i:=1 to 10 do

  begin

    setcolor(black);

    outtextxy(230,getmaxy-20-i+1,e);

    delay(100);

    setcolor(color);

    outtextxy(230,getmaxy-20-i,e);

  end;

  settextstyle(4,0,15);

  setviewport(1,1,639,479,false);

  repeat

    for i:=15 downto 1 do

    begin

      if(i=1)or(i=5)then continue;

      setcolor(i);

      outtextxy((GetMaxX div 2)-(TextWidth(t) div 2),180,t);

      delay(100);

    end;

    for i:=1 to 15 do

    begin

      if(i=1)or(i=5)then continue;

      setcolor(i);

      outtextxy((GetMaxX div 2)-(TextWidth(t) div 2),180,t);

      delay(100);

    end;

  until keypressed;

1:

  setcolor(black);

  setfillstyle(1,1);

  SetBkcolor(1);

  setviewport(1,1,639,479,true);

  for i:=1 to 90 do

  begin

    sector(getmaxx div 2,getmaxy div 2,0,i,400,400);

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

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

    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),

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


Новости


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

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

Пока нет

Новости в Twitter и Facebook

                   

Новости

© 2010.