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

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: 1 2 [3]  Все   Вниз
  Печать  
Автор Тема: Как написать на делфи простую игру?  (Прочитано 51339 раз)
0 Пользователей и 1 Гость смотрят эту тему.
_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 » new

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