📄 unit_main.pas
字号:
begin
for lrm_i := -1 to 1 do
for lrm_j :=-1 to 1do
case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32
end;
end;
31,21,22,23,24,25,26,27,28:
begin
for lrm_i := -1 to 1 do
for lrm_j :=-1 to 1do
if (lrm_i =0 ) and(lrm_j=0 ) then
Continue
else
case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32;
end;
end;
33 :
begin
lrm_UpGridArray .Grid [lrm_Col ][lrm_Row ]:= 32;
for lrm_i := -1 to 1 do
for lrm_j :=-1 to 1 do
if (lrm_i =0 ) and(lrm_j=0 ) then
Continue
else
case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32;
end;
end;
end;
end;
procedure TFrm_Main.Image_BackGroundMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
moveCol,moveRow:integer;
begin
//跳出过程的情况如下
if isGameOver or isGamePaused or not(isLeftBtnDown or isLeftAndRightBtnDown ) then
exit;
ChangePixelToBlock(x,y,moveCol ,moveRow );
//对照鼠标移动到的方块是否是当前的方块
if(moveCol <> LocalCol ) or (moveRow <> LocalRow ) then
if isLeftAndRightBtnDown then
//左右键一通按下时的移动
begin
//移出本方块,使其还原
LeftAndRightBtnMoveOut(DownGridArray ,UpGridArray ,LocalCol,LocalRow );
LocalCol :=moveCol;
LocalRow :=moveRow ;
//如果没有移出 Image 的区域,则执行新方块的被左右键一同按下的操作
if (movecol >= 1 ) and (moveRow >= 1 ) and (moveCol <= UserTotalCols ) and (moveRow <= UserTotalRows )then
LeftAndRightBtnDown (DownGridArray,UpGridArray ,LocalCol ,LocalRow );
end else
if isLeftBtnDown then
//只有左键被按下
begin
//移出本方块,使其还原
leftBtnMoveOut(DownGridArray ,UpGridArray ,LocalCol ,LocalRow );
LocalCol :=moveCol ;
LocalRow :=moveRow ;
//如果没有移出 Image 的区域,则执行新方块的被左键按下的操作
if (LocalCol >= 1 ) and (LocalRow >= 1 ) and (LocalCol <= UserTotalCols) and (LocalRow <= UserTotalRows )then
LeftBtnDown(DownGridArray ,UpGridArray ,LocalCol ,LocalRow );
end;
DrawBackGround(UpGridArray ,false)
end;
procedure TFrm_Main.Timer_DisplayTimer(Sender: TObject);
begin
if isHaveSound then
sndPlaySound(pchar(comdir+g_ResourceName +g_sound_second),SND_ASYNC );
//使用 GetTickCount 以确保程序时间的准确性.
TotalTime :=(GetTickCount -Begin_Time ) div 1000 +1;
DrawHead(TotalTime ,d_right );
end;
procedure CheckMainFormPosition(frm_check:TForm );
begin
//确保界面或是对话框存在于屏幕内部
if frm_check .Left < 0 then
frm_check.Left := 0;
if frm_check .Top < 0 then
frm_check .Top := 0;
if (frm_check .Left + frm_check .Width ) >Screen .Width then
frm_check .Left := Screen.Width - frm_check .Width ;
//30 是任务栏的高度
if (frm_check .Top + frm_check .Height )>screen.Height-30 then
frm_check .Top := Screen .Height-30 -frm_check .Height ;
end;
procedure TFrm_Main.Panel_topMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if isGameOver then
exit;
if button = mbleft then
begin
ChgSpbtnGlyph(f_O );
end;
Image_BackGroundMouseDown (self, Button , Shift,x-Image_BackGround.left , y - Panel_bottom.Top - Image_BackGround.top);
end;
procedure TFrm_Main.Panel_topMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if isGameOver then
exit;
if Button = mbleft then
begin
ChgSpbtnGlyph(f_smile );
isLeftBtnDown :=False;
end else
isRightbtnDown :=False;
Image_BackGroundMouseUp (self,button,shift,x-Image_BackGround.left , y - Panel_bottom.Top - Image_BackGround.top);
end;
procedure TFrm_Main.Menu_Lv_BClick(Sender: TObject);
begin
initApplication(v_Beginner ,g_Level_1_Col ,g_Level_1_Row ,g_Level_1_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure TFrm_Main.Menu_Lv_IClick(Sender: TObject);
begin
initApplication(v_Middle ,g_Level_2_Col ,g_Level_2_Row ,g_Level_2_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure TFrm_Main.Menu_Lv_EClick(Sender: TObject);
begin
initApplication(v_Expert ,g_Level_3_Col ,g_Level_3_Row ,g_Level_3_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure TFrm_Main.Menu_Lv_PClick(Sender: TObject);
begin
initApplication(v_Professional ,g_Level_4_Col ,g_Level_4_Row ,g_Level_4_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure TFrm_Main.N1Click(Sender: TObject);
begin
initApplication(UserLevel ,UserTotalCols ,UserTotalRows ,UserBombCount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure TFrm_Main.Menu_FlagClick(Sender: TObject);
begin
isHaveQuestion :=not isHaveQuestion ;
Menu_Flag .Checked :=isHaveQuestion ;
checkMainFormPosition(Frm_Main );
end;
procedure TFrm_Main.Menu_ColorClick(Sender: TObject);
begin
isHaveColor :=not isHaveColor ;
Menu_Color .Checked :=isHaveColor ;
checkMainFormPosition(Frm_Main );
DrawBackGround (UpGridArray ,True);
DrawHead(UserBombCount -FlagCount ,d_left );
DrawHead(TotalTime ,d_right);
if not isGameOver then
ChgSpbtnGlyph (f_smile )
else
if isGameWin then
ChgSpbtnGlyph(f_glass)
else
ChgSpbtnGlyph(f_sad);
end;
procedure TFrm_Main.Menu_SoundClick(Sender: TObject);
begin
isHaveSound :=not isHaveSound ;
Menu_Sound .Checked := isHaveSound ;
checkMainFormPosition(Frm_Main );
end;
procedure TFrm_Main.Menu_Lv_CClick(Sender: TObject);
begin
//初始化自定义 的Form ,并且 ShowModal;
Application.CreateForm(TFrm_Choose, Frm_Choose);
Frm_Choose .ShowModal ;
//如果自定义了,则接受 Frm_Choose 传过来的参数.否则还是按当前的参数开始新局
if UNit_Choose.Changed then
initApplication(v_UserDefine ,Unit_Choose.userW, Unit_Choose.UserH ,Unit_Choose.UserM ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType )
else
initApplication(UserLevel ,UserTotalCols ,UserTotalRows ,UserBombCount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;
procedure ExportIniFile(var i_level:TGameLevel ;var i_totalCols,i_totalRows,i_bombCount:integer; var i_isHaveQuestion,i_isHaveColor,i_isHaveSound, i_isHaveStatusBar:boolean; var i_LanguageType:TLanguageType);
var
e_REG:TRegistry;
begin
//从注册表读取新信息
e_REG:=TRegistry.Create;
e_REG.RootKey:=HKEY_CURRENT_USER;
with e_REG do
begin
OpenKey(g_REG_InfoPath ,False);
case ReadInteger('Level') of
11: i_level :=v_Beginner ;
12: i_level :=v_Middle ;
13: i_level :=v_Expert ;
14: i_level :=v_Professional ;
20: i_level :=v_UserDefine;
else i_level :=v_Middle;
end;
i_totalCols :=ReadInteger ('LocalCols');
i_totalRows :=ReadInteger('LocalRows');
case ReadInteger('Language') of
10: i_LanguageType :=l_Chinese_Simplified ;
11: i_LanguageType :=l_Chinese_Traditional ;
20: i_LanguageType :=l_English ;
else i_LanguageType :=l_Chinese_Simplified;
end;
Frm_Main .Left :=ReadInteger('Pos_Left');
Frm_Main .Top :=ReadInteger('Pos_Top');
i_bombCount :=ReadInteger('BombCount');
i_ishaveQuestion :=ReadBool('IsHaveQuestion');
i_ishaveColor :=ReadBool('IsHaveColor');
i_ishaveSound :=ReadBool('IsHaveSound');
i_ishaveStatusBar:=ReadBool('IsHaveStatusBar');
CloseKey;
free;
end;
end;
procedure TFrm_Main.T1Click(Sender: TObject);
begin
Application.CreateForm(TFrm_Hero, Frm_Hero);
Frm_Hero.ShowModal ;
checkMainFormPosition(Frm_Main );
end;
procedure TFrm_Main.A1Click(Sender: TObject);
begin
Application.CreateForm(TFrm_About, Frm_About);
frm_About .ShowModal ;
end;
procedure TFrm_Main.C2Click(Sender: TObject);
begin
ShellExecute (Application.Handle,pchar('open'),pchar(comdir+g_ResourceName+g_ChmFileName),nil,nil,SW_show);
end;
procedure TFrm_Main.Image_FaceMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft then
begin
Timer_Display .Enabled :=False;
ChgSpbtnGlyph(f_smileDown );
end;
end;
procedure TFrm_Main.Image_FaceMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (x < 0) or (y < 0) or (x > Image_Face.Width) or (y > Image_Face.Height ) then
begin
if (not isGameOver) and (GameStatus =s_Sweeping )then
begin
TotalTime :=TotalTime +1;
if isHaveSound then
sndPlaySound(pchar(comdir+g_ResourceName +g_Sound_Second),SND_ASYNC );
DrawHead(TotalTime,d_right );
Timer_Display.Enabled :=true
end;
if isGameWin then
ChgSpbtnGlyph(f_glass )
else if isGameLost then
ChgSpbtnGlyph(f_sad)
else
ChgSpbtnGlyph(f_smile );
end else
if (button = mbleft ){and (isGameOver ) }then
N1Click (self);
end;
// For cheating !
procedure TFrm_Main.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
{ if( key =27) and (isLeftAndRightBtnDown ) then
Timer_Display.Enabled :=false;
}
end;
procedure TFrm_Main.Panel_topMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if isGameOver then
exit;
Image_BackGroundMouseMove(self, Shift, x-Image_BackGround.left , y-Panel_bottom .top-Image_BackGround.top);
end;
procedure TFrm_Main.Image_Dis_BombCountMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseMove(self,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;
procedure TFrm_Main.Image_Dis_TimeMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseMove(self,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;
procedure TFrm_Main.Image_Dis_BombCountMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseDown(self,button,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;
procedure TFrm_Main.Image_Dis_TimeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseDown(self,button,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;
procedure TFrm_Main.Image_Dis_BombCountMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseUp(self,button,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;
procedure TFrm_Main.Image_Dis_TimeMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseUp(self,button,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;
procedure TFrm_Main.Panel_Display_leftMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseDown(self,button,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;
procedure TFrm_Main.Panel_Display_leftMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseMove(self,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;
procedure TFrm_Main.Panel_Display_leftMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseUp(self,button,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;
procedure TFrm_Main.Panel_Display_rightMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Panel_topMouseDown(self,button,shift,x + Panel_Display
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -