Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2004.09.12;
Скачать: [xml.tar.bz2];

Вниз

Посторение тетриса или как можно упростить?   Найти похожие ветки 

 
xoid   (2004-05-17 03:17) [0]

получил курсовую : написать программу тетрис - пока что дела идут неважно
нормальных исходников в сети не нашел - все либо не компиляются, либо используют плохие компаненты =(

может у кого завалялся нормальный исходник?

щас бьюсь над отображением информации

закинул на форуму 200 speedbutton и думаю что с ними делать:
решил сделать так
при нажатии на кнопку происходит следующее begin
x:=1;
y:=1;
fire(x,y);
end;

procedure fire(x,y)
if V[x,y]=1 then V[x,y]:=2
-----------

действия всякие
drow;
end;

А вот самая загвоздка
у нас есть двумерный масссив 1..10, 1..10
мы должны перевести значения в нем на картинки на кнопках и их состояние
procedure drow;
begin

if V[1,1]=1 then begin SpeedButton101.glyph.loadfromfile("1.bmp"); SpeedButton101.enabled:=false; end;

if V[2,1]=1 then begin SpeedButton102.glyph.loadfromfile("1.bmp");
SpeedButton102.enabled:=false; end;

if V[3,1]=1 then begin SpeedButton103.glyph.loadfromfile("1.bmp");
SpeedButton103.enabled:=false; end;

++++++++++++
и так еще 97 раз

нельзя ли как нибудь уростить данную функцию? а то слишком долго и гемморойно =((((


 
Думкин ©   (2004-05-17 06:40) [1]

Дичь какая-то, причем по всем пунктам.
А просто рисовать состояние на канву - не пробовал?


 
Magikan ©   (2004-05-17 11:03) [2]

http://www.screnge.narod.ru/

По этому адресу валяется скриптовой проект для игрушек. Скачай и посмотри скрипты. Там просто и ясно показывается алгоритм игры тетрис. Но только сам алгоритм.


 
Игорь Шевченко ©   (2004-05-17 16:03) [3]

Исходники Тетриса есть в Demos к D8. Называется Netrix.


 
xoid   (2004-05-17 20:01) [4]

тфуу что делает трудный день с людьми
не тетрис а морской бой

от кнопок избавился и теперь у меня что то подобное получилось



var
 Form1: TForm1;
 S:array[1..10,1..10]of integer;
 V:array[1..10,1..10]of integer;
 game:boolean;
 Vshutted,Vkilled,sshutted,skilled,VS,SS:integer;
implementation

{$R *.dfm}

function check(x,y:integer):boolean;
   var
   x1,y1:integer;
   begin
       if v[x,y]<=0    then       begin
       if x-1<=0 then x1:=2 else x1:=x;
         if x+1>10 then x1:=9 else x1:=x;
         if y-1<=0 then y1:=2 else y1:=y;
         if y+1>10 then y1:=9 else y1:=y;
             if (v[x1-1,y1-1]<=0)
and (v[x1+1,y1-1]<=0)
and (v[x1+1,y1+1]<=0)
and (v[x1-1,y1+1]<=0)
and (v[x,y1+1]<=0)
and (v[x,y1-1]<=0)
and (v[x1-1,y]<=0)
and (v[x1+1,y]<=0)
              then check:=true else  check:=false;
                                              end else  check:=false;

   end;

    function die1(x,y:integer):boolean;
   var
   x1,y1:integer;
   begin

       if x-1<=0 then x1:=2 else x1:=x;
         if x+1>10 then x1:=9 else x1:=x;
         if y-1<=0 then y1:=2 else y1:=y;
         if y+1>10 then y1:=9 else y1:=y;
             if  (v[x,y1+1]=1)
or (v[x,y1-1]=1)
or (v[x1-1,y]=1)
or (v[x1+1,y]=1)
              then die1:=false else  die1:=true;

           end;

function fire(x,y:integer):boolean;
var
i,j:integer;
begin

if V[x,y]=2 then
       begin
         fire:=false;

       end else begin
if V[x,y]=0 then V[x,y]:=2;
if v[x,y]=1 then

begin
if not die1(x,y) then
       begin
         V[x,y]:=4;
         inc(Vshutted);
         end
         else
             begin
             V[x,y]:=3;
             inc(Vkilled);
                inc(Vshutted);
end;              end;  fire:=true;  end;

end;

function die2(x,y:integer):boolean;
   var
   x1,y1:integer;
   begin

       if x-1<=0 then x1:=2 else x1:=x;
         if x+1>10 then x1:=9 else x1:=x;
         if y-1<=0 then y1:=2 else y1:=y;
         if y+1>10 then y1:=9 else y1:=y;
             if  (s[x,y1+1]=1)
or (s[x,y1-1]=1)
or (s[x1-1,y]=1)
or (s[x1+1,y]=1)
              then die2:=false else  die2:=true;

           end;

function attack:boolean;
var
x,y:integer;
begin
 Randomize;
 attack:=false;
x:=random(10)+1;
y:=random(10)+1;

if s[x,y]=1 then
       begin
        attack:=true;
        inc(ss);
if not die2(x,y) then
       begin
         s[x,y]:=4;
         inc(sshutted);
         end
         else
             begin
             s[x,y]:=3;
             inc(skilled);
             inc(ss);

  end;   attack;  end else
  begin
  if s[x,y]<>0 then attack else begin
  s[x,y]:=2;
  inc(ss); end;
     end;

end;

function mark(x,y,ori,j:integer):boolean;
var
i,i1,count,verh:integer;

begin // 1
 Randomize;
 count:=0;  //??????? ????????? ???? = 0

  verh:=random(2); //???? ??????? ???????
 if check(x,y) then begin // 2

                     if ori=1 then   begin  // ???? ??????????? ??????? ?? .....
      if verh=1 then  begin // ???? 1 ?? ????? ??????? ????? ?? ?????     ----------------------------------------

                   for i:=0 to 3 do   begin // 4
          if (check(x,y-i)) and (y-i>=1) and (count<j) then
                             begin  //5
                             inc(count);     //??????????? ??????? ???????????? ?? ???????
                              v[x,y-i]:=-4;   // ????????? ??? ???????
                             end else break;   //5
                   end;  //4

                   for i:=1 to 3 do   begin  //6
         if (check(x,y+i)) and (y+i<=10) and (count<j) then
                           begin   //7
                           inc(count);
                           v[x,y+i]:=-4;
                           end else break;    //7
             end;       end  //6
          else  begin    // ????? ??????? ????????

for i:=0 to 3 do   begin  //6
           if (check(x,y+i)) and (y+i<=10) and (count<j) then
                           begin   //7
                           inc(count);
                           v[x,y+i]:=-4;
                           end else break;    //7
                    end;  //6
               for i:=1 to 3 do   begin // 4
          if (check(x,y-i)) and (y-i>=1) and (count<j) then
                             begin  //5
                             inc(count);     //??????????? ??????? ???????????? ?? ???????
                              v[x,y-i]:=-4;   // ????????? ??? ???????
                             end else break;     //5
               end;    end;  //4
                           end

                      else
                       begin
       if verh=1 then begin
for i:=0 to 3 do   begin //8
  if (check(x-i,y)) and (x-i>=1) and (count<j) then
                          begin    //9
                          inc(count);
                           v[x-i,y]:=-4;
                          end else break;     //9
                   end;     //8

                   for i:=1 to 3 do   begin  //10
  if (check(x+i,y)) and (x+i<=10) and (count<j) then
                         begin  //11
                         inc(count);
                         v[x+i,y]:=-4;
                         end else break;    //11

             end;             end //10

  else   begin
for i:=0 to 3 do   begin  //10
  if (check(x+i,y)) and (x+i<=10) and (count<j) then
                         begin  //11
                         inc(count);
                         v[x+i,y]:=-4;
                         end else break;    //11

                          end; //10
   for i:=1 to 3 do   begin //8
  if (check(x-i,y)) and (x-i>=1) and (count<j) then
                          begin    //9
                          inc(count);
                           v[x-i,y]:=-4;
                          end else break;     //9
                   end; end;    //8
                          end;

                          if count=j then
                                                      begin //18
                               for i:=1 to 10   do
                                for i1:=1 to 10 do
                                   begin //19
                                 if V[i,i1]=-4 then V[i,i1]:=1;
                                   end;    //19
                                        mark:=true;
                          end else  begin          //18    //20
                              for i:=1 to 10   do
                                for i1:=1 to 10 do
                                  begin //21
                                    if V[i,i1]=-4 then V[i,i1]:=0;
                                  end;  //21
                                       //  mark:=false;
                                  end; //20

                            //12

            end //2
       else mark:=false;  // ???? ?????? ?????? ?? ??????????? ???? ????
  end;  //1


 
xoid   (2004-05-17 20:02) [5]


procedure rasstanovka;
var
ori,x,y,i,j:integer;
t:boolean;
begin
   Randomize;
 for i:=4 downto 1 do begin //i-????????? ?????
for j:=1 to 5-i do      //j-?????????? ????????
repeat
t:=false;
x:=random(10)+1;
y:=random(10)+1;

ori:=random(2);
if mark(x,y,ori,i) then t:=true;
     until t=true;
    end;
    end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
 var x,y:integer;
 begin
  if game=false then
               begin
                 x:=acol;
                 y:=arow;
              if S[x,y]=0 then S[x,y]:=1 else s[x,y]:=0;
               button2.Click;
              end;

end;

procedure TForm1.StringGrid2SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
 var x,y:integer;
 
begin
 if game then
               begin
               if Skilled=20 then game:=false ;
               if vkilled=20 then game:=false;
                 x:=acol;
                 y:=arow;
              if (fire(x,y)) and (game) then begin button1.click;
             inc(vs);
             attack;
              button2.click;

              end;
              end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
game:=true;
clear(5);
button1.click;
rasstanovka;
button1.click;
button2.click;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 10 do
for j:=1 to 10 do    begin
if  V[i,j]=1 then Stringgrid2.cells[i,j]:="[ ]";
if   V[i,j]=0 then Stringgrid2.cells[i,j]:=" ";
if   V[i,j]=2 then Stringgrid2.cells[i,j]:="*";
if   V[i,j]=3 then Stringgrid2.cells[i,j]:="[x]";
if   V[i,j]=4 then Stringgrid2.cells[i,j]:="x";
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 10 do
for j:=1 to 10 do    begin
if  s[i,j]=1 then Stringgrid1.cells[i,j]:="[ ]";
if   s[i,j]=0 then Stringgrid1.cells[i,j]:=" ";
if   s[i,j]=2 then Stringgrid1.cells[i,j]:="*";
if   s[i,j]=3 then Stringgrid1.cells[i,j]:="[x]";
if   s[i,j]=4 then Stringgrid1.cells[i,j]:="x";
end;

end;



самый прикол что мой долбанный алгорим расстановки 10 раз делает все нормально, на 12 генерирует фигню =(
что делать незнаю

кроме того надо реализовать чтобы в случае попадания мне давался еще 1н ход - компу он дается =)))))))))


 
kas-t   (2004-05-18 20:27) [6]

Игроделы млин... :) Как же ты на кнопках тетрис то напишешь!? :) Рисуй все в канву.

Делаешь двумерный массив размерами с поле, и уже его обрабатываешь, таскаешь там значения по массиву по правилам тетриса. И отдельно пиши процедуру, которая бы рисовала состояние массива в канву. Лучше уже не придумать.

А за кнопки тебе пятерку не поставят :).


 
Papai ©   (2004-05-19 09:58) [7]

У меня есть, 263-317-621


 
xoid   (2004-05-19 21:30) [8]

что есть?
и что за цифры?


 
delin   (2004-05-21 08:09) [9]

xoid, почту проверь я там тебе архивчик выслала


 
delin   (2004-05-21 08:25) [10]

может есть у кого нибудь прога с генерацией самолетиков и радар, который пишет данные самолета в txt файл при попаданиии в его область


 
TUser ©   (2004-05-21 08:40) [11]


> может есть у кого нибудь прога с генерацией самолетиков
> и радар, который пишет данные самолета в txt файл при попаданиии
> в его область

Эх, кто бы мне подкинул движок от американской программы управления межконтинентаьной ракетой *)



Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2004.09.12;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.53 MB
Время: 0.079 c
14-1093340593
NikotiN
2004-08-24 13:43
2004.09.12
Алгоритм сортировки


4-1091182248
IllusoryOrion
2004-07-30 14:10
2004.09.12
Свой Shell + internat.exe


4-1091367247
Seldon
2004-08-01 17:34
2004.09.12
Сколько памяти кушаем?


6-1087534420
atruhin
2004-06-18 08:53
2004.09.12
Сокет на Win API


3-1091855712
SergP
2004-08-07 09:15
2004.09.12
Восстановление БД Oracle





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский