Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: 1 2 3 [Все]   Вниз
  Печать  
Автор Тема: Как написать на делфи простую игру?  (Прочитано 51318 раз)
0 Пользователей и 1 Гость смотрят эту тему.
rfgecnf
Гость
« : 06-10-2006 10:42 » 

Завожу тему) Улыбаюсь)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #1 : 06-10-2006 10:44 » 

ну, давайте писать. только по-быстрому Улыбаюсь что-то простое, типа тетриса, сапёра, линий и прочей лабуды. что именно?
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #2 : 06-10-2006 10:47 » 

есть, кстати, тема интересная. можно наваять что-то по мотивам King's Bounty под винду.
« Последнее редактирование: 07-12-2007 19:24 от Алексей1153++ » Записан

rfgecnf
Гость
« Ответ #3 : 06-10-2006 10:49 » 

ну...простая_текстовая_так)_или_сложно_будет_а?(ссори_пробел_барахлит) мм_в_King's_Bounty_не_играл_давай_попробуем)
« Последнее редактирование: 07-12-2007 19:25 от Алексей1153++ » Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #4 : 06-10-2006 11:02 » 

Капустник, человек, не игравший в King's Bounty, не имеет морального права называться программером Улыбаюсь http://dosgames.ru/index.php?action=game&act=sub&id=114

можно и текстовую. что-то типа рпг или квеста, но без графики. типа, настольный mud Ага
« Последнее редактирование: 07-12-2007 19:26 от Алексей1153++ » Записан

rfgecnf
Гость
« Ответ #5 : 06-10-2006 11:04 » 

всё, клаву почистил пробел работает, када эта игра вышла меня на свете не было!)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #6 : 06-10-2006 11:06 » 

Капустник, ну, игра культовая. комменты почитай Улыбаюсь куче народа она нравится больше героев и прочего Улыбаюсь

в принципе, можно сделать что-то аналогичное на дельфе. чтобы безо всяких досбоксов тихо-скромно оно жило в окошке где-нить. в разгар напряжённого рабочего дня Улыбаюсь
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #7 : 06-10-2006 11:07 » 

но по времени это где-то с месяц займёт. недели две - минимум. если не пугает и других предложений нет - то можно попробовать.
Записан

rfgecnf
Гость
« Ответ #8 : 06-10-2006 11:10 » 

 ну вот King's Bounty не качаеться! блин хостинг у них отключён(, а немного информации про mud можно? Я думаю не стоить начинаь сразу и игр с графикой(или стоит?) а так пожалуй начнём, спешить некуда)
« Последнее редактирование: 07-12-2007 19:29 от Алексей1153++ » Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #9 : 06-10-2006 11:16 » 

Капустник, мады - это текстовые игры. нагугли Dungeon And Dragons, или просто DnD. c них все рпг и начинались, когда-то. ещё безо всяких компьютеров, на бумажке с кубиками. рассказывать это - нереально долго, на диссертацию потянет свободно Улыбаюсь

другой вариант. были (да и есть ещё наверное где-то) такие штуки, назывались "книжка-игра". на первой странице читаешь вводную, типа где ты оказался и зачем, дальше у тебя начинается выбор. например, открыть дверь налево - стр. 10, посмотреть в шкафу - страница 50. а на странице 50 будет написано - проверьте удачу (т.е. киньте кубик), если выпало чётное число - вы нашли лом. ну и т.д.

при желании можно наворочать достаточно нелинейный сюжет, с развитием параметров, и пр.
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #10 : 06-10-2006 11:16 » 

ты расскажи, что ты сам хочешь.
Записан

rfgecnf
Гость
« Ответ #11 : 06-10-2006 11:20 » 

ура я её скачал! ну попробуем давай чтонить вроде мада
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #12 : 06-10-2006 11:22 » 

хых. ну, давай. в какой области? фантастика, фэнтэзи, ещё что-нибудь? тебе что больше нравится, "постаппокалиптический мир", или полуголые девки с арбалетами?
Записан

rfgecnf
Гость
« Ответ #13 : 06-10-2006 11:30 » 

Star Wars-наверн это)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #14 : 06-10-2006 11:32 » 

а ты уверен, что хочешь именно mud? Multi User Dungeon? это подразумевает несколько игроков, т.е. в том или ином виде игра должна быть сетевой.
Записан

rfgecnf
Гость
« Ответ #15 : 06-10-2006 11:38 » 

сетевой.. всё, окончательно запутался))) ладно ладно)) Знаешь так) Пусть это будет текстовая игрушка для одного игрока в духе Star Wars)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #16 : 06-10-2006 11:44 » 

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

rfgecnf
Гость
« Ответ #17 : 06-10-2006 11:49 » 

мм 4й эпизод смотрел? вот квестик по мотивам 4го эпизода
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #18 : 06-10-2006 11:50 » 

Капустник, не помню Улыбаюсь напиши сюжет вкратце, всё равно будет нужен.
Записан

rfgecnf
Гость
« Ответ #19 : 06-10-2006 12:02 » 

ок! Значит так Корелийская канарейка(кажись так) на которой летит принцесса Лея попадает в захватывающий луч Имперского корабля, после удачного штурма Дарт Вейдер не находит планов Звезды Смерти, От корабля отстыковывается спасательняа капсула, на борту которой находятся 2джоида: С3РО и R2D2, после этого они попадают на планету Татуин где их хватают джавы(а кстать вот мульт можна быстренько всё вспомнить)  http://umora.ru/dl.cgi?file=115056909269123.swf уу еле нашёл) еси не вспомнишь, буду продолжать)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #20 : 06-10-2006 12:10 » 

ыыыыыыыыыыыыыыы..... я не могу............ "Use the Force, Dude!"............ ыыыыыыыыыыыыы
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #21 : 06-10-2006 12:11 » 

аццкий мульт Улыбаюсь ладно, вспомнил.

квест от имени Люка, я так понимаю?
Записан

rfgecnf
Гость
« Ответ #22 : 06-10-2006 12:16 » 

гыыыыы, да, от Люка), потом сделаем за Империю)
Записан
rfgecnf
Гость
« Ответ #23 : 06-10-2006 12:21 » 

и так обязательно будет use the Force,Dude!)))
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #24 : 06-10-2006 12:23 » 

значит, начинается на Татуине. с того, что он идёт покупать роботов. я правильно понимаю?

10. Покупка роботов
20. Починка Р2Д2
30. Робот сваливает - поиски робота
40. Перестрелка с этими дебилами в рояле на колёсах
50. Разговор с Оби Ван Кеноби
60. Сбегание на корабле с тем придуром и волосатым.
70. Спасение принцессы из звезды смерти
80. Штурм звезды смерти.

так, примерно? тут квестов не особо много получается, и непонятно, как в тексте перестрелки и пр. изображать.
Записан

rfgecnf
Гость
« Ответ #25 : 06-10-2006 12:26 » 

мм да, но обязательно надо бы рисунок поставить как Алдераан(кажись так) Звезда Смерти взрывает)
Записан
rfgecnf
Гость
« Ответ #26 : 06-10-2006 12:30 » 

тока бы Джордж Лукас в суд не подал)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #27 : 06-10-2006 12:35 » 

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

Записан

rfgecnf
Гость
« Ответ #28 : 06-10-2006 12:37 » 

а обязательно должен быть смысл? ну а в чём смысл фильма? победить империю, муками, старанием, шаг в неправильную сторону-труп
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #29 : 06-10-2006 12:40 » 

Капустник, а мы своё сценарий сделаем. StarWars за ганьджубас. Империя запретила курить марихуанну. Звезда смерти - имперская секретная плантация. Оби-Ван-Кеноби - главный растаман, активист движения Legalize It, по суровой укурке собравший стебанутого робота, в которого зашил технологию производства бульбуляторов, пытающийся втянуть в растаманство юного Люка Скайвокера. Лия - глава звёздной системы, специализировавшейся на выращивании конопли в галактических масштабах. Борется с имперской монополией. Лукас у нас на коленях будет лицензию просить. ладно, это неважно.

ты мне лучше скажи, в чём квесты будут заключатся.
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #30 : 06-10-2006 12:41 » 

Капустник, ну, хотелось бы, чтобы юзер не тупо жал кнопки "Дальше", "Дальше", "Дальше", а иногда юзал моск.
Записан

rfgecnf
Гость
« Ответ #31 : 06-10-2006 12:45 » 

......да уж, вопрос))  ну скажем например идёшь по планете там отряд штурмовиков, что делать? спрататься или попереть в лоб? или скажем космос, летит ракета, как увернуться или увеличить скорость?  что то вробе этого
лан я оффлайн до 19поем  и уроки(
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #32 : 06-10-2006 12:52 » 

угу....

ну, можно так. сценарий хранить, как xml-файл. "игра" - по сути, просто плеер сценариев -  будет подгружать этот файл и воспроизводить. можно будет небольшой редактор сценариев потом прикрутить. т.е. задачу решить в общем виде. а потом писать любые сценарии и "играть" в них в плеере.
Записан

rfgecnf
Гость
« Ответ #33 : 06-10-2006 14:33 » 

с чего начнём?
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #34 : 06-10-2006 14:52 » 

я сейчас сбегаю, и до понедельника уже не появлюсь. нужно следующее.

1. определиться с набором характеристик персонажа.
2. определиться с набором доступных ему действий.

после этого можно написать простенький xml, из двух локаций всего, и начинать ваять интерфейс.
Записан

rfgecnf
Гость
« Ответ #35 : 06-10-2006 14:56 » 

мм впринципе думаю характеристики ненужны... а нобер доступных дейтвий, даж незнаю
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #36 : 06-10-2006 14:58 » 

Капустник, с характеристиками интереснее. на успешные действия можно вешать увеличение какого-то навыка. сами действия:

1. переход в другую локацию
2. бой
3. взять
4. оглядеться

и т.д. много не надо, основные хотя бы.
Записан

rfgecnf
Гость
« Ответ #37 : 06-10-2006 15:12 » 

ну впринципе это же будет квест ебз графики, а чё писать просто в текстовом документе характеристики, иль где?
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #38 : 06-10-2006 15:30 » 

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

а писать просто в отдельном окне где-нить, типа

Сила
Ловкость
Выносливость
Накуренность

и т.д.
Записан

rfgecnf
Гость
« Ответ #39 : 06-10-2006 15:39 » 

лан, подождём до понедельника, там посмотрим
Записан
rfgecnf
Гость
« Ответ #40 : 06-10-2006 15:46 » 

знаешь ,давай начнём лучьше с тетриса)
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


« Ответ #41 : 06-10-2006 17:47 » 

Капустник, характеристики будут определять возможность

....
....

Сила
Ловкость
Выносливость
Накуренность

и т.д.

напоминает "гопника " Улыбаюсь) скинуть программку? Улыбаюсь

* gopnik.rar (28.1 Кб - загружено 712 раз.)
« Последнее редактирование: 06-10-2006 17:49 от Алексей1153 » Записан

rfgecnf
Гость
« Ответ #42 : 07-10-2006 05:25 » 

гы, а я для тетриса сюжет придумал: мы жители нижниго народа! и однажды какой та казёл с неба начал кидать на нас фсякими фигурками! а еси будет полный экранчик появиться надпись: GAME OVER! вот такие дела а еси собирать их всести в одну линию они ищёзнут!

нда гнопик игра-жесть
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


« Ответ #43 : 07-10-2006 06:51 » 

Капустник, хе хе хе... тетрис - игра бесконечная и без сюжета. Истинно русская игра )) , изобретённая русским ))
Записан

rfgecnf
Гость
« Ответ #44 : 07-10-2006 09:29 » 

ну да изобрёл её русский человек) но сюжет есть даже в тетрисе(см журнал "Игромания") ыыы
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


« Ответ #45 : 07-10-2006 10:58 » 

игромания - отстой дремучий
Записан

rfgecnf
Гость
« Ответ #46 : 07-10-2006 11:13 » 

ну незнаю, незнаю , чатию больше года, меня устраивает
Записан
MS
Помогающий

ru
Offline Offline
Пол: Мужской

« Ответ #47 : 07-10-2006 17:19 » 

Игромания - журнал для геймеров от 14 до 16, из программирования там только примеры в 2 строки
Записан

Ничто так не ограничивает полёт мысли программиста, как компилятор
rfgecnf
Гость
« Ответ #48 : 08-10-2006 06:24 » 

2страницы)
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #49 : 09-10-2006 08:38 » 

Капустник, ну фто? тетрис? Улыбаюсь
Записан

rfgecnf
Гость
« Ответ #50 : 09-10-2006 15:17 » 

ДА!
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #51 : 10-10-2006 09:13 » 

тогда последний вопрос. насколько подробно описывать процесс? стоит ли, например, размусоливать про то же ООП, что-то объяснять, или просто приводить код?
Записан

rfgecnf
Гость
« Ответ #52 : 10-10-2006 11:01 » 

просо, сделать тетрис,без мусолиней
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #53 : 10-10-2006 11:31 » 

ладно, поехали. боевая задача:

1. написать унаследованный от TStringGrid класс, скажем, TGameGrid, который будет предком для любой игры клеточной типа, вроде тетриса, сапёра, или, там, крестиков - ноликов.

2. написать класс TTetris, унаследованный от TGameGrid, который и будет, собственно, игрой.

3. сделать интерфейс, в котором будет юзаться этот класс (TTetris).

для простоты пункты 2 и 3 имеет смысл совместить. щас перекурю и будем ваять.
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #54 : 10-10-2006 11:55 » 

примерный код для TGameGrid:

Код:
unit GameGridClass;

interface

uses
  Windows, Classes, Forms, Grids;

type
  TGameState = (gsNone, gsPlaying, gsUserWon, gsUserLoose);

  TGameGrid = class (TStringGrid)
  private
    fScore: integer;
    fState: TGameState;
    fSpeed: integer;
    fUseSpeed: boolean;
    procedure Wait (Ms: Cardinal);
  public
    property Score: integer read fScore write fScore default 0;
    property Speed: integer read fSpeed write fSpeed default 1000;
    property State: TGameState read fState default gsNone;
    property UseSpeed: boolean read fUseSpeed write fUseSpeed default TRUE;
    constructor Create (AOwner: TComponent); override;
    procedure Move; virtual; abstract;
    procedure Play; virtual;
    procedure Prepare; virtual; abstract;
  end;

implementation

{ TGameGrid }

constructor TGameGrid.Create(AOwner: TComponent);
begin
  inherited;
  fScore := 0;
  fSpeed := 1000;
  fState := gsNone;
  fUseSpeed := TRUE;
end;

procedure TGameGrid.Play;
begin
  while TRUE do begin
    if fState <> gsPlaying then
      Break;
    Move;
    if fUseSpeed then
      Wait (fSpeed);
  end;
end;

procedure TGameGrid.Wait(Ms: Cardinal);
var
  OldTickCount: Cardinal;
begin
  OldTickCount := GetTickCount;
  while GetTickCount - OldTickCount < Ms do
    Application.ProcessMessages;
end;

end.

пока никуда не прикручивал его, просто набросал логику любой "тетрисоподобной" игрушки. если есть вопросы - спрашивайте, я пока остальным займусь.
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #55 : 10-10-2006 15:25 » 

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

модуль TetrisGameClass:
Код:
unit TetrisGameClass;

interface

uses
  Classes, Graphics, SysUtils, Types, StdCtrls, Grids, GameGridClass, ExtCtrls;

const
  clFixed = clBtnFace;
  clEmpty = clWhite;
  clFigure = clBlue;
  clDropped = clGreen;


type
  TTetrisGame = class (TGameGrid)
  private
    procedure Freeze;
    procedure NewFigure;
    function CheckSpace (dx, dy: integer): boolean;
    procedure CheckState;
  protected
    procedure DeleteRow (ARow: integer); override;
  public
    constructor Create (AComponent: TComponent); override;
    procedure DrawCell (ACol, ARow: integer;
      ARect: TRect; AState: TGridDrawState); override;
    procedure FigureLeft;
    procedure FigureRight;
    procedure Move; override;
    procedure MoveFigure (dx, dy: integer);
    procedure Prepare; override;
  end;

implementation

{ TTetrisGame }

function TTetrisGame.CheckSpace(dx, dy: integer): boolean;
var
  i, j: integer;
begin
  Result := TRUE;
  for j := RowCount - dy - 1 downto 0 do begin
    for i := 1 to ColCount - 2 do begin
      if Cells [i, j] = '1' then begin
        if (Cells [i + dx, j + dy] = '0') or
          (Cells [i + dx, j + dy] = '2') then
          Result := FALSE;
      end;
    end;
  end;
end;

procedure TTetrisGame.CheckState;
var
  i, j: integer;
  AGameOver,
  AFilledRow: boolean;
begin
  j := RowCount - 2;
  while j >= 0 do begin
    AFilledRow := TRUE;
    for i := 1 to ColCount - 2 do
      if Cells [i, j] <> '2' then
        AFilledRow := FALSE;
    if AFilledRow then
      DeleteRow (j)
    else
      Dec (j);
  end;

  AGameOver := FALSE;
  for j := RowCount - 1 downto 0 do
    for i := 1 to ColCount - 2 do
      if (Cells [i, j] = '2') and (j < 4) then
        AGameOver := TRUE;
  if AGameOver then
    State := gsUserLoose;
end;

constructor TTetrisGame.Create(AComponent: TComponent);
begin
  inherited;
  FixedCols := 0;
  FixedRows := 0;
  ColCount := 11;
  RowCount := 21;
  DefaultColWidth := 16;
  DefaultRowHeight := 16;
  DefaultDrawing := FALSE;
  GridLineWidth := 0;
  ScrollBars := ssNone;
  Options := [];
  Width := (DefaultColWidth + GridLineWidth) * ColCount + 4;
  Height := (DefaultRowHeight + GridLineWidth) * RowCount + 4;
  Randomize;
end;


procedure TTetrisGame.DeleteRow(ARow: integer);
var
  i, j: integer;
begin
  for j := ARow downto 1 do
    for i := 1 to ColCount - 2 do
      Cells [i, j] := Cells [i, j - 1];
  for i := 1 to ColCount - 2 do
    Cells [i, 0] := '';
end;

procedure TTetrisGame.DrawCell(ACol, ARow: integer; ARect: TRect;
  AState: TGridDrawState);
var
  AValue: integer;
begin
  inherited;
  with Canvas do begin
    if Cells [ACol, ARow] <> '' then begin
      AValue := StrToInt (Cells [ACol, ARow]);
      case AValue of
        0: begin
          Brush.Color := clFixed;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clWhite, clGray, 1);
        end;
        1: begin
          Brush.Color := clFigure;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clAqua, clNavy, 1);
        end;
        2: begin
          Brush.Color := clDropped;
          FillRect (ARect);
          Frame3D (Canvas, ARect, clLime, clTeal, 1);
        end;
      end;
    end else begin
      Brush.Color := clEmpty;
      FillRect (ARect);
    end;
  end;

end;

procedure TTetrisGame.FigureLeft;
begin
  if CheckSpace (-1, 0) then
    MoveFigure (-1, 0);
end;

procedure TTetrisGame.FigureRight;
begin
  if CheckSpace (1, 0) then
    MoveFigure (1, 0);
end;

procedure TTetrisGame.Freeze;
var
  i, j: integer;
begin
  for j := 0 to RowCount - 1 do
    for i := 1 to ColCount - 2 do
      if Cells [i, j] = '1' then
        Cells [i, j] := '2';
end;

procedure TTetrisGame.Move;
begin
  if CheckSpace (0, 1) then
    MoveFigure (0, 1)
  else begin
    Freeze;
    CheckState;
    if State = gsPlaying then
      NewFigure;
  end;
end;

procedure TTetrisGame.MoveFigure(dx, dy: integer);
var
  i, j: integer;
begin
  for j := RowCount - 2 downto 0 do
    if dx < 0 then begin
      for i := 1 to ColCount - 2 do
        if Cells [i, j] = '1' then
          if Cells [i + dx, j + dy] = '' then begin
            Cells [i + dx, j + dy] := Cells [i, j];
            Cells [i, j] := '';
          end;
    end else begin
      for i := ColCount - 2 downto 1 do
        if Cells [i, j] = '1' then
          if Cells [i + dx, j + dy] = '' then begin
            Cells [i + dx, j + dy] := Cells [i, j];
            Cells [i, j] := '';
          end;
    end;
end;

procedure TTetrisGame.NewFigure;
var
  AFigure,
  ARotation,
  fLeft,
  fTop: integer;
begin
  AFigure := Random (8);
  ARotation := Random (4);
  fLeft := ColCount div 2 - 2;
  fTop := 0;
  case AFigure of
    0, 5..7: begin
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 2] := '1';
      Cells [fLeft + 2, fTop + 3] := '1';
    end;
    1: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 1, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
    2: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
      Cells [fLeft + 3, fTop + 1] := '1';
    end;
    3: begin
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 3, fTop] := '1';
      Cells [fLeft + 1, fTop + 1] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
    4: begin
      Cells [fLeft + 1, fTop] := '1';
      Cells [fLeft + 2, fTop] := '1';
      Cells [fLeft + 3, fTop] := '1';
      Cells [fLeft + 2, fTop + 1] := '1';
    end;
  end;
end;

procedure TTetrisGame.Prepare;
var
  i, j: integer;
begin
  for i := 1 to ColCount - 2 do
    for j := 0 to RowCount - 2 do
      Cells [i, j] := '';
  for i := 0 to RowCount - 1 do begin
    Cells [0, i] := '0';
    Cells [ColCount - 1, i] := '0';
  end;
  for i := 1 to ColCount - 2 do
    Cells [i, RowCount - 1] := '0';
  NewFigure;
end;

end.

куча недоделок. например, генерится только 4 фигуры вместо 7 (лениво дописывать однотипные вещи), фигуры не умеют переворачиваться и "падать" вниз до конца по нажатию кнопки, не увеличивается скорость, ну и ещё парочка мелочей. но в целом фигуры генерятся, падают, двигаются вправо/влево, и при заполнении ряда он стирается. о, ещё подсчёт очков тоже лень писать.

сама программа выглядит так:
Код:
unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GameGridClass, TetrisGameClass, StdCtrls;

type
  TFormMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    fTetris: TTetrisGame;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  fTetris := TTetrisGame.Create (Self);
  fTetris.Parent := Self;
  fTetris.Speed := 500;
  fTetris.Prepare;
end;

procedure TFormMain.Button1Click(Sender: TObject);
begin
  if fTetris.State <> gsPaused then
    fTetris.Prepare;
  fTetris.Play;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fTetris.Stop;
  Action := caFree;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  fTetris.Pause;
end;

procedure TFormMain.Button3Click(Sender: TObject);
begin
  fTetris.FigureLeft;
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  fTetris.FigureRight;
end;

end.

будет нечего делать - допишу остальное.
« Последнее редактирование: 07-12-2007 19:31 от Алексей1153++ » Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #56 : 10-10-2006 18:50 » 

ну и дабы закрыть тему...

готовый проект (сделано всё, кроме вращения - поставил заглушку, кому интересно - дописывайте Улыбаюсь )

ну и скриншот.

* tetris.zip (4.55 Кб - загружено 809 раз.)
* tetris.JPG (16.35 Кб - загружено 825 раз.)
« Последнее редактирование: 10-10-2006 18:53 от x77 » Записан

rfgecnf
Гость
« Ответ #57 : 11-10-2006 16:06 » 

ы
Записан
rfgecnf
Гость
« Ответ #58 : 11-10-2006 16:20 » 

слух ,а ты можешь мне объяснить как чиловеку каторый васче ничё нипанимает а?
создай то создай это я думаешь знаю чё это?))
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #59 : 11-10-2006 19:47 » 

Капустник, я же спрашивал - надо объяснять? завтра будут комментарии Улыбаюсь
Записан

_MK
Гость
« Ответ #60 : 19-10-2006 18:49 » 

Простенькую? Эх. Давно это было. Вот. Простейшая игруша. Все на Api. Написал где-то за 1 час.
Код:
program Project;

{$R 'resourse\project.res' 'resourse\project.rc'}

uses
  Windows,
  Messages;

Const ClassName      = 'GameClass';
Const IconName       = 'ID_ICON';
Const TitleName      = 'Пятнашки 15 vs 15';
Const MenuName       = 'programMenuName';
Const ButtonClass    = 'BUTTON';
Const VictoryMessage = 'Поздравляем! Вы победили!'+ #13 + 'Хотите ли вы повторить?';
Const VictoryTitle   = 'Ура!';
Const BueBueMessage  = 'До свидания!';
Const BueBueTitle    = 'Вот и все..';

Const ButtonSize = 100;
Const GameSize   = 15;

Type TGameObject = record
    Gamehandle : HWND;
    Xpos,Ypos    : WORD;
End;

Var GameFirst : Boolean = TRUE;
Var GamePlay : array [0..GameSize] of TGameObject;

Procedure InitGameObject(hwndparent : HWND);
Const ButtonsName : array [0..14] of PAnsiChar = ('1','2','3','4','5','6','7','8','9','10','11','12','13','14','15');
Var X : Byte;
Begin
  For X := 0 to 14 do
    With GamePlay[X] do
      Begin
        Xpos := (X mod 4) * ButtonSize;
        Ypos := (X div 4) * ButtonSize;
      End;
  If GameFirst then
    Begin
      For X := 0 to 14 do
        With GamePlay[X] do
          Begin
            Gamehandle := CreateWindow(ButtonClass,ButtonsName[X],WS_VISIBLE or WS_CHILD,Xpos,Ypos,ButtonSize,ButtonSize,hwndparent,0,hInstance,NIL);
          End;
      GameFirst := False;
    End;
    GamePlay[GameSize].Xpos := (GameSize mod 4) * ButtonSize;
    GamePlay[GameSize].Ypos := (GameSize div 4) * ButtonSize;
End;

Procedure Swap(a,b : byte);
var XX,YY : WORD;
Begin
  XX := GamePlay[a].Xpos;
  GamePlay[a].Xpos  := GamePlay[b].Xpos;
  GamePlay[b].Xpos := XX;
  YY := GamePlay[a].Ypos;
  GamePlay[a].yPos  := GamePlay[b].YPos;
  GamePlay[b].YPos := YY;
End;

Procedure RandomizeGame;
Var A,B,C : Byte;
Begin
  randomize;
  For A := 1 to random(50) do
    Begin
      b := random(GameSize+1);
      c := random(GameSize+1);
      swap(c,b);
      With GamePlay[B] do MoveWindow(GameHandle,Xpos,Ypos,ButtonSize,ButtonSize,true);
      With GamePlay[C] do MoveWindow(GameHandle,Xpos,Ypos,ButtonSize,ButtonSize,true);
    End;
End;

Function CanDoIt(x,y : word) : Byte;
Begin
  If (x-ButtonSize = GamePlay[GameSize].Xpos) and (y = GamePlay[GameSize].YPos) then begin Result := 1; exit end;
  If (x+ButtonSize = GamePlay[GameSize].Xpos) and (y = GamePlay[GameSize].YPos) then begin Result := 2; exit end;
  If (y-ButtonSize = GamePlay[GameSize].Ypos) and (x = GamePlay[GameSize].XPos) then begin Result := 3; exit end;
  If (y+ButtonSize = GamePlay[GameSize].Ypos) and (x = GamePlay[GameSize].XPos) then begin Result := 4; exit end;
  Result := 255;
End;

Procedure CheckGameVictory(hwndParent : HWND);
Var X : Byte;
Begin
  For X := 0 to GameSize do
   With GamePlay[x] do
      If (Xpos <> (X mod 4) * ButtonSize) or (YPos <> (X div 4)*ButtonSize) then exit;

  If MessageBox(0,VictoryMessage,VictoryTitle,MB_YESNO) = IDYES then
    Begin
      InitGameObject(hwndParent);
    End
  else
    Begin
      MessageBox(0,BueBueMessage,BueBueTitle,MB_OK);
      SendMessage(hwndParent,WM_DESTROY,0,0);
    End;
End;


Procedure NewStep(SendHandle : HWND);
Var X : byte;
Begin
  For X := 0 to GameSize do
    If GamePlay[X].GameHandle = SendHandle then
      begin SendHandle := X;  break end;
  Case CanDoIt(GamePlay[SendHandle].Xpos,GamePlay[SendHandle].Ypos) of
   1..4 : swap(SendHandle,GameSize);
    else exit;
  End;
 With GamePlay[GameSize] do MoveWindow(GameHandle,XPos,YPos,ButtonSize,ButtonSize,TRUE);
 With GamePlay[SendHandle] do MoveWindow(GameHandle,XPos,YPos,ButtonSize,ButtonSize,TRUE);
End;

function MainWndProc(handle : HWND; uMsg : UINT; wparam : WPARAM; lparam : LPARAM) : LRESULT; WinApi;
const ID_EXIT = 2;
const ID_HELP = 3;
const ID_ABOUT = 4;
Begin
 case uMsg of
  WM_CREATE: Begin
              ZeroMemory(addr(GamePlay),SizeOf(GamePlay));
              InitGameObject(handle);
              RandomizeGame;
             End;
  WM_COMMAND: begin
                If lparam = 0 then
                  case loword(wparam) of
                    ID_ABOUT: ;
                    ID_HELP: ;
                    ID_EXIT: SendMessage(handle,WM_CLOSE,0,0);
                  end
                else begin NewStep(lparam);  CheckGameVictory(handle);  end
              end;
  WM_DESTROY: PostQuitMessage(0);
 else begin MainWndProc := DefWindowProc(handle, uMsg, wparam, lparam);  exit; end;
 end;
 MainWndProc := 0;
End;

Procedure RegisterWC;
Var WC   : WNDCLASSEX;
    icon : HICON;
Begin
  WC.cbSize := SizeOf(WC);
  WC.style := CS_HREDRAW or CS_VREDRAW ;
  WC.lpfnWndProc := addr(MainWndProc);
  WC.cbClsExtra := 0;
  WC.cbWndExtra := 0;
  WC.hInstance := hInstance;
  icon := LoadIcon(hInstance,IconName);
  WC.hIcon := Icon;
  WC.hIconSm := Icon;
  WC.hCursor := LoadCursor(hInstance,IDC_ICON);
  WC.hbrBackground := COLOR_BTNHIGHLIGHT;
  WC.lpszMenuName := MenuName;
  WC.lpszClassName := ClassName;
  RegisterClassEx(WC);
End;

Procedure CreateMyWindow;
Begin
  CreateWindow(ClassName,TitleName, WS_VISIBLE  or WS_SYSMENU, CW_USEDEFAULT,CW_USEDEFAULT,400,450, 0,0,hInstance,NIL);
End;

Procedure MainProcedure;
Var MyMsg :  MSG;
Begin
  while GetMessage(MyMsg,0, 0, 0) <> LongBool(0)  do
    begin
      TranslateMessage(MyMsg);
      DispatchMessage(MyMsg);
    end;
  ExitProcess(MyMsg.wParam);
End;

begin
  RegisterWC;
  CreateMyWindow;
  MainProcedure;
end.

--------------------project.rc-----------------------------------
;This Resource Script was generated by WinAsm Studio.

#define ID_FILE 1
#define ID_EXIT 2
#define ID_HELP 3
#define ID_ICON 1000
#define ID_ABOUT 4

ID_ICON ICON DISCARDABLE "Icon.ico"

programMenuName MENUEX DISCARDABLE
BEGIN
POPUP "&File",ID_FILE
BEGIN
MENUITEM "Exit",ID_EXIT
END
MENUITEM "&About",ID_ABOUT
MENUITEM "H&elp",ID_HELP
END
« Последнее редактирование: 07-12-2007 19:33 от Алексей1153++ » Записан
_MK
Гость
« Ответ #61 : 19-10-2006 18:51 » 

p.s Сейчас как раз пишу генератор квестов. Собираюсь прикрутить музыку. Возможность самому п-ть дввижки, вставлять картинки. etc... Напишу, думаю скину сюда.
Записан
x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #62 : 20-10-2006 09:17 » 

_MK, а генератор квестов для чего?
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #63 : 20-10-2006 09:19 » 

Капустник, извини, несколько раз пытался начать всё откомментить, но понял - что делое гиблое. объяснение простого ключевого слова class само по себе тянет на небольшой реферат. будет проще, если ты задашь конкретные вопросы, если они у тебя есть. а я, в свою очередь, постараюсь ответить.
Записан

_MK
Гость
« Ответ #64 : 20-10-2006 10:23 » 

x77
Для создания текстовых квестов. Сама по себе идея не новая, но в реализации есть довольно интересные моменты, так к примеру, я собираюсь дать пользвателю возможность самому распологать кнопки, поля ввода-вывода, вводить новые характеристики (допустим силу Улыбаюсь ) описывающие персонажей, работать с этими характеристиками. По сути дела это то же программирование, но уже на сверхвысоком уровне (и в переделах игры).
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


« Ответ #65 : 07-12-2007 19:36 » 

Offtopic:

в посте #56 - Игоревский проект и скрин тетриса на Дельфи - может тоже в файлы пора ? )
Поставлю в угол.

Записан

RXL
Технический
Администратор

ru
Offline Offline
Пол: Мужской

WWW
« Ответ #66 : 10-12-2007 08:37 » 

Алексей1153++, можно.
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
rfgecnf
Новенький

ru
Offline Offline

« Ответ #67 : 09-09-2011 18:56 » 

Ох, боже, это надо было же найти тот самый форум через 5 лет и посмотреть на всё это дело, повзрослев) Я тогда свалил, не сказав спасибо. Извиняюсь, спасибо за помощь 5 лет назад Ага
Записан
RXL
Технический
Администратор

ru
Offline Offline
Пол: Мужской

WWW
« Ответ #68 : 09-09-2011 19:26 » 

rfgecnf, с возвращением!
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
rfgecnf
Новенький

ru
Offline Offline

« Ответ #69 : 09-09-2011 19:28 » 

Спасибо) А вот "Гопника", которого выкладывали тут когда-то я до сих пор не могу пройти  Отлично
Записан
Алексей++
глобальный и пушистый
Глобальный модератор

ru
Offline Offline
Сообщений: 13


« Ответ #70 : 09-09-2011 20:00 » 

Спасибо) А вот "Гопника", которого выкладывали тут когда-то я до сих пор не могу пройти  Отлично

ну да, там рулетка ) Я прошёл как-то. В конце этого крутого-прекрутого декана надо запинать, а уже ближе к концу запина тебя ждёт большой сюрприз Ага Это чтобы раззадорить тебя ))

Самое главное в игре - как можно больше бабосов заработать. Далее как лавина - прокачиваешься в тренажёрках, закупаешь побольше жратвы, крутизна прёт
Записан

x77
Модератор

ro
Offline Offline
Пол: Мужской
меняю стакан шмали на обратный билет с Марса.


« Ответ #71 : 10-09-2011 13:23 » 

rfgecnf, пожалуйста Ага
Записан

Страниц: 1 2 3 [Все]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines