Subversion Repositories jumper

Rev

Rev 22 | Rev 24 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls,
  7.   ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Playground: TPanel;
  12.     MainMenu: TMainMenu;
  13.     Help1: TMenuItem;
  14.     MExit: TMenuItem;
  15.     Statistics: TStatusBar;
  16.     Timer: TTimer;
  17.     MNewGame: TMenuItem;
  18.     Help2: TMenuItem;
  19.     MAbout: TMenuItem;
  20.     MHelp: TMenuItem;
  21.     N5: TMenuItem;
  22.     MJumpHistory: TMenuItem;
  23.     N2: TMenuItem;
  24.     N4: TMenuItem;
  25.     MHighScores: TMenuItem;
  26.     MRestartGame: TMenuItem;
  27.     MSettings: TMenuItem;
  28.     MEnableSound: TMenuItem;
  29.     MPauseTime: TMenuItem;
  30.     N1: TMenuItem;
  31.     MUndo: TMenuItem;
  32.     N3: TMenuItem;
  33.     Aboutthislevel1: TMenuItem;
  34.     procedure MExitClick(Sender: TObject);
  35.     procedure TimerTimer(Sender: TObject);
  36.     procedure MNewGameClick(Sender: TObject);
  37.     procedure MAboutClick(Sender: TObject);
  38.     procedure FormShow(Sender: TObject);
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure FormDestroy(Sender: TObject);
  41.     procedure MJumpHistoryClick(Sender: TObject);
  42.     procedure MRestartGameClick(Sender: TObject);
  43.     procedure MHighScoresClick(Sender: TObject);
  44.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  45.     procedure MHelpClick(Sender: TObject);
  46.     procedure MUndoClick(Sender: TObject);
  47.     procedure Aboutthislevel1Click(Sender: TObject);
  48.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  49.   private
  50.     NoCloseQuery: boolean;
  51.     CountedSeconds: Integer;
  52.     LevelFile: String;
  53.     PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
  54.     PlaygroundMatrix: TPlayGroundMatrix;
  55.     Points: Integer;
  56.     LevelTotalStones: Integer;
  57.     LevelRemovedStones: Integer;
  58.     JumpHistory: TStringList;
  59.     Level: TLevel;
  60.     procedure LoadSettings;
  61.     procedure SaveSettings;
  62.     procedure RestartLevel;
  63.     procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
  64.     procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
  65.     function AskForLevel: String;
  66.     procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
  67.     procedure NewGame(Filename: string);
  68.     function LevelTime: String;
  69.     procedure DestroyLevel;
  70.     procedure RefreshTime;
  71.     procedure RefreshPoints;
  72.     procedure RefreshStonesRemoved;
  73.     procedure RemoveStone(x, y: integer; count_points: boolean);
  74.     procedure DoJump(SourceTag, DestTag: integer);
  75.     function MayJump(SourceTag, DestTag: integer): boolean; overload;
  76.     procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  77.     procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
  78.     function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
  79.     function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
  80.     function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
  81.     procedure BuildPlayground(LevelArray: TLevelArray);
  82.     procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
  83.     function GoalStatus: TGoalStatus;
  84.   end;
  85.  
  86. var
  87.   MainForm: TMainForm;
  88.  
  89. implementation
  90.  
  91. uses
  92.   About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
  93.  
  94. {$R *.dfm}
  95.  
  96. { TMainForm }
  97.  
  98. procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
  99. var
  100.   x, y: integer;
  101. begin
  102.   for x := Low(Matrix.Fields) to High(Matrix.Fields) do
  103.   begin
  104.     for y := Low(Matrix.Fields[x]) to High(Matrix.Fields[x]) do
  105.     begin
  106.       if Assigned(Matrix.Fields[x][y].Stone) then
  107.       begin
  108.         LoadPictureForType(Matrix.Fields[x][y].FieldType, Matrix.Fields[x][y].Stone.Picture);
  109.         StoneDraggingAllow(Matrix.Fields[x][y].Stone, Matrix.FieldState(Matrix.Fields[x][y].FieldType) <> fsAvailable);
  110.       end;
  111.     end;
  112.   end;
  113. end;
  114.  
  115. procedure TMainForm.DestroyLevel;
  116. var
  117.   i: Integer;
  118. begin
  119.   MPauseTime.Checked := false;
  120.   MPauseTime.Enabled := false;
  121.   Timer.Enabled := false;
  122.  
  123.   MRestartGame.Enabled := false;
  124.  
  125.   LevelFile := '';
  126.  
  127.   CountedSeconds := 0;
  128.   RefreshTime;
  129.  
  130.   Points := 0;
  131.   RefreshPoints;
  132.  
  133.   LevelRemovedStones := 0;
  134.   LevelTotalStones := 0;
  135.   RefreshStonesRemoved;
  136.  
  137.   JumpHistory.Clear;
  138.  
  139.   PlayGroundMatrix.ClearMatrix(true);
  140.   for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
  141.     PrevPlaygroundMatrixes[i].ClearMatrix(false);
  142.   SetLength(PrevPlaygroundMatrixes, 0);
  143.   MUndo.Enabled := false;
  144.  
  145.   if Assigned(Level) then FreeAndNil(Level);
  146. end;
  147.  
  148. procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
  149. begin
  150.   case FieldType of
  151.     ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
  152.     ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
  153.     ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
  154.     ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
  155.   end;
  156. end;
  157.  
  158. function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
  159. begin
  160.   result := TImage.Create(panel);
  161.   result.Parent := panel;
  162.   LoadPictureForType(fieldtype, result.Picture);
  163.   result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
  164.   result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
  165.   result.Left := MET_SHAPE_MARGIN;
  166.   result.Top := MET_SHAPE_MARGIN;
  167.   result.Center := true;
  168.   result.Transparent := true;
  169.  
  170.   result.Tag := panel.Tag;
  171.   result.OnDragOver := panel.OnDragOver;
  172.   result.OnDragDrop := panel.OnDragDrop;
  173.  
  174.   StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
  175. end;
  176.  
  177. procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
  178. begin
  179.   if Allow then
  180.   begin
  181.     Stone.DragMode := dmAutomatic;
  182.     (Stone.Parent as TPanel).DragMode := dmAutomatic;
  183.   end
  184.   else
  185.   begin
  186.     Stone.DragMode := dmManual;
  187.     (Stone.Parent as TPanel).DragMode := dmManual;
  188.   end;
  189. end;
  190.  
  191. function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
  192. begin
  193.   result := TPanel.Create(Playground);
  194.   result.Parent := Playground;
  195.   if isGoal then
  196.   begin
  197.     result.BevelInner := bvLowered;
  198.   end;
  199.   result.Color := Playground.Color;
  200.   result.BevelOuter := bvLowered;
  201.   result.Width := MET_FIELD_SIZE;
  202.   result.Height := MET_FIELD_SIZE;
  203.   result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);
  204.   result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
  205.  
  206.   result.Tag := tag;
  207.   result.OnDragOver := StoneDragOver;
  208.   result.OnDragDrop := StoneDragDrop;
  209. end;
  210.  
  211. procedure TMainForm.MExitClick(Sender: TObject);
  212. begin
  213.   Close;
  214. end;
  215.  
  216. procedure TMainForm.RefreshTime;
  217. begin
  218.   Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
  219. end;
  220.  
  221. procedure TMainForm.RefreshStonesRemoved;
  222. resourcestring
  223.   LNG_STONES_REMOVED = '%d of %d stones removed';
  224. begin
  225.   Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
  226. end;
  227.  
  228. procedure TMainForm.RefreshPoints;
  229. begin
  230.   Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
  231. end;
  232.  
  233. procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
  234. begin
  235.   if count_points then
  236.   begin
  237.     Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));
  238.     RefreshPoints;
  239.  
  240.     Inc(LevelRemovedStones);
  241.     RefreshStonesRemoved;
  242.   end;
  243.  
  244.   PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;
  245.   LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);
  246.   StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);
  247. end;
  248.  
  249. procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
  250. var
  251.   mode: string;
  252.   goalYeSNo: string;
  253. resourcestring
  254.   LNG_BOARD = 'Board: %s';
  255.   LNG_MODE = 'Mode: %s';
  256.   LNG_STONES_TOTAL = 'Stones: %d';
  257.   LNG_GOAL_AVAILABLE = 'Target field defined';
  258.   LNG_NO_GOAL = 'No target field';
  259. begin
  260.   case Level.GameMode of
  261.     gmNormal:    mode := 'Diagonal';
  262.     gmDiagonal:  mode := 'Normal';
  263.     gmUndefined: mode := '?';
  264.   end;
  265.  
  266.   if GoalStatus = gsNoGoal then
  267.     goalYeSNo := LNG_NO_GOAL
  268.   else
  269.     goalYeSNo := LNG_GOAL_AVAILABLE;
  270.  
  271.   ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
  272.               #13#10 +
  273.               Format(LNG_MODE, [mode]) + #13#10 +
  274.               Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
  275.               goalYesNo);
  276. end;
  277.  
  278. procedure TMainForm.DoJump(SourceTag, DestTag: integer);
  279. resourcestring
  280.   LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
  281. var
  282.   d, s: TCoord;
  283.   old_fieldtype: TFieldType;
  284.   res: Integer;
  285. begin
  286.   if not MayJump(SourceTag, DestTag) then exit;
  287.  
  288.   s := PlaygroundMatrix.IndexToCoord(SourceTag);
  289.   d := PlaygroundMatrix.IndexToCoord(DestTag);
  290.  
  291.   JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
  292.  
  293.   {$REGION 'Stein entfernen und Punkte vergeben'}
  294.   if Level.GameMode = gmDiagonal then
  295.   begin
  296.     if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y-1) = fsStone) then RemoveStone(s.X-1, s.Y-1, true);
  297.     if (s.X-2 = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y+1) = fsStone) then RemoveStone(s.X-1, s.Y+1, true);
  298.     if (s.X+2 = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y-1) = fsStone) then RemoveStone(s.X+1, s.Y-1, true);
  299.     if (s.X+2 = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y+1) = fsStone) then RemoveStone(s.X+1, s.Y+1, true);
  300.   end;
  301.  
  302.   if (s.X+2 = d.X) and (s.Y = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y  ) = fsStone) then RemoveStone(s.X+1, s.Y, true);
  303.   if (s.X-2 = d.X) and (s.Y = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y  ) = fsStone) then RemoveStone(s.X-1, s.Y, true);
  304.   if (s.X = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X  , s.Y+1) = fsStone) then RemoveStone(s.X, s.Y+1, true);
  305.   if (s.X = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X  , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true);
  306.   {$ENDREGION}
  307.  
  308.   // Den Timer erst nach dem ersten Zug starten
  309.   // oder nach einer Pause neustarten
  310.   MPauseTime.Checked := false;
  311.   MPauseTime.Enabled := true;
  312.   Timer.Enabled := true;
  313.  
  314.   // Sound abspielen
  315.   if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  316.  
  317.   {$REGION 'Nun den Stein springen lassen'}
  318.   old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken
  319.   RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
  320.   PlayGroundMatrix.Fields[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
  321.   LoadPictureForType(PlayGroundMatrix.Fields[d.X, d.Y].FieldType, PlayGroundMatrix.Fields[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
  322.   StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
  323.   {$ENDREGION}
  324.  
  325.   {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
  326.   if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
  327.   begin
  328.     MPauseTime.Checked := false;
  329.     MPauseTime.Enabled := false;
  330.     Timer.Enabled := false;
  331.     RefreshTime;
  332.     if MEnableSound.Checked then
  333.     begin
  334.       if LevelRemovedStones = LevelTotalStones-1 then
  335.       begin
  336.         if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
  337.           PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
  338.         else
  339.           PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
  340.       end
  341.       else
  342.         PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  343.     end;
  344.     res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
  345.     if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
  346.   end;
  347.   {$ENDREGION}
  348.  
  349.   SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
  350.   PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
  351.   MUndo.Enabled := true;
  352. end;
  353.  
  354. function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
  355. var
  356.   s, d: TCoord;
  357. begin
  358.   s := PlayGroundMatrix.IndexToCoord(SourceTag);
  359.   d := PlayGroundMatrix.IndexToCoord(DestTag);
  360.  
  361.   result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);
  362. end;
  363.  
  364. procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
  365. begin
  366.   DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
  367. end;
  368.  
  369. procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
  370.   Y: Integer; State: TDragState; var Accept: Boolean);
  371. begin
  372.   Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
  373. end;
  374.  
  375. function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
  376. var
  377.   newField: TField;
  378.   index: integer;
  379. begin
  380.   ZeroMemory(@result, SizeOf(result));
  381.   if t.Typ = ftFullSpace then exit;
  382.  
  383.   index := PlaygroundMatrix.CoordToIndex(x, y);
  384.  
  385.   newField.FieldType := t.Typ;
  386.   newField.Goal := t.Goal;
  387.   newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
  388.   newField.Stone := DrawStone(t.Typ, newField.Panel);
  389.  
  390.   result := newField;
  391. end;
  392.  
  393. procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
  394. var
  395.   y, x: integer;
  396.   max_x, max_y: integer;
  397.   p: TPanel;
  398.   newField: TField;
  399. begin
  400.   PlayGround.Visible := false;
  401.  
  402.   // Attention: PlaygroundMatrix is indexed [x,y] while LevelArray is indexed [y,x]
  403.   // TODO: PlaygroundMatrix and LevelArray are redundant. Can't we just replace one with the other?
  404.   PlaygroundMatrix.InitFieldArray(Length(LevelArray[0].Fields), Length(LevelArray));
  405.  
  406.   max_x := 0;
  407.   max_y := 0;
  408.   for y := Low(LevelArray) to High(LevelArray) do
  409.   begin
  410.     for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
  411.     begin
  412.       if TPlayGroundMatrix.FieldState(LevelArray[y].Fields[x].Typ) = fsStone then
  413.         Inc(LevelTotalStones);
  414.       newField := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent);
  415.       PlaygroundMatrix.Fields[x, y] := newField;
  416.       p := newField.Panel;
  417.       if Assigned(p) then
  418.       begin
  419.         max_x := Max(max_x, p.Left + p.Width);
  420.         max_y := Max(max_y, p.Top  + p.Height);
  421.       end;
  422.     end;
  423.   end;
  424.  
  425.   PlayGround.Visible := true;
  426.  
  427.   // Das Form an das Level anpassen
  428.   PlayGround.Top    := MET_OUTER_MARGIN;
  429.   PlayGround.Left   := MET_OUTER_MARGIN;
  430.   PlayGround.Width  := max_x;
  431.   PlayGround.Height := max_y;
  432.   ClientWidth       := 2 * MET_OUTER_MARGIN + PlayGround.Width;
  433.   ClientHeight      := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
  434.  
  435.   // If the board is too small, ClientWidth/ClientHeight will stop at a minimum value
  436.   // in this case, we make sure that the Playground is centered
  437.   PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;
  438.   PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;
  439.  
  440.   Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
  441.   Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
  442.  
  443.   SetLength(PrevPlaygroundMatrixes,1);
  444.   PrevPlaygroundMatrixes[0] := PlayGroundMatrix.CloneMatrix;
  445.   MUndo.Enabled := false;
  446. end;
  447.  
  448. procedure TMainForm.TimerTimer(Sender: TObject);
  449. begin
  450.   if MPauseTime.Checked then exit;
  451.   if mainform.Focused then Inc(CountedSeconds);
  452.   RefreshTime;
  453. end;
  454.  
  455. function TMainForm.LevelTime: String;
  456. begin
  457.   result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)
  458. end;
  459.  
  460. procedure TMainForm.NewGame(Filename: string);
  461. resourcestring
  462.   LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
  463. var
  464.   LevelArray: TLevelArray;
  465. begin
  466.   DestroyLevel;
  467.  
  468.   MPauseTime.Checked := true;
  469.   MPauseTime.Enabled := true;
  470.   Timer.Enabled := true;
  471.   MRestartGame.Enabled := true;
  472.  
  473.   LevelFile := Filename;
  474.   Level := TLevel.Create(LevelFile);
  475.   LevelArray := Level.LevelStringToLevelArray(true);
  476.   if Length(LevelArray) = 0 then Exit;
  477.   BuildPlayground(LevelArray);
  478.   if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
  479.   begin
  480.     MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
  481.   end;
  482.   RefreshTime;
  483.   RefreshStonesRemoved;
  484.   RefreshPoints;
  485. end;
  486.  
  487. procedure TMainForm.MNewGameClick(Sender: TObject);
  488. begin
  489.   LevelFile := AskForLevel;
  490.   if LevelFile <> '' then
  491.   begin
  492.     NewGame(LevelFile);
  493.   end;
  494. end;
  495.  
  496. procedure TMainForm.MAboutClick(Sender: TObject);
  497. begin
  498.   AboutBox.ShowModal;
  499. end;
  500.  
  501. function TMainForm.AskForLevel: String;
  502. begin
  503.   LevelChoice.ShowModal;
  504.  
  505.   if LevelChoice.ModalResult <> mrOK then
  506.   begin
  507.     result := '';
  508.     exit;
  509.   end;
  510.  
  511.   result := LevelChoice.SelectedLevel;
  512. end;
  513.  
  514. procedure TMainForm.FormShow(Sender: TObject);
  515. begin
  516.   LevelFile := AskForLevel;
  517.   if LevelFile <> '' then
  518.   begin
  519.     NewGame(LevelFile);
  520.   end
  521.   else
  522.   begin
  523.     NoCloseQuery := true;
  524.     Close;
  525.   end;
  526. end;
  527.  
  528. function TMainForm.GoalStatus: TGoalStatus;
  529. var
  530.   ft: TFieldType;
  531. begin
  532.   if not PlaygroundMatrix.MatrixHasGoal then
  533.     result := gsNoGoal
  534.   else if LevelRemovedStones < LevelTotalStones-1 then
  535.     Result := gsMultipleStonesRemaining
  536.   else
  537.   begin
  538.     ft := PlaygroundMatrix.GoalFieldType;
  539.     if ft = ftRed then
  540.       result := gsLastStoneInGoalRed
  541.     else if ft = ftYellow then
  542.       result := gsLastStoneInGoalYellow
  543.     else if ft = ftGreen then
  544.       result := gsLastStoneInGoalGreen
  545.     else
  546.       result := gsUndefined;
  547.   end;
  548. end;
  549.  
  550. procedure TMainForm.FormCreate(Sender: TObject);
  551. begin
  552.   JumpHistory := TStringList.Create;
  553.   LoadSettings;
  554. end;
  555.  
  556. procedure TMainForm.FormDestroy(Sender: TObject);
  557. begin
  558.   DestroyLevel;
  559.   JumpHistory.Free;
  560. end;
  561.  
  562. procedure TMainForm.MJumpHistoryClick(Sender: TObject);
  563. begin
  564.   HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
  565.   HistoryForm.ShowModal;
  566. end;
  567.  
  568. procedure TMainForm.RestartLevel;
  569. var
  570.   i: Integer;
  571. begin
  572.   MPauseTime.Checked := true;
  573.   MPauseTime.Enabled := true;
  574.   Timer.Enabled := true;
  575.  
  576.   CountedSeconds := 0;
  577.   RefreshTime;
  578.  
  579.   Points := 0;
  580.   RefreshPoints;
  581.  
  582.   LevelRemovedStones := 0;
  583.   RefreshStonesRemoved;
  584.  
  585.   JumpHistory.Clear;
  586.  
  587.   RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
  588.   SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
  589.   for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
  590.     PrevPlaygroundMatrixes[i].ClearMatrix(false);
  591.   SetLength(PrevPlaygroundMatrixes, 1);
  592.  
  593.   MUndo.Enabled := false;
  594. end;
  595.  
  596. procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
  597. begin
  598.   PlayGroundMatrix.ClearMatrix(false); // Memory Leak verhindern
  599.   PlayGroundMatrix := Matrix.CloneMatrix;
  600. end;
  601.  
  602. procedure TMainForm.MRestartGameClick(Sender: TObject);
  603. begin
  604.   RestartLevel;
  605. end;
  606.  
  607. procedure TMainForm.MUndoClick(Sender: TObject);
  608. var
  609.   PrevWorth: integer;
  610.   NewWorth: integer;
  611. begin
  612.   if Length(PrevPlaygroundMatrixes) > 1 then
  613.   begin
  614.     PrevWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
  615.  
  616.     PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].ClearMatrix(false);
  617.     SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
  618.  
  619.     NewWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
  620.     RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  621.     SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  622.  
  623.     JumpHistory.Delete(JumpHistory.Count-1);
  624.  
  625.     Dec(LevelRemovedStones);
  626.     RefreshStonesRemoved;
  627.  
  628.     Dec(Points, NewWorth-PrevWorth);
  629.     RefreshPoints;
  630.  
  631.     // Sound abspielen
  632.     if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  633.   end;
  634.  
  635.   MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
  636. end;
  637.  
  638. procedure TMainForm.MHighScoresClick(Sender: TObject);
  639. begin
  640.   HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
  641. end;
  642.  
  643. procedure TMainForm.LoadSettings;
  644. var
  645.   reg: TRegistry;
  646. begin
  647.   reg := TRegistry.Create;
  648.   try
  649.     reg.RootKey := HKEY_CURRENT_USER;
  650.     if reg.OpenKeyReadOnly(REG_KEY) then
  651.     begin
  652.       if reg.ValueExists(REG_SOUND) then
  653.         MEnableSound.Checked := reg.ReadBool(REG_SOUND);
  654.       reg.CloseKey;
  655.     end;
  656.   finally
  657.     reg.Free;
  658.   end;
  659. end;
  660.  
  661. procedure TMainForm.SaveSettings;
  662. var
  663.   reg: TRegistry;
  664. begin
  665.   reg := TRegistry.Create;
  666.   try
  667.     reg.RootKey := HKEY_CURRENT_USER;
  668.     if reg.OpenKey(REG_KEY, true) then
  669.     begin
  670.       reg.WriteBool(REG_SOUND, MEnableSound.Checked);
  671.       reg.CloseKey;
  672.     end;
  673.   finally
  674.     reg.Free;
  675.   end;
  676. end;
  677.  
  678. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  679. begin
  680.   SaveSettings;
  681.   if FinishForm.NameEdit.Text <> '' then
  682.   begin
  683.     FinishForm.SaveSettings;
  684.   end;
  685. end;
  686.  
  687. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  688. resourcestring
  689.   LNG_REALLY_QUIT = 'Do you really want to quit?';
  690. begin
  691.   CanClose := NoCloseQuery or (MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes);
  692. end;
  693.  
  694. procedure TMainForm.MHelpClick(Sender: TObject);
  695. begin
  696.   HelpForm.ShowModal;
  697. end;
  698.  
  699. end.
  700.