Текущий архив: 2004.09.12;
Скачать: CL | DM;
Вниз
Посторение тетриса или как можно упростить? Найти похожие ветки
← →
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;
Скачать: CL | DM;
Память: 0.53 MB
Время: 0.022 c
