Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.02.2016, 15:06   #1
mazahaler
Пользователь
 
Регистрация: 25.02.2016
Сообщений: 11
Радость Игра блоки

Нашел в интернете игру блоки. Более менее разобрался в коде, но не знаю как сделать так, чтобы при отсутствии рядом стоящих одноцветных блоков игра заканчивалась. Собственно прошу помощи.
Код программы:
Код:
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls;
 
type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N41: TMenuItem;
    N51: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure NewGame;
    procedure DropBlock;
    procedure DelVoid;
    procedure N2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N51Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MainArray:array[0..100,0..100] of byte;
  SecArray : array[0..100,0..100] of byte;
  BPic1,BPic2,BPic3,BPic4,BPic5:TBitmap;
  count,colors:integer;
 
implementation
 
{$R *.dfm}
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;  //процедура поиска и удаления  рядом стоящих одноцветных блоков.
  Shift: TShiftState; X, Y: Integer);
 
 var item : byte;
    i, j, k, m: Integer;
    ending : boolean;
begin
 item := MainArray[X div 24,Y div 24];
 m := 1;
 ending := False;
 for i := 0 to Count do
    for j := 0 to Count do
      SecArray[i,j] := 0;
 
 if MainArray[X div 24,Y div 24] <> 0 Then
    begin
      SecArray[X div 24,Y div 24] := 1;
      While ending <> True do
      begin
      k := 0;
      for i := Count downto 0 do
        for j := Count downto 0 do
           if (SecArray[i,j] = 1) Then
             begin
               if (MainArray[i-1,j] = item)and(SecArray[i-1,j] = 0) Then
                 begin SecArray[i-1,j] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i+1,j] = item)and(SecArray[i+1,j] = 0) Then
                 begin SecArray[i+1,j] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i,j-1] = item)and(SecArray[i,j-1] = 0) Then
                 begin SecArray[i,j-1] := 1; k := k+1; m := m+1; end;
 
               if (MainArray[i,j+1] = item)and(SecArray[i,j+1] = 0) Then
                 begin SecArray[i,j+1] := 1; k := k+1; m := m+1; end;
             end;
      if k = 0 Then ending := True;
      end;
 
      if m > 1 Then
         for i := 0 to Count do
             for j := 0 to Count do
                 if SecArray[i,j] = 1 Then MainArray[i,j] := 0;
 
 
    end;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
 var i,j:integer;
 begin
 for i:=0 to count do
for j:=0 to count do
if MainArray[i,j]<>0 then
case MainArray[i,j]   of
               1:Canvas.Draw(i*24,j*24,BPic1);
               2:Canvas.Draw(i*24,j*24,BPic2);
               3:Canvas.Draw(i*24,j*24,BPic3);
               4:Canvas.Draw(i*24,j*24,BPic4);
               5:Canvas.Draw(i*24,j*24,BPic5);
               end;
               DropBlock;
               DelVoid;
end;
 
procedure TForm1.N21Click(Sender: TObject);
begin
colors:=2;
NewGame;
end;
 
procedure TForm1.N2Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm1.N31Click(Sender: TObject);
begin
colors:=3;
end;
 
procedure TForm1.N3Click(Sender: TObject);
begin
 close;
end;
 
procedure TForm1.N41Click(Sender: TObject);
begin
colors:=4;
NewGame;
end;
 
procedure TForm1.N4Click(Sender: TObject);
begin
NewGame;
end;
 
procedure TForm1.N51Click(Sender: TObject);
begin
colors:=5;
NewGame;
end;
 
procedure TForm1.NewGame;
var i,j:integer;
 begin
randomize;
for i:=0 to count do
for j:=0 to count do
MainArray[i,j]:= random(colors)+1;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Refresh;
end;
 
procedure TForm1.DropBlock ;
var i,j:integer;
begin
 for i := 0 to count do
   for j := count downto 1  do
   if MainArray[i,j]=0 then
   begin
     MainArray[i,j]:= MainArray[i,j-1];
     MainArray[i,j-1]:=0;
   end;
 
 
end;
      procedure TForm1.DelVoid;
      var
      i,j,k:integer;
      begin
      for i :=0 to count-1 do
      begin
        k:=0;
        for j := 0 to count do
        k:=k+MainArray[i,j];
        if k=0 then
        for j := 0 to count do
        begin
          MainArray[i,j]:=   MainArray[i+1,j]  ;
          MainArray[i+1,j]:=0;
        end;
 
 
      end;
 
 
      end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
 
count:=20;
Width:= 24*(count+1)+13;
Height:= 24*(count+1)+55;
color:=clblack;
colors:=3;
BPic1:=TBitmap.Create;
BPic1.LoadFromFile('red.bmp');
BPic2:=TBitmap.Create;
BPic2.LoadFromFile('blue.bmp');
BPic3:=TBitmap.Create;
BPic3.LoadFromFile('yellow.bmp');
BPic4:=TBitmap.Create;
BPic4.LoadFromFile('green.bmp');
BPic5:=TBitmap.Create;
BPic5.LoadFromFile('purple.bmp');
NewGame;
end;
 
end.
mazahaler вне форума Ответить с цитированием
Старый 27.02.2016, 12:38   #2
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,876
По умолчанию

Стоит выложить проект целиком, особенно, если Вы его дорабатывали, или ссылку на сайт, где брали (если это не помойка), но если брали только код, а потом сами собирали проект, то опять же проект предпочтительнее.
Очень мало кто будет из этого кода собирать проект, который должен включать ещё и форму(ы), и приложение, которому нужны ресурсы (картинки).
Потом, стоит указать где находится проблемное место в коде(раз Вы в нём разобрались), а также привести постановк задачи, но не в двух словах а максимально подробно, лучше даже приложить скриншоты, где показано, как есть сейчас и как должно быть по Вашей задумке, т.к. из кода этого никак не увидеть.

Приложите усилия свои, чтобы помогающие, могли с удобством разбираться с задачей, а без подготовительной работы люди даже не взглянут, т.к. если Вам не охота прилагать усилия, почему кому-то вообще будет охота тратить _соё_ время и разбираться с _Вашей_ задачей.
phomm вне форума Ответить с цитированием
Старый 27.02.2016, 14:24   #3
mazahaler
Пользователь
 
Регистрация: 25.02.2016
Сообщений: 11
По умолчанию

Вот полный проект. .exe файл удалил ибо занимал много места. Суть игры в том чтобы щелкать по одноцветным рядом стоящим блокам, за что должны начисляться очки. Проблема в том что в конечном итоге остается несколько блоков разного цвета, с которыми ничего не сделаешь. Как показано на скрине. Вот я и не знаю как сделать так, чтобы при отсутствии рядом стоящих одноцветных блоков на игровом поле игра заканчивалась.
Изображения
Тип файла: jpg Безымянный.jpg (111.8 Кб, 117 просмотров)
Вложения
Тип файла: rar blocks.rar (70.6 Кб, 13 просмотров)
mazahaler вне форума Ответить с цитированием
Старый 27.02.2016, 19:53   #4
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,876
По умолчанию

"Узнаю брата Колю" ©
это я про тему http://www.cyberforum.ru/post4476495.html , но не про юзера NIKOLAYY в теме http://www.cyberforum.ru/delphi-begi...ad1664852.html

Скажу честно, не очень положительно отношусь к людям, на чужой работе выезжающих, хотя зависит от добавленного труда.

Ежели есть нормальные попытки сделать такую проверку, дам код нахаляву, т.к. хочу понять, что Вы сами эту задачу понимаете и можете написать, но по неопытности это идёт с ошибками, переписыванием, очень долго и т.п., но суть Вы должны понимать.

А коли Вы сами только смогли оживить исходник MaDiN'ы, но все процессы в с массивами для Вас покрыты тайной и Вы не хотите/не можете/не считаете нужным разобраться, то код могу дать только за мзду.
Вложения
Тип файла: zip BlockBusterExe.zip (273.7 Кб, 17 просмотров)
phomm вне форума Ответить с цитированием
Старый 29.02.2016, 15:24   #5
mazahaler
Пользователь
 
Регистрация: 25.02.2016
Сообщений: 11
По умолчанию

Исходники взяты не у MaDiN'ы, а вот из этого видеоролика https://www.youtube.com/watch?v=uxLkUbHeiJc
Я недавно начал проходить delphi.
Дело не в том, что я не хочу, не могу или не считаю нужным, я, как раз, считаю нужным, но едва ли в силу моей неопытности могу написать эту проверку. И я не смог бы написать эту игру сам, без нечего. Я разобрался в коде, почти полностью, я понимаю все, кроме некоторых нюансов в процедуре поиска и удаления одноцветных рядом стоящих блоков. И рано или поздно разберусь до конца, поскольку эта игра - моя курсовая. И я заинтересован в не просто ее сдаче, а в полном понимании того, что я собираюсь сдавать.

Последний раз редактировалось mazahaler; 29.02.2016 в 16:21.
mazahaler вне форума Ответить с цитированием
Старый 07.03.2016, 11:49   #6
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,876
По умолчанию

Если заинтересованы, то это радует, давайте продолжим обсуждение, лучше начать с попыток реализации, я хочу видеть, как Вы понимаете алгоритм, пусть и ошибки там будут - разберём по косточкам что и где.
phomm вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Меню И Блоки CilCatblack WordPress и другие CMS 0 05.10.2013 13:46
переименовать блоки propoker23 HTML и CSS 1 14.01.2012 10:00
переименовать блоки propoker23 JavaScript, Ajax 0 05.01.2012 15:11
блоки css Ast HTML и CSS 2 04.01.2012 13:48
Блоки в CSS WindWdM Помощь студентам 0 24.11.2011 15:03