Subversion Repositories jumper

Rev

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