⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 Delphi Engine for games.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
TmpImageList1.Items.Clear;
Close;
end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

//////////////////////////////////////////////////////////////////////
procedure TMainForm.SceneTitle;
var
  r    : TRect;
  Logo: TPictureCollectionItem;
begin
  BlinkUpdate;

  DXDraw.Surface.Fill(0);

  Logo:= TmpImageList1.Items[0];
  r:=Bounds((640-Logo.Width)div 2,(480-Logo.Height)div 2,Logo.Width, Logo.Height);

  //Logo.DrawWaveX(DXDraw.Surface,(640-Logo.Width)div 2,(480-Logo.Height)div 2,Logo.Width,Logo.Height,0,Trunc(4-Cos256(FBlink div 10)*4),200,FBlink div 6);
  Logo.DrawAlpha(DXDraw.Surface,r,0,Trunc(255-Sin256(FBlink div 30)*150));

  if DXInput.States<>[] then
  begin
    //PlaySound('SceneMov', False);
    //Sleep(300);
    StartScene(gsMainMenu);
  end;

end;
////////////////////////////////////////////////////////////////////////
procedure TMainForm.SceneMainMenu;
Var
i : integer;
begin
//DXDraw.Surface.Fill(0);

TmpImageList1.Items[0].Draw(DXDraw.Surface, 0, 0, 0);

For i:=0 to FBtnList.Count-1
 do TDXImageButton(FBtnList[i]).DoDraw;

{
 if isButton1 in DXInput.States then
  begin
    //PlaySound('SceneMov', False);
    //Sleep(200);
    //StartScene(gsMain);
  end;
}

end;

////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////

procedure TMainForm.SceneGameOver;
Const
 Counter : Integer=0;
 Mode    : Integer=0;
begin

  DXDraw.Surface.Fill(0);
  TmpImageList1.Items[0].Draw(DXDraw.Surface, 0, 0, 0);

  with DXDraw.Surface.Canvas do
  begin
    Brush.Style := bsClear;
    if ( (FBlink div 300) mod 2=0 )
    and (Mode=0)then
    begin
      Font.Color := clRed;
      Font.Size := 30;
      Font.Name:='Times New Roman';
      Textout(160, 420, 'Push ''Spase to Exit ''  ');
    end;
    BlinkUpdate;
    Release;
  end;

  if ( isButton1 in DXInput.States ) and (Mode=0) then
  begin
    //PlaySound('SceneMov', False);
    Mode:=1;
  end;

  If Mode=1 then Inc(Counter);
  If Counter> 200 then EndSceneGameOver;

end;

procedure TMainForm.DXDrawMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
MouseXY:=Point(X,Y);

case FScene of
 //gsTitle   :
 gsMainMenu : SceneMainMenuMouseMove(Shift,X,Y);
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.MouseMove(Shift,X,Y);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.MouseMove(Shift,X,Y);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.MouseMove(Shift,X,Y);

 gsMain     : SceneMainMouseMove(Shift,X,Y);

 //gsGameOver:
end;

end;

procedure TMainForm.DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
case FScene of
 //gsTitle   : SceneTitleMouseDown(Shift: TShiftState; X, Y: Integer);
 gsMainMenu : SceneMainMenuMouseDown(Shift,X,Y);
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.MouseDown(Button,Shift,X,Y);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.MouseDown(Button,Shift,X,Y);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.MouseDown(Button,Shift,X,Y);

 gsMain     : SceneMainMouseDown(Shift,X,Y);
 //gsGameOver: SceneGameOverMouseDown(Shift: TShiftState; X, Y: Integer);
end;
end;


procedure TMainForm.DXDrawMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
case FScene of
// gsTitle   : SceneTitleMouseDown(Shift: TShiftState; X, Y: Integer);
 gsMainMenu: SceneMainMenuMouseUp(Shift,X,Y);
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.MouseUp(Button,Shift,X,Y);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.MouseUp(Button,Shift,X,Y);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.MouseUp(Button,Shift,X,Y);

 gsMain    : SceneMainMouseUp(Shift,X,Y);
 // gsGameOver: SceneGameOverMouseDown(Shift: TShiftState; X, Y: Integer);
end;
end;


procedure TMainForm.SceneMainMenuMouseUp(Shift: TShiftState; X, Y: Integer);
Var
 i          : integer;
begin
if TDXImageButton(FBtnList[0]).Selected then
 begin
  TDXImageButton(FBtnList[0]).Selected:=False;
  StartScene(gsMain);
  Exit;
 end;


if TDXImageButton(FBtnList[1]).Selected then
 begin
  StartScene(gsMultiPlayerMenu1);
  Exit;
 end;


if TDXImageButton(FBtnList[4]).Selected then
 begin
  TDXImageButton(FBtnList[4]).Selected:=False;
  StartScene(gsGameOver);
  Exit;
 end;

For i:=0 to FBtnList.Count-1
 do TDXImageButton(FBtnList[i]).Selected:=False;

end;

procedure TMainForm.SceneMainMenuMouseDown(Shift: TShiftState; X, Y: Integer);
Var
 i         : integer;
 DownPoint : TPoint;
 r          : TRect;
begin
DownPoint:=Point(x,y);
For i:=0 to FBtnList.Count-1 do
  begin
   r:=TDXImageButton(FBtnList[i]).BoundsRect;
   if PtInRect(r,DownPoint) then TDXImageButton(FBtnList[i]).Selected:=true;
  end;
end;


procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 JobList.SaveToFile(GetName('JobList.txt'));
 Action:=caFree;
end;

procedure TMainForm.PrintScreen;
Const
 N : integer=1;
Var
 //Dib : TDib;
 NewGraphic : TDIB;
 FileName   : String;
begin
 NewGraphic := TDIB.Create;
 try
  DXDraw.Primary.AssignTo(NewGraphic);
  FileName:=GetName('Screen'+IntToStr(N)+'.bmp');
  Inc(N);
  NewGraphic.SaveToFile(FileName);
 finally
  NewGraphic.free;
 end;
end;

function GetFirstToken(S: string; Token: Char): string;
var
  Temp  : string;
  Index : INteger;
begin
  Index := Pos(Token, S);
  if Index < 1 then begin
    Result:= '';
    Exit;
  end;
  Dec(Index);
  SetLength(Temp, Index);
  Move(S[1], Temp[1], Index);
  Result := Temp;
end;


//......................................................................

procedure TMainForm.SavePicData(var DXImageList : TDXImageList; FileName : string);
Var
 i           : integer;
 Item        : TPictureCollectionItem;
 SectionName : string;
 Ident       : string;
begin
FileName:=ChangeFileExt(FileName,'.dat');

if FileExists(GetName('Graphics\data',FileName)) then Exit;
With TIniFile.Create(GetName('Graphics\data',FileName)) do
 try
 For i:=0 to DXImageList.Items.Count-1 do
  begin
   Item:=DXImageList.Items[i];
   SectionName:=Item.Name;

   Ident:='PictureHeight';
   WriteInteger(SectionName,Ident,Item.Picture.Height);
   Ident:='PictureWidth';
   WriteInteger(SectionName,Ident,Item.Picture.Width);

   Ident:='PatternHeight';
   WriteInteger(SectionName,Ident,Item.PatternHeight);
   Ident:='PatternWidth';
   WriteInteger(SectionName,Ident,Item.PatternWidth);

   Ident:='SkipHeight';
   WriteInteger(SectionName,Ident,Item.SkipHeight);
   Ident:='SkipWidth';
   WriteInteger(SectionName,Ident,Item.SkipWidth);

   Ident:='SystemMemory';
   WriteBool(SectionName,Ident,Item.SystemMemory);

   Ident:='Transparent';
   WriteBool(SectionName,Ident,Item.Transparent);

   Ident:='TransparentColor';
   WriteString(SectionName,Ident,ColorToString(Item.TransparentColor));

  end;

 Finally
  Free;
 end;

end;

Procedure TMainForm.LoadPicData( var DXImageList : TDXImageList; FileName : string);
Var
 i           : integer;
 Item        : TPictureCollectionItem;
 SectionName : string;
 Ident       : string;
 NewGraphic  : TDIB;
 BitMap      : TBitMap;
 DXGFileName : string;
 PicFileName : string;
 SectionList : TStringList;
 JpgImg      : TJPEGImage;
 Ext         : String;
begin
DXImageList.Items.Clear;

DXGFileName:=GetName('Graphics\DXG',ChangeFileExt(FileName,'.dxg'));
if FileExists(DXGFileName) then
 begin
  DXImageList.Items.LoadFromFile(DXGFileName);
  Exit;
 end;

FileName:=ChangeFileExt(FileName,'.dat');
NewGraphic  := TDIB.Create;
BitMap      := TBitMap.Create;

SectionList := TStringList.Create;

try
With TIniFile.Create(GetName('Graphics\data',FileName)) do
 try
 ReadSections(SectionList);
 For i:=0 to SectionList.Count-1 do
  begin
  SectionName:=SectionList[i];

  Ext:='bmp';
  PicFileName:=GetName('Graphics',Ext+'\'+SectionName+'.'+Ext);

  if FileExists(PicFileName) then
   begin
    NewGraphic.LoadFromFile(PicFileName);
   end
  else
  //if FileExists(PicFileName) then
   begin
    Ext:='jpg';
    PicFileName:=GetName('Graphics',Ext+'\'+SectionName+'.'+Ext);
    JpgImg:=TJPEGImage.Create;
    try
     JpgImg.LoadFromFile(PicFileName);
     NewGraphic.Assign(JpgImg);
    finally
     JpgImg.Free;
    end;

   end;

   Item := TPictureCollectionItem.Create(DXImageList.Items);
   Item.Picture.Graphic := NewGraphic;

   Item.Name:=SectionName;

   Ident:='PatternHeight';
   Item.PatternHeight:=ReadInteger(SectionName,Ident,0);
   Ident:='PatternWidth';
   Item.PatternWidth:=ReadInteger(SectionName,Ident,0);

   Ident:='SkipHeight';
   Item.SkipHeight:=ReadInteger(SectionName,Ident,0);
   Ident:='SkipWidth';
   Item.SkipWidth:=ReadInteger(SectionName,Ident,0);

   Ident:='SystemMemory';
   Item.SystemMemory:=ReadBool(SectionName,Ident,false);

   Ident:='Transparent';
   Item.Transparent:=ReadBool(SectionName,Ident,false);

   Ident:='TransparentColor';
   Item.TransparentColor:=StringToColor(ReadString(SectionName,Ident,'clBlack'));
   Item.Restore;
  end;

 Finally
  Free;
 end;

Finally
 NewGraphic.Free;
 BitMap.Free;
 SectionList.Free;
end;

//DXImageList.DXDraw:=nil;
//DXImageList.DXDraw:=DXDraw;// do not work without it !!!!! ???????????

end;


procedure TMainForm.LoadWaves;  // do not work !!!!! ???????????
Var
 FResult       : integer;
 SearchRec     : TSearchRec;
 Item          : TWaveCollectionItem;
 SoundName     : String ;
begin
if FileExists(GetName('Sound\DXW','SpriteEffect.dxw')) then
begin
 MainForm.DXWaveList.Items.LoadFromFile(GetName('Sound\DXW','SpriteEffect.dxw'));
 Exit;
end;

FResult:=FindFirst(GetName('Sound\Wav','*.wav'),faArchive,SearchRec);
While FResult=0 do begin
 SoundName:=GetFirstToken(SearchRec.name,'.');
 Item := TWaveCollectionItem.Create(DXWaveList.Items);
 Item.Name := SoundName;
 Item.Wave.LoadFromFile(GetName('Sound\Wav',SearchRec.name));
 Item.Restore;
 FResult:=FindNext(SearchRec);

end;
Sysutils.FindClose(SearchRec);

//DXWaveList.DXSound:=DXSound;// do not work without it !!!!! ???????????
end;

procedure TMainForm.DXSoundInitialize(Sender: TObject);
var
WaveFormat:TWaveFormatEx;
begin
 //MakePCMWaveFormatEx(WaveFormat,11025,8,1);
 MakePCMWaveFormatEx(WaveFormat,22050,16,1);
 DXSound.Primary.SetFormat(WaveFormat);
end;



procedure TMainForm.SceneMainMenuMouseMove(Shift: TShiftState; X,
  Y: Integer);
Var
 i          : integer;
 MousePoint : TPoint;
 r          : TRect;
begin
MousePoint:=Point(x,y);
For i:=0 to FBtnList.Count-1 do
  begin
   r:=TDXImageButton(FBtnList[i]).BoundsRect;
   if PtInRect(r,MousePoint)
    then TDXImageButton(FBtnList[i]).HighLighted:=true
     else TDXImageButton(FBtnList[i]).HighLighted:=false;
  end;
end;

procedure TMainForm.DXDrawKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Case Key of
   VK_ESCAPE  : Close;
   VK_F12     : PrintScreen;
  end;

case FScene of
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.KeyDown(Key,Shift);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.KeyDown(Key,Shift);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.KeyDown(Key,Shift);
end;

end;

procedure TMainForm.DXDrawKeyPress(Sender: TObject; var Key: Char);
begin
case FScene of
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.KeyPress(Key);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.KeyPress(Key);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.KeyPress(Key);
end;
end;

procedure TMainForm.DXDrawKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
case FScene of
 gsMultiPlayerMenu1 : SceneMultiPlayerMenu1.KeyUp(Key,Shift);
 gsMultiPlayerMenu2 : SceneMultiPlayerMenu2.KeyUp(Key,Shift);
 gsMultiPlayerMenu3 : SceneMultiPlayerMenu3.KeyUp(Key,Shift);
end;
end;

procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
//
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -