Развиваем замысел игры. Кто поможет.?

codemaster

Горожанин

Зарегистрирован: Jul 16, 2008
Сообщения: 133
Откуда: Павлодар

Добавлено: Вс Сен 14, 15:11 Заголовок сообщения: Развиваем замысел игры. Кто поможет.?

Вот ссылка на скриншот игры
http://www.pavlodar.gn.kz/index.html?op=modload&title=Foto&file=index&do=showpic&pid=5972&orderby=dateD

А вот сам код игры:

Код:

unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,DirectDraw,DDUtil, AppEvnts, DirectInput8;
type
TKeys = class
Conn: Boolean;
private
LastTickCount: DWORD;
ThisTickCount: DWORD;
numkey: integer;
PosX, PosY: Integer;
wrkBitmap: TBItmap;
procedure Dead;
procedure Show;

public
constructor Create;

end;
type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
private
FDD: IDirectDraw7;
FDDSPRimary: IDirectDrawSurface7;
FDDSBack: IDirectDrawSurface7;
FDDSBackground: IDirectDrawSurface7;
FDDSSPrite: IDirectDrawSurface7;
FDDSKey: IDirectDrawSurface7;
FDI : IDirectInput8;
DDIKeyboard : IDirectInputDevice8;
KeyAl: TKeys;
function DI_Init : HRESULT;
procedure KeyAnalyse;
function UpdateFrame: HRESULT;
procedure Errorout(Hret: HReSULT);
function RestoreAll: HRESULT;
function FlipPages: HRESULT;
function FDDSSpritesRestore : HRESULT;
{ Private declarations }
public
{ Public declarations }
end;
type
TBaseSprite = class
Width: Integer;
Height: Integer;
AnimFrame: Integer;
CountFrame: Integer;
PosX,Posy: Integer;
Conn: Boolean;

private
LastTickCount: DWORD;
ThisTickCount: DWORD;

procedure Show; virtual; abstract;

end;
type
TSprite = class(TBaseSprite)

Activate: Boolean;
Dead: Boolean;
procedure Show; override;
public
constructor Create(PosXX,PosYY: integer);
destructor Destroy;
end;

const
ScreenWidth = 800;
ScreenHeight = 600;
ScreenBitDepth = 32;

var
Form1: TForm1;
Spheres: array[1..10,1..20] of TSprite;
KeyTab: String;
TabNum: Integer = 0;
ActivateNuM: Integer = 0;

HeightSp: Integer;
StrKap: array[1..20] of integer;

implementation

{$R *.dfm}
function TForm1.DI_Init : HRESULT;
var
hRet : HRESULT;
Keys: TDIDataFormat;

begin
hRet := DirectInput8Create(hInstance, DIRECTINPUT_VERSION, IID_IDirectInput8, FDI, nil);
if Failed(hRet) then begin
Result := hRet;
Exit
end;

hRet := FDI.CreateDevice (GUID_SysKeyboard, DDIKeyboard, nil);
if Failed(hRet) then begin
Result := hRet;
Exit
end;
ZeroMemory(@Keys,SizeOf(Keys));
Keys.dwSize:= SizeOf(Keys);
Keys.dwObjSize:= Sizeof(TDIObjectDataFormat);
Keys.dwFlags:= DIDF_RELAXIS;
Keys.dwDataSize:= Sizeof(TDIKeyboardState);
Keys.dwNumObjs:= High(_c_dfDIKeyboard_Objects) + 1;
Keys.rgodf:= @_c_dfDIKeyboard_Objects[Low(_c_dfDIKeyboard_Objects)];
hRet := DDIKeyboard.SetDataFormat(Keys);

if Failed(hRet) then begin
Result := hRet;
Exit
end;

hRet := DDIKeyboard.SetCooperativeLevel(Handle, DISCL_FOREGROUND or DISCL_EXCLUSIVE);
if Failed(hRet) then begin
Result := hRet;
Exit
end;

Result := DDIKeyboard.Acquire;
end;
procedure TForm1.KeyAnalyse;
var
diks : Array [0..255] of BYTE;
hRet : HRESULT;
i : Byte;
function ScanToChar (const Scan : Byte) : String;
begin
case Scan of
DIK_A : Result := 'ф';
DIK_B : Result := 'и';
DIK_C : Result := 'с';
DIK_D : Result := 'в';
DIK_E : Result := 'у';
DIK_F : Result := 'а';
DIK_G : Result := 'п';
DIK_H : Result := 'р';
DIK_I : Result := 'ш';
DIK_J : Result := 'о';
DIK_K : Result := 'л';
DIK_L : Result := 'д';
DIK_M : Result := 'ь';
DIK_N : Result := 'т';
DIK_O : Result := 'щ';
DIK_P : Result := 'з';
DIK_Q : Result := 'й';
DIK_R : Result := 'к';
DIK_S : Result := 'ы';
DIK_T : Result := 'е';
DIK_U : Result := 'г';
DIK_V : Result := 'м';
DIK_W : Result := 'ц';
DIK_X : Result := 'ч';
DIK_Y : Result := 'н';
DIK_Z : Result := 'я';
DIK_OEM_102: Result:= 'х';
else Result := ''
end;
end;

begin

ZeroMemory(@diks, SizeOf(diks));
hRet := DDIKeyboard.GetDeviceState(SizeOf(diks), @diks);
if Failed (hRet) then begin
hRet := DDIKeyboard.Acquire;
while hRet = DIERR_INPUTLOST do
hRet := DDIKeyboard.Acquire;
end;

for I := $01 to $99 do begin
if diks [i] and $80 <> 0 then begin
if KeyTab = ScanToChar(i) then begin

Spheres[StrKap[TabNum + 1],TabNum + 1].Activate:= True;
ActivateNum:= TabNum + 1;

end;

end;
end;

for I := $01 to $99 do begin
if diks [i] and $80 <> 0 then begin
if KeyTab = ScanToChar(i) then begin
Spheres[StrKap[TabNum + 1],TabNum + 1].Activate:= True;
ActivateNum:= TabNum + 1;

end;

end;
end;

if diks [DIK_ESCAPE] and $80 <> 0 then begin
Close();
end;

end;

procedure TKeys.Dead;
const
KeyA: array[1..32] of string = ('а','б','в','г','д','е','ё','ж','з','и','й','к','л','м','н','о','п','р','с','т','у','ф','х','ц','щ','ш','ь','ы','ъ','э','ю','я');
var
i: integer;
begin
PosY:= -40;

Randomize;
repeat

numkey:= Random(33);
until numkey <> 0;

KeyTab:= KeyA[numkey];

i:= Random(20);

PosX:= (i * 40) + 5;
TabNum:= i;

end;
procedure TKeys.Show;

var
OldBkMode: Integer;
k: TRect;
begin
ThisTickCount:= GetTickCount;
if ThisTickCount - LastTickCount > 1 then begin

with WrkBitmap.Canvas do begin
Brush.COlor:= clBlack;
FillRect(CliPRect);
Font.Name:= 'Arial';
Font.Color:= clRed;
TextOut(0,0, KeyTab);
end;

PosY:= PosY + 4;
LastTickCount:= ThisTickCount;
if PosY >= ScreenHeight - 160 then Dead;

end;
DDCopyBitmap(Form1.FDDSKey,wrkBitmap.Handle,0,0,40,40);

DDSetColorKey(Form1.FDDSKey,RGB(0,0,0));
SetRect(k,0,0,40,40);

Form1.FDDSBack.BltFast(PosX,PosY,Form1.FDDSKey,@k,DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end;
constructor TKeys.Create;
const
KeyA: array[1..32] of string = ('а','б','в','г','д','е','ё','ж','з','и','й','к','л','м','н','о','п','р','с','т','у','ф','х','ц','щ','ш','ь','ы','ъ','э','ю','я');
var
i: integer;
begin
wrkBitmap:= TBitmap.Create;
Randomize;
repeat

numkey:= Random(33);
until numkey <> 0;
i:= Random(20);

KeyTab:= KeyA[numkey];
conn:= false;
PosX:= (i * 40) + 5;
TabNum:= i;
PosY:= -40;
wrkBitmap.Width:= 40;
wrkBitmap.Height:= 40;

wrkBitmap.Canvas.Font.Size:= 30;

end;
constructor TSprite.Create(PosXX,PosyY: Integer);
var
wrkBitmap: TBitmap;
i: integer;
begin
PosX:= PosXX;
PosY:= PosYY;
CountFrame:= 5;
AnimFrame:= 0;
Width:= 40;
Height:= 40;
Conn:= False;
Activate:= false;
Dead:= False;
for i := 1 to 20 do
StrKap[i]:= 4;

end;
destructor TSprite.Destroy;
begin

end;
procedure TSprite.Show;
var
SRect: Trect;

begin

if Dead = False then begin

if Activate then begin

if Form1.KeyAl.PosY + 80 >= PosY then begin

ThisTickCount:= GetTIckCount;
if ThisTickCount - LastTickCOunt > 100 then begin
AnimFrame:= (AnimFrame + 1) mod CountFrame;
LastTickCount:= ThisTickCount;
end;
if AnimFrame = 4 then begin

Form1.KeyAl.Dead;
Dead:= True;
StrKap[ActivateNum]:= StrKap[ActivateNum] - 1;
end;
end
else
PosY:= PosY - 1;
end;

SetRect(SRect,(AnimFrame * Width),0,(AnimFrame * Width) + Width,40);
Form1.FDDSBack.BltFast(PosX,PosY,Form1.FDDSSprite,@SRect,DDBLTFAST_WAIT or DDBLTFAST_SRCCOLORKEY);

end;

end;
function TForm1.FlipPages : HRESULT;
var
hRet : HRESULT;
begin
hRet := DD_OK;
while TRUE do begin
hRet := FDDSPrimary.Flip(nil, 0);
if hRet = DD_OK then Break;
if hRet = DDERR_SURFACELOST then begin
hRet := RestoreAll;
if Failed(hRet) then Break;
end;
if hRet <> DDERR_WASSTILLDRAWING then Break;
end;
Result := hRet;
end;

function TForm1.RestoreAll: HRESULT;
var
hRet : HRESULT;
bkRect: Trect;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin

hRet := FDDSBackground._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit
end;
SetRect(bkRect,0,0,800,600);
hRet := DDReLoadBitmap(FDDSBackground, 'images\background.bmp');
if Failed (hRet) then ErrorOut(hRet);
FDDSPrimary.BltFast(0, 0, FDDSBackground, @bkRect, DDBLTFAST_WAIT);
hRet := FDDSSprite._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit
end;
hRet := DDReLoadBitmap(FDDSSPrite, 'images\sprite.bmp');
if Failed (hRet) then ErrorOut(hRet);

hRet := FDDSSpritesRestore;
if Failed (hRet) then begin
Result := hRet;
Exit
end;

Result := DD_OK
end
else Result := hRet;
end;
function TForm1.FDDSSpritesRestore : HRESULT;
var
DC : HDC;
hRet : HResult;
begin
hRet := FDDSKey._Restore;
if Failed (hRet) then begin
Result := hRet;
Exit
end;

Result := DD_OK;
end;
function TForm1.UpdateFrame: HRESULT;
var
hRet: HRESULT;
Rect: TRect;
i,j: Integer;
begin
Rect.Left:= 0;
Rect.Top:= 0;
Rect.Right:= 800;
Rect.Bottom:= 600;
hRet:= FDDSBack.BltFast(0,0,FDDSBackground,nil,DDBLTFAST_WAIt);
if Failed(Hret) then ErrorOut(Hret);
KeyAl.Show;
for j := 1 to 4 do

for i := 1 to 20 do

Spheres[j,i].Show;

end;
procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin

if Failed(UpdateFrame) then RestoreAll;
FlipPages;
KeyAnalyse;
Done:= False;
end;

procedure TForm1.Errorout(Hret: HRESULT);
var
F: TextFile;
begin
AssignFile(f,ExtractFilePath(ParamStr(0)) + 'errors.txt');
if FileExists(ExtractFilePath(ParamStr(0)) + 'errors.txt') then
Append(f)
else
Rewrite(F);
WRiteLn(f,DDErrorString(hRet));
CloseFile(f);

end;
procedure TForm1.FormCreate(Sender: TObject);
var
ddsd: TDDSurfaceDesc2;
hRet: HRESULT;
wrkBitmap: TBitmap;
ddscaps: TDDSCAPS2;
i,j: integer;
begin
FDD:= nil;
FDDSPRimary:= nil;
FDDSBack:= nil;
FDDSBackground:= nil;
FDDSSPrite:= nil;
FDDSKey:= nil;

hRet:= DirectDrawCreateEx(nil,FDD,IDirectDraw7,nil);
if Failed(hret) then ErrorOut(hret);

hRet:= FDD.SetCooperativeLevel(Handle,DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
if Failed(hret) then ErrorOut(hret);

hRet:= FDD.SetDisplayMode(ScreenWidth,ScreenHeight,ScreenBitDepth,0,0);
if Failed(hret) then ErrorOut(hRet);

ZeroMemory(@ddsd,SizeOf(ddsd));
with ddsd do begin
dwSize:= SizeOf(ddsd);
dwFlags:= DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
ddsCaps.dwCaps:= DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
dwBackBufferCount:= 1;

end;

hRet:= FDD.CreateSurface(ddsd,FDDSPrimary,nil);
if Failed(Hret) then ErrorOut(hRet);

ZeroMemory(@ddscaps,SizeOf(ddscaps));
with ddscaps do begin
ddscaps.dwCaps:= DDSCAPS_BACKBUFFER;

end;

hRet:= FDDSPrimary.GetAttachedSurface(ddscaps,FDDSBack);
if Failed(hret) then ErrorOut(hret);

FDDSBack._AddRef;
wrkBitmap:= TBitmap.Create;
ZeroMemory(@ddsd,SizeOf(ddsd));
with ddsd do begin
dwSize:= SizeOf(ddsd);
dwFlags:= DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
ddscaps.dwCaps:= DDSCAPS_OFFSCREENPLAIN;
dwWidth:= 800;
dwHeight:= 600;
end;

wrkBitmap.LoadFromFile('images\background.bmp');
hRet:= FDD.CreateSurface(ddsd,FDDSBackground,nil);
if Failed(hret) then ErrorOut(Hret);

hRet:= DDCopyBItmap(FDDSBackground,wrkBitmap.Handle,0,0,800,600);
if Failed(hret) then ErrorOut(HRet);

ZeroMemory(@ddsd,SizeOf(ddsd));
with ddsd do begin
dwSize:= SizeOf(ddsd);
dwFlags:= DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
ddscaps.dwCaps:= DDSCAPS_OFFSCREENPLAIN;
dwWidth:= 200;
dwHeight:= 40;
end;

hRet:= FDD.CreateSurface(ddsd,FDDSSprite,nil);
if Failed(hret) then ErrorOut(hRet);

wrkBitmap.LoadFromFile('images\sprite.bmp');

FDDSSPrite:= DDLoadBitmap(FDD,'images\sprite.bmp',0,0);
DDSetColorKey(FDDSSPrite,RGB(255,255,255));
wrkBitmap.Free;
for j := 1 to 4 do
for I := 1 to 20 do

Spheres[j,i]:= TSprite.Create((i - 1) * 40,ScreenHeight - (j * 40));
with ddsd do begin
dwSize:= SizeOf(ddsd);
dwFlags:= DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
ddscaps.dwCaps:= DDSCAPS_OFFSCREENPLAIN;
dwWidth:= 40;
dwHeight:= 40;

end;

hRet:= FDD.CreateSurface(ddsd,FDDSKey,nil);
if Failed(hret) then ErrorOut(hret);

KeyAl:= TKeys.Create;

hRet:= Di_Init;
if Failed(hret) then ErrorOut(hret);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FDD) then begin
if Assigned(FDDSSprite) then FDDSSprite:= nil;

if Assigned(FDDSBackGround) then FDDSBackGround:= nil;
if Assigned(FDDSBack) then FDDSBack:= nil;
if Assigned(FDDSPrimary) then FDDSprimary:= nil;

FDD:= nil;
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if KEy = VK_ESCAPE then Application.Terminate;

end;

end.

Уважаемые Люди помогите мне продолжить замысел этой самой игры, игра предназначена для людей кто медленно печатает. Покажите мне мои ошибки. Вообщем я хочу услышать всё что думают люди и чего они хотят увидеть в этой игре.[/code]

Вернуться к началу

Реклама на сайте	Контакты	Наши клиенты		сейчас на сайте 202 чел.
© 2006-2023 ТОО"Электронный город" Дизайн Алексенко А.

Павлодарский форум

Просмотр темы - Развиваем замысел игры. Кто поможет.?

«Показать последние сообщения»