?? main.pas
字號:
{*************************************************}
{*************** 連連看1.0 ************}
{*************** 開發(fā) 孔祥吉 ************}
{*************完成于 07.3.5 哈薩克斯坦************}
{*********本軟件為共享免費軟件版權屬于作者********}
{***任何單位和個人不經作者同意禁止用于商業(yè)盈利****}
{*******開發(fā)者引用本程序請保留開發(fā)者信息**********}
{*************************************************}
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DXPlay, DXInput, DXSounds, DXSprite, DXDraws, DIB,DXClass,DirectX,
ExtCtrls, Menus, ToolWin, ComCtrls, MPlayer,Math,Regest;
type
TMonoSprite = class;
TSpriteImageID = Set of 1..100;
TLanguageType = (ltChs,ltEng);
TSpriteXY = record
X,Y: integer;
ID,ImageID: integer;
XID,YID: integer;
dead,throut,show: boolean;
MonoSprite: TMonoSprite;
end;
TRandomEvent = record
ID: integer;
Add: integer;
end;
TGameState = (gtWait,gtRuning,gtPaused,gtGameOver);
TForm1 = class(TForm)
DXDraw: TDXDraw;
ImageList: TDXImageList;
DXSpriteEngine: TDXSpriteEngine;
DXWaveList1: TDXWaveList;
DXInput: TDXInput;
DXPlay1: TDXPlay;
DXSound1: TDXSound;
DXTimer1: TDXTimer;
DXImageList1: TDXImageList;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
game1: TMenuItem;
NewGame1: TMenuItem;
GameOver1: TMenuItem;
Exit1: TMenuItem;
about1: TMenuItem;
about: TMenuItem;
other1: TMenuItem;
hint1: TMenuItem;
wash1: TMenuItem;
aa1: TMenuItem;
Auto1: TMenuItem;
Level1: TMenuItem;
Normal1: TMenuItem;
Easy1: TMenuItem;
Hard1: TMenuItem;
Level2: TMenuItem;
Music1: TMenuItem;
Sound1: TMenuItem;
BackgroundMusic1: TMenuItem;
Language1: TMenuItem;
Chinese1: TMenuItem;
English1: TMenuItem;
N2: TMenuItem;
MediaPlayer1: TMediaPlayer;
ModesMenu: TMenuItem;
BackImage: TDXImageList;
EndGame1: TMenuItem;
Regest1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Exit1Click(Sender: TObject);
procedure NewGame1Click(Sender: TObject);
procedure aboutClick(Sender: TObject);
procedure GameOver1Click(Sender: TObject);
procedure wash1Click(Sender: TObject);
procedure aa1Click(Sender: TObject);
procedure hint1Click(Sender: TObject);
procedure Auto1Click(Sender: TObject);
procedure Easy1Click(Sender: TObject);
procedure Normal1Click(Sender: TObject);
procedure Hard1Click(Sender: TObject);
procedure Level2Click(Sender: TObject);
procedure Music1Click(Sender: TObject);
procedure BackgroundMusic1Click(Sender: TObject);
procedure Sound1Click(Sender: TObject);
procedure MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean);
procedure Chinese1Click(Sender: TObject);
procedure English1Click(Sender: TObject);
procedure Language1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure MediaPlayer1Notify(Sender: TObject);
procedure DXDrawInitialize(Sender: TObject);
procedure EndGame1Click(Sender: TObject);
procedure game1Click(Sender: TObject);
procedure other1Click(Sender: TObject);
procedure about1Click(Sender: TObject);
procedure Regest1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FAngle: Integer;
FShowRegTime: integer;
FShowReg: boolean;
FRanEventID: TRandomEvent;
FocusedSprite,FocusedSprite1: array[0..1] of TSpriteXY;
FSurface: TDirectDrawSurface;
FScore,FBaseScore,FTotleScore,FOneSpriteScore,FIniScore,CurLostIndex: integer;
Language: TLanguageType;
FImageW,FImageH,FBackImageW,FBackImageH,w,h,Ax,Ay: integer;
FX,FY: integer;
FLevel,FStep,FTime,FOneTime,FLostTime,incTime,incTime1,incTime2,incTime3: integer;
FGameState: TGameState;
{FPaused: boolean;
FGameOver: boolean;
FPassAll: boolean;
Fstart: boolean; }
SelfDo: boolean;
IS800x600: boolean;
Washing,FCLose,FStop: boolean;
FBackMusic,FMusic: boolean;
FHint,FWash: integer;
FProgressW,FProgressH,FProgressT: integer;
FProgressC: TColor;
FSprites: array of array of TSpriteXY;
FRoadPoint,FFirstRoadPoint: array[0..1] of TSpriteXY;
NumStrs: array[1..10] of string;
FStrs: array[1..100] of string;
FRanEventName: array[1..5] of string;
FSpritesCount,ImageCount,OneImageCount: integer;
FSpritesCount2,OneImageCount2,ImageCount2: integer;
procedure ChangeLanguge(AType: TLanguageType);
procedure AssignPoint(SourPoint: TSpriteXY; var DesPoint: TSpriteXY);
procedure Initialize(isStep: boolean = false);
procedure FocusedSprites(AX,AY: integer);
procedure UnFocusedSprite;
procedure DeadSprite;
procedure InitializeSprite;
procedure Randomsprite;
procedure RandomEvent;
procedure WashSprite;
procedure MoveSprite(AStep: integer);
procedure InitializeID;
procedure DrawLine(X1,Y1,X2,Y2: integer;ACanvas: TCanvas;PenColor: TColor);
procedure getXY(Count: integer;var x: integer;var y: integer);
procedure getRaodPoint(StPoint,EndPoint: TSpriteXY;var RoadPoint1,RoadPoint2: TSpriteXY);
procedure getFirstRaodPoint(var RoadPoint1,RoadPoint2: TSpriteXY;ISF4: boolean = false);
procedure NewGame(ALeavel: integer = 2);
procedure PauseGame;
procedure GameOver;
procedure DoPassStep;
procedure EndGame;
procedure PlayBackMusic(Play: boolean=true);
public
constructor Create(AOwner: TComponent);override;
procedure ModeItemClick(Sender: TObject);
{ Public declarations }
end;
TMonoSprite = class(TImageSprite)
private
FCounter: Double;
FS: Integer;
Focused,OldFocused: boolean;
procedure Hit;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
protected
//FDefaultGammaRamp: TDDGammaRamp;
procedure Click;dynamic;
public
ID: integer;
ImageID: integer;
XID,YID: integer;
ISDead: boolean;
//FS: Integer;
procedure DoMove(MoveCount: Integer); override;
procedure DoDead;
end;
TMyBackGroubd = class(TBackgroundSprite)
protected
procedure DoCollision(Sprite: TSprite; var Done: Boolean); override;
procedure DoMove(MoveCount: Integer); override;
//procedure DoClick;override;
end;
var
Form1: TForm1;
FRegInfo: TRegInfo;
FDecKey: TMemoEncKey ;
FParentFile: TFileStream;
ChsNum: array[1..10] of string = ('第一關','第二關','第三關','第四關',
'第五關','第六關','第七關','第八關','第九關','第十關');
ChsStr: array[1..48] of string = ( '無變化',
'左移',
'右移',
'左右分離',
'左右集中',
'上移',
'下移',
'上下分離',
'上下集中',
'時間剩余 : ',
'提示(F4)剩余 :',
'重洗(F5)剩余 : ',
' 次',
'共 ',
' 種圖片',
'每種 ',
'剩余 ',
' 對',
'游戲',
'新游戲',
'暫停',
'退出',
'設置',
'等級',
'容易',
'一般',
'困難',
'聲音',
'音效',
'背景音樂',
'其他',
'提示',
'重洗',
'語言',
'中文',
'英文',
'自動',
'幫助',
'關于',
'恭喜過關,繼續(xù)下一難度',
'恭喜通關,重新開始?',
'見縫插針',
'排名',
'連連看 1.0',
'結束游戲',
'恢復',
'未注冊',
'天'
);
RanEventName: array[1..5] of string =('提示增加',
'重新洗牌增加',
'分數(shù)增加',
'時間增加',
''
);
EngNum: array[1..10] of string = ('First Step','Second Step','Third Step',
'Fourth Step','Fifths Step','Sixth Step',
'Seventh Step','Eighth Step','Ninth Step',
'Tenth Step');
EngStr: array[1..48] of string = ( 'No Change',
'Left',
'Right',
'Left And Right',
'Left and Right To Center',
'Up',
'Down',
'Up And Down',
'Top and Bottom To Center',
'Remain Time : ',
'Remain Hint(F4) : ',
'Remain Shuffle(F5) : ',
'',
'',
' Type pictures',
'Every Type ',
'Remain ',
' Twain',
'Game',
'New Game',
'Pause',
'Exit',
'Setting',
'Level',
'Easy',
'Normal',
'Hard',
'Sound',
'Music',
'BackGround Music',
'Other',
'Hint',
'Shuffle',
'Language',
'Chinese',
'English',
'Auto',
'Help',
'About',
'Congratulation!Next Level?',
'Congratulation! You Pass All Level,Again?',
'Make use of every bit of time or space',
'Sequence',
'Look for Link 1.0',
'End Game',
'Resume',
'Not Registered',
'Days'
);
RanEventNameEn: array[1..5] of string =('Hint Add',
'Shuffle Add',
'Scores Add',
'Time Add',
''
);
procedure CheckUseInfo(var ARegInfo: TRegInfo;ADecKey: TMemoEncKey);
implementation
uses about,Scores, Reg;
{$R *.dfm}
{$R MIDI.RES}
procedure CheckUseInfo(var ARegInfo: TRegInfo;ADecKey: TMemoEncKey);
var
Reginfo: TRegInfo;
DecKey: TMemoEncKey;
function ISSameSn(Sn1,Sn2: FSn) :boolean;
var
i: integer;
begin
result := true;
for i := low(Sn1) to high(Sn1) do
begin
if Sn1[i] <> Sn2[i] then
begin
result := false;
break;
end;
end;
end;
procedure AssignSn(var Sn1: TRegInfo;Sn2: FSn);
var
i: integer;
begin
for i := low(Sn2) to high(Sn2) do
begin
Sn1.Sn[i] := Sn2[i];
end;
end;
procedure getOldUserInfo;
var
File1,File2: TFileStream;
begin
if not(Fileexists(RegFileName)) then
begin
File1 := TFileStream.Create(RegFileName,fmCreate);
WriteUserInfo(ARegInfo,ADecKey,TStream(File1));
File1.Free;
end;
if FileExists(RegFileName) then
try
FileSetAttr(RegFileName,faSysFile or faHidden);
except
end;
File1 := TFileStream.Create(RegFileName,fmOpenReadWrite);
GetRegInfo(RegInfo,DecKey,File1);
ARegInfo.RunData := Max(ARegInfo.RunData,RegInfo.RunData);
ARegInfo.InstallDate := Min(ARegInfo.InstallDate,RegInfo.InstallDate);
if round(Date - ARegInfo.InstallDate)+2 > ARegInfo.RunData then
begin
ARegInfo.RunData := round(Date - ARegInfo.InstallDate)+2;
end
else if round(Date - ARegInfo.InstallDate)+2 < ARegInfo.RunData then
begin
ARegInfo.RunData := FMaxRunData;
end;
if ARegInfo.RunData = 0 then
ARegInfo.RunData := 1;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -