📄 main.pas
字号:
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 + -