Простенькую? Эх. Давно это было. Вот. Простейшая игруша. Все на 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
