Subversion Repositories jumper

Rev

Rev 6 | Rev 8 | 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.   TField = record
  11.     FieldType: TFieldType;
  12.     Goal: Boolean;
  13.     Panel: TPanel;
  14.     Stone: TImage;
  15.   end;
  16.  
  17.   TFieldState = (fsError, fsLocked, fsAvailable, fsStone);
  18.  
  19.   TPlayGroundMatrix = array of array of TField;
  20.  
  21.   TMainForm = class(TForm)
  22.     Playground: TPanel;
  23.     MainMenu: TMainMenu;
  24.     Help1: TMenuItem;
  25.     MExit: TMenuItem;
  26.     Statistics: TStatusBar;
  27.     Timer: TTimer;
  28.     MNewGame: TMenuItem;
  29.     Help2: TMenuItem;
  30.     MAbout: TMenuItem;
  31.     MHelp: TMenuItem;
  32.     N5: TMenuItem;
  33.     MJumpHistory: TMenuItem;
  34.     N2: TMenuItem;
  35.     N4: TMenuItem;
  36.     MHighScores: TMenuItem;
  37.     MRestartGame: TMenuItem;
  38.     MSettings: TMenuItem;
  39.     MEnableSound: TMenuItem;
  40.     MPauseTime: TMenuItem;
  41.     N1: TMenuItem;
  42.     MUndo: TMenuItem;
  43.     N3: TMenuItem;
  44.     procedure MExitClick(Sender: TObject);
  45.     procedure TimerTimer(Sender: TObject);
  46.     procedure MNewGameClick(Sender: TObject);
  47.     procedure MAboutClick(Sender: TObject);
  48.     procedure FormShow(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure FormDestroy(Sender: TObject);
  51.     procedure MJumpHistoryClick(Sender: TObject);
  52.     procedure MRestartGameClick(Sender: TObject);
  53.     procedure MHighScoresClick(Sender: TObject);
  54.     procedure MPauseTimeClick(Sender: TObject);
  55.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  56.     procedure MHelpClick(Sender: TObject);
  57.     procedure MEnableSoundClick(Sender: TObject);
  58.     procedure MUndoClick(Sender: TObject);
  59.   private
  60.     CountedSeconds: Integer;
  61.     LevelFile: String;
  62.     LookupFieldCoordinateArray: array of TPoint;
  63.     OriginalPlayGroundMatrix: TPlayGroundMatrix;
  64.     PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
  65.     PlaygroundMatrix: TPlayGroundMatrix;
  66.     Points: Integer;
  67.     LevelTotalStones: Integer;
  68.     LevelRemovedStones: Integer;
  69.     JumpHistory: TStringList;
  70.     procedure LoadSettings;
  71.     procedure SaveSettings;
  72.     procedure RestartLevel;
  73.     procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
  74.     procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
  75.     function AskForLevel: String;
  76.     function AreJumpsPossible: boolean;
  77.     procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
  78.     procedure NewGame(Filename: string);
  79.     function LevelTime: String;
  80.     procedure DestroyLevel;
  81.     procedure RefreshTime;
  82.     procedure RefreshPoints;
  83.     procedure RefreshStonesRemoved;
  84.     procedure CountPoints(t: TFieldType);
  85.     procedure RemoveStone(x, y: integer; count_points: boolean);
  86.     procedure DoJump(SourceTag, DestTag: integer);
  87.     function CanJump(x, y: integer): boolean;
  88.     function MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; overload;
  89.     function MayJump(SourceTag, DestTag: integer): boolean; overload;
  90.     procedure StoneDragOver(Sender, Source: TObject; X,
  91.       Y: Integer; State: TDragState; var Accept: Boolean);
  92.     procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
  93.     procedure DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
  94.     function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
  95.     function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
  96.     procedure BuildPlayground(LevelArray: TLevelArray);
  97.     function FieldState(t: TFieldType): TFieldState; overload;
  98.     function FieldState(f: TField): TFieldState; overload;
  99.     function FieldState(x, y: integer): TFieldState; overload;
  100.     procedure ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
  101.     function CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
  102.     procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
  103.     function MatrixWorth(Matrix: TPlayGroundMatrix): integer;
  104.     function FieldTypeWorth(t: TFieldType): integer;
  105.   end;
  106.  
  107. var
  108.   MainForm: TMainForm;
  109.  
  110. implementation
  111.  
  112. uses
  113.   About, Finish, Choice, Functions, History, HighScore, Help, Constants;
  114.  
  115. {$R *.dfm}
  116.  
  117. function TMainForm.MatrixWorth(Matrix: TPlayGroundMatrix): integer;
  118. var
  119.   i, j: integer;
  120. begin
  121.   result := 0;
  122.   for i := Low(Matrix) to High(Matrix) do
  123.   begin
  124.     for j := Low(Matrix[i]) to High(Matrix[i]) do
  125.     begin
  126.       Inc(result, FieldTypeWorth(Matrix[i][j].FieldType));
  127.     end;
  128.   end;
  129. end;
  130.  
  131. procedure TMainForm.ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
  132. var
  133.   i, j: integer;
  134. begin
  135.   for i := Low(Matrix) to High(Matrix) do
  136.   begin
  137.     for j := Low(Matrix[i]) to High(Matrix[i]) do
  138.     begin
  139.       if FreeVCL then
  140.       begin
  141.         if Assigned(Matrix[i][j].Stone) then Matrix[i][j].Stone.Free;
  142.         if Assigned(Matrix[i][j].Panel) then Matrix[i][j].Panel.Free;
  143.       end;
  144.     end;
  145.     SetLength(Matrix[i], 0);
  146.   end;
  147.   SetLength(Matrix, 0);
  148. end;
  149.  
  150. procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
  151. var
  152.   i, j: integer;
  153. begin
  154.   for i := Low(Matrix) to High(Matrix) do
  155.   begin
  156.     for j := Low(Matrix[i]) to High(Matrix[i]) do
  157.     begin
  158.       if Assigned(Matrix[i][j].Stone) then
  159.       begin
  160.         LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture);
  161.         StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable);
  162.       end;
  163.     end;
  164.   end;
  165. end;
  166.  
  167. procedure TMainForm.DestroyLevel;
  168. var
  169.   i: Integer;
  170. begin
  171.   MPauseTime.Enabled := false;
  172.   Timer.Enabled := false;
  173.  
  174.   MRestartGame.Enabled := false;
  175.  
  176.   LevelFile := '';
  177.  
  178.   CountedSeconds := 0;
  179.   RefreshTime;
  180.  
  181.   Points := 0;
  182.   RefreshPoints;
  183.  
  184.   LevelRemovedStones := 0;
  185.   LevelTotalStones := 0;
  186.   RefreshStonesRemoved;
  187.  
  188.   JumpHistory.Clear;
  189.  
  190.   ClearMatrix(PlayGroundMatrix, true);
  191.   ClearMatrix(OriginalPlayGroundMatrix, false);
  192.   for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
  193.     ClearMatrix(PrevPlaygroundMatrixes[i], false);
  194.   SetLength(PrevPlaygroundMatrixes, 0);
  195.   MUndo.Enabled := false;
  196.  
  197.   SetLength(LookupFieldCoordinateArray, 0);
  198. end;
  199.  
  200. procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
  201. begin
  202.   case FieldType of
  203.     ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
  204.     ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
  205.     ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
  206.     ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
  207.   end;
  208. end;
  209.  
  210. function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
  211. begin
  212.   result := TImage.Create(panel);
  213.   result.Parent := panel;
  214.   LoadPictureForType(fieldtype, result.Picture);
  215.   result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
  216.   result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
  217.   result.Left := MET_SHAPE_MARGIN;
  218.   result.Top := MET_SHAPE_MARGIN;
  219.   result.Center := true;
  220.   result.Transparent := true;
  221.  
  222.   result.Tag := panel.Tag;
  223.   result.OnDragOver := panel.OnDragOver;
  224.   result.OnDragDrop := panel.OnDragDrop;
  225.  
  226.   StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable);
  227. end;
  228.  
  229. procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
  230. begin
  231.   if Allow then
  232.   begin
  233.     Stone.DragMode := dmAutomatic;
  234.     (Stone.Parent as TPanel).DragMode := dmAutomatic;
  235.   end
  236.   else
  237.   begin
  238.     Stone.DragMode := dmManual;
  239.     (Stone.Parent as TPanel).DragMode := dmManual;
  240.   end;
  241. end;
  242.  
  243. function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
  244. begin
  245.   result := TPanel.Create(Playground);
  246.   result.Parent := Playground;
  247.   if isGoal then
  248.   begin
  249.     result.BevelInner := bvLowered;
  250.   end;
  251.   result.Color := Playground.Color;
  252.   result.BevelOuter := bvLowered;
  253.   result.Width := MET_FIELD_SIZE;
  254.   result.Height := MET_FIELD_SIZE;
  255.   result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE - (halftabs*MET_HALFTAB_SIZE);
  256.   result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
  257.  
  258.   result.Tag := tag;
  259.   result.OnDragOver := StoneDragOver;
  260.   result.OnDragDrop := StoneDragDrop;
  261. end;
  262.  
  263. procedure TMainForm.MExitClick(Sender: TObject);
  264. begin
  265.   Close;
  266. end;
  267.  
  268. function TMainForm.FieldState(t: TFieldType): TFieldState;
  269. begin
  270.   result := fsError;
  271.   case t of
  272.     ftLocked:        result := fsLocked;
  273.     ftLockedWithTab: result := fsLocked;
  274.     ftEmpty:         result := fsAvailable;
  275.     ftGreen:         result := fsStone;
  276.     ftYellow:        result := fsStone;
  277.     ftRed:           result := fsStone;
  278.   end;
  279. end;
  280.  
  281. function TMainForm.FieldState(f: TField): TFieldState;
  282. begin
  283.   result := FieldState(f.FieldType);
  284. end;
  285.  
  286. function TMainForm.FieldState(x, y: integer): TFieldState;
  287. begin
  288.   result := fsError;
  289.   if (x < Low(PlayGroundMatrix)) or (x > High(PlayGroundMatrix)) then exit;
  290.   if (y < Low(PlayGroundMatrix[x])) or (y > High(PlayGroundMatrix[x])) then exit;
  291.  
  292.   result := FieldState(PlayGroundMatrix[x][y]);
  293. end;
  294.  
  295. procedure TMainForm.RefreshTime;
  296. begin
  297.   Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
  298. end;
  299.  
  300. procedure TMainForm.RefreshStonesRemoved;
  301. begin
  302.   Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones]);
  303. end;
  304.  
  305. procedure TMainForm.RefreshPoints;
  306. begin
  307.   Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
  308. end;
  309.  
  310. function TMainForm.FieldTypeWorth(t: TFieldType): integer;
  311. begin
  312.   if t = ftGreen then result := 10
  313.   else if t = ftYellow then result := 20
  314.   else if t = ftRed then result := 30
  315.   else result := 0;
  316. end;
  317.  
  318. procedure TMainForm.CountPoints(t: TFieldType);
  319. begin
  320.   inc(Points, FieldTypeWorth(t));
  321.   RefreshPoints;
  322. end;
  323.  
  324. procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
  325. begin
  326.   if count_points then
  327.   begin
  328.     CountPoints(PlayGroundMatrix[x, y].FieldType);
  329.     Inc(LevelRemovedStones);
  330.     RefreshStonesRemoved;
  331.   end;
  332.   PlayGroundMatrix[x, y].FieldType := ftEmpty;
  333.   LoadPictureForType(PlayGroundMatrix[x, y].FieldType, PlayGroundMatrix[x, y].Stone.Picture);
  334.   StoneDraggingAllow(PlayGroundMatrix[x, y].Stone, false);
  335. end;
  336.  
  337. function TMainForm.CanJump(x, y: integer): boolean;
  338. begin
  339.   if FieldState(x, y) <> fsStone then
  340.   begin
  341.     result := false;
  342.     exit;
  343.   end;
  344.  
  345.   result := true;
  346.  
  347.   if MayJump(x, y, x+2, y) then exit;
  348.   if MayJump(x, y, x-2, y) then exit;
  349.   if MayJump(x, y, x, y+2) then exit;
  350.   if MayJump(x, y, x, y-2) then exit;
  351.  
  352.   if AllowDiagonalMoves then
  353.   begin
  354.     if MayJump(x, y, x-2, y-2) then exit;
  355.     if MayJump(x, y, x+2, y-2) then exit;
  356.     if MayJump(x, y, x-2, y+2) then exit;
  357.     if MayJump(x, y, x+2, y+2) then exit;
  358.   end;
  359.  
  360.   result := false;
  361. end;
  362.  
  363. function TMainForm.AreJumpsPossible: boolean;
  364. var
  365.   i, j: integer;
  366. begin
  367.   result := false;
  368.   for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do
  369.   begin
  370.     for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do
  371.     begin
  372.       if CanJump(i, j) then
  373.       begin
  374.         result := true;
  375.         break;
  376.       end;
  377.       if result then break;
  378.     end;
  379.   end;
  380. end;
  381.  
  382. procedure TMainForm.DoJump(SourceTag, DestTag: integer);
  383. var
  384.   d, s: TPoint;
  385.   old_fieldtype: TFieldType;
  386.   res: Integer;
  387. begin
  388.   if not MayJump(SourceTag, DestTag) then exit;
  389.  
  390.   d := LookupFieldCoordinateArray[DestTag];
  391.   s := LookupFieldCoordinateArray[SourceTag];
  392.  
  393.   JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
  394.  
  395.   {$REGION 'Stein entfernen und Punkte vergeben'}
  396.   if AllowDiagonalMoves then
  397.   begin
  398.     if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X-1, s.Y-1) = fsStone) then RemoveStone(s.X-1, s.Y-1, true);
  399.     if (s.X-2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X-1, s.Y+1) = fsStone) then RemoveStone(s.X-1, s.Y+1, true);
  400.     if (s.X+2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X+1, s.Y-1) = fsStone) then RemoveStone(s.X+1, s.Y-1, true);
  401.     if (s.X+2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X+1, s.Y+1) = fsStone) then RemoveStone(s.X+1, s.Y+1, true);
  402.   end;
  403.  
  404.   if (s.X+2 = d.X) and (s.Y = d.Y) and (FieldState(s.X+1, s.Y  ) = fsStone) then RemoveStone(s.X+1, s.Y, true);
  405.   if (s.X-2 = d.X) and (s.Y = d.Y) and (FieldState(s.X-1, s.Y  ) = fsStone) then RemoveStone(s.X-1, s.Y, true);
  406.   if (s.X = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X  , s.Y+1) = fsStone) then RemoveStone(s.X, s.Y+1, true);
  407.   if (s.X = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X  , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true);
  408.   {$ENDREGION}
  409.  
  410.   // Den Timer erst nach dem ersten Zug starten
  411.   // oder nach einer Pause neustarten
  412.   if not Timer.Enabled then
  413.   begin
  414.     MPauseTime.Enabled := true;
  415.     Timer.Enabled := true;
  416.   end;
  417.  
  418.   MRestartGame.Enabled := true;
  419.  
  420.   // Sound abspielen
  421.   if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  422.  
  423.   {$REGION 'Nun den Stein springen lassen'}
  424.   old_fieldtype := PlayGroundMatrix[s.X, s.Y].FieldType; // Steinfarbe merken
  425.   RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
  426.   PlayGroundMatrix[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
  427.   LoadPictureForType(PlayGroundMatrix[d.X, d.Y].FieldType, PlayGroundMatrix[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
  428.   StoneDraggingAllow(PlayGroundMatrix[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
  429.   {$ENDREGION}
  430.  
  431.   {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
  432.   if not AreJumpsPossible then
  433.   begin
  434.     MPauseTime.Enabled := false;
  435.     Timer.Enabled := false;
  436.     RefreshTime;
  437.     if MEnableSound.Checked then
  438.     begin
  439.       if LevelRemovedStones = LevelTotalStones then
  440.         PlaySound(RES_FINISH, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
  441.       else
  442.         PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  443.     end;
  444.     res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, JumpHistory);
  445.     if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
  446.   end;
  447.   {$ENDREGION}
  448.  
  449.   SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
  450.   PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := CloneMatrix(PlaygroundMatrix);
  451.   MUndo.Enabled := true;
  452. end;
  453.  
  454. function TMainForm.MayJump(SourceX, SourceY, DestX, DestY: integer): boolean;
  455. begin
  456.   result := false;
  457.  
  458.   // Check 1: Ist das Zielfeld überhaupt leer?
  459.   if FieldState(DestX, DestY) <> fsAvailable then exit;
  460.  
  461.   // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
  462.   if AllowDiagonalMoves then
  463.   begin
  464.     if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true;
  465.     if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true;
  466.     if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true;
  467.     if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
  468.   end;
  469.  
  470.   if (SourceX+2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX+1, SourceY  ) = fsStone) then result := true;
  471.   if (SourceX-2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX-1, SourceY  ) = fsStone) then result := true;
  472.   if (SourceX   = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX  , SourceY+1) = fsStone) then result := true;
  473.   if (SourceX   = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX  , SourceY-1) = fsStone) then result := true;
  474. end;
  475.  
  476. function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
  477. var
  478.   s, d: TPoint;
  479. begin
  480.   d := LookupFieldCoordinateArray[DestTag];
  481.   s := LookupFieldCoordinateArray[SourceTag];
  482.  
  483.   result := MayJump(s.X, s.Y, d.X, d.Y);
  484. end;
  485.  
  486. procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
  487. begin
  488.   DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
  489. end;
  490.  
  491. procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
  492.   Y: Integer; State: TDragState; var Accept: Boolean);
  493. begin
  494.   Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
  495. end;
  496.  
  497. procedure TMainForm.DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
  498. var
  499.   newField: TField;
  500.   index: integer;
  501. begin
  502.   if (t.Typ = ftLocked) or (t.Typ = ftLockedWithTab) then exit;
  503.  
  504.   index := Length(LookupFieldCoordinateArray);
  505.  
  506.   newField.FieldType := t.Typ;
  507.   newField.Goal := t.Goal;
  508.   newField.Panel := DrawStoneBox(x, y, index, halftabs, t.Goal);
  509.   newField.Stone := DrawStone(t.Typ, newField.Panel);
  510.   if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
  511.  
  512.   SetLength(LookupFieldCoordinateArray, index + 1);
  513.   LookupFieldCoordinateArray[index].X := x;
  514.   LookupFieldCoordinateArray[index].Y := y;
  515.  
  516.   if Length(PlayGroundMatrix) < x+1 then SetLength(PlayGroundMatrix, x+1);
  517.   if Length(PlayGroundMatrix[x]) < y+1 then SetLength(PlayGroundMatrix[x], y+1);
  518.   PlaygroundMatrix[x, y] := newField;
  519. end;
  520.  
  521. function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
  522. var
  523.   i, j: integer;
  524. begin
  525.   SetLength(result, Length(Source));
  526.   for i := Low(Source) to High(Source) do
  527.   begin
  528.     SetLength(result[i], Length(Source[i]));
  529.     for j := Low(Source[i]) to High(Source[i]) do
  530.     begin
  531.       result[i][j].FieldType := Source[i][j].FieldType;
  532.       result[i][j].Goal      := Source[i][j].Goal;
  533.       result[i][j].Panel     := Source[i][j].Panel;
  534.       result[i][j].Stone     := Source[i][j].Stone;
  535.     end;
  536.   end;
  537. end;
  538.  
  539. procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
  540. var
  541.   i, j, halftabs, cur_x: integer;
  542.   max_x, max_y, old_cw, old_ch: integer;
  543. begin
  544.   PlayGround.Visible := false;
  545.  
  546.   // Die Dimensionen ermitteln
  547.   max_x := 0;
  548.   for i := Low(LevelArray) to High(LevelArray) do
  549.   begin
  550.     halftabs := 0;
  551.     for j := Low(LevelArray[i]) to High(LevelArray[i]) do
  552.     begin
  553.       if LevelArray[i][j].Typ = ftLockedWithTab then inc(halftabs);
  554.       DrawField(j, i, LevelArray[i][j], halftabs);
  555.     end;
  556.     cur_x := High(LevelArray[i]) + 1;
  557.     if cur_x > max_x then max_x := cur_x;
  558.   end;
  559.   max_y := High(LevelArray) + 1;
  560.  
  561.   PlayGround.Visible := true;
  562.  
  563.   // Die aktuellen Dimensionen merken
  564.   old_cw := ClientWidth;
  565.   old_ch := ClientHeight;
  566.  
  567.   // Das Form an das Level anpassen
  568.   PlayGround.Width := MET_FIELD_SPACE + max_x * (MET_FIELD_SPACE + MET_FIELD_SIZE);
  569.   PlayGround.Height := MET_FIELD_SPACE + max_y * (MET_FIELD_SPACE + MET_FIELD_SIZE);
  570.   ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width;
  571.   ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
  572.  
  573.   Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
  574.   Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
  575.  
  576.   // Wenn sich das Form vergrößert oder verkleinert hat, neu justieren
  577.   if (old_cw <> ClientWidth) or (old_ch <> ClientHeight) then
  578.   begin
  579.     Left := Screen.Width div 2 - Width div 2;
  580.     Top := Screen.Height div 2 - Height div 2;
  581.    
  582.     // Playground mittig setzen, falls die Mindestgröße für die
  583.     // Punkteanzeige unterschritten wurde,
  584.     PlayGround.Left := ClientWidth div 2 - PlayGround.Width div 2;
  585.     PlayGround.Top := ClientHeight div 2 - PlayGround.Height div 2;
  586.   end;
  587.  
  588.   OriginalPlayGroundMatrix := CloneMatrix(PlayGroundMatrix);
  589.   SetLength(PrevPlaygroundMatrixes,1);
  590.   PrevPlaygroundMatrixes[0] := CloneMatrix(PlayGroundMatrix);
  591.   MUndo.Enabled := false;
  592. end;
  593.  
  594. procedure TMainForm.TimerTimer(Sender: TObject);
  595. begin
  596.   if mainform.Focused then Inc(CountedSeconds);
  597.   RefreshTime;
  598. end;
  599.  
  600. function TMainForm.LevelTime: String;
  601. begin
  602.   result := SecondsToTimeString(CountedSeconds);
  603. end;
  604.  
  605. procedure TMainForm.NewGame(Filename: string);
  606. var
  607.   LevelString: String;
  608.   LevelArray: TLevelArray;
  609. begin                          
  610.   DestroyLevel;
  611.   LevelFile := Filename;
  612.   LevelString := ReadFile(LevelFile);
  613.   LevelArray := LevelStringToLevelArray(LevelString, true);
  614.   if Length(LevelArray) = 0 then Exit;
  615.   BuildPlayground(LevelArray);
  616.   if not AreJumpsPossible then
  617.   begin
  618.     ShowMessage(LNG_LVL_INVALID_NO_JUMP);
  619.   end;
  620.   RefreshTime;
  621.   RefreshStonesRemoved;
  622.   RefreshPoints;
  623. end;
  624.  
  625. procedure TMainForm.MNewGameClick(Sender: TObject);
  626. begin
  627.   LevelFile := AskForLevel;
  628.   if LevelFile <> '' then
  629.   begin
  630.     NewGame(LevelFile);
  631.   end;
  632. end;
  633.  
  634. procedure TMainForm.MAboutClick(Sender: TObject);
  635. begin
  636.   AboutBox.ShowModal;
  637. end;
  638.  
  639. function TMainForm.AskForLevel: String;
  640. begin
  641.   LevelChoice.ShowModal;
  642.  
  643.   if LevelChoice.ModalResult <> mrOK then
  644.   begin
  645.     result := '';
  646.     exit;
  647.   end;
  648.  
  649.   result := LevelChoice.SelectedLevel;
  650. end;
  651.  
  652. procedure TMainForm.FormShow(Sender: TObject);
  653. begin
  654.   LevelFile := AskForLevel;
  655.   if LevelFile <> '' then
  656.   begin
  657.     NewGame(LevelFile);
  658.   end
  659.   else Close();
  660. end;
  661.  
  662. procedure TMainForm.FormCreate(Sender: TObject);
  663. begin
  664.   JumpHistory := TStringList.Create;
  665.   LoadSettings;
  666. end;
  667.  
  668. procedure TMainForm.FormDestroy(Sender: TObject);
  669. begin
  670.   JumpHistory.Free;
  671. end;
  672.  
  673. procedure TMainForm.MJumpHistoryClick(Sender: TObject);
  674. begin
  675.   HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
  676.   HistoryForm.ShowModal;
  677. end;
  678.  
  679. procedure TMainForm.RestartLevel;
  680. begin
  681.   MPauseTime.Enabled := false;
  682.   Timer.Enabled := false;
  683.  
  684.   MRestartGame.Enabled := false;
  685.  
  686.   CountedSeconds := 0;
  687.   RefreshTime;
  688.  
  689.   Points := 0;
  690.   RefreshPoints;
  691.  
  692.   LevelRemovedStones := 0;
  693.   RefreshStonesRemoved;
  694.  
  695.   JumpHistory.Clear;
  696.  
  697.   RedrawStonesFromMatrix(OriginalPlayGroundMatrix);
  698.   SetNewPlayGroundMatrix(OriginalPlayGroundMatrix);
  699.   SetLength(PrevPlaygroundMatrixes,1);
  700.   PrevPlaygroundMatrixes[0] := CloneMatrix(OriginalPlayGroundMatrix);
  701.   MUndo.Enabled := false;
  702. end;
  703.  
  704. procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
  705. begin
  706.   ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
  707.   PlayGroundMatrix := CloneMatrix(Matrix);
  708. end;
  709.  
  710. procedure TMainForm.MRestartGameClick(Sender: TObject);
  711. begin
  712.   RestartLevel;
  713. end;
  714.  
  715. procedure TMainForm.MUndoClick(Sender: TObject);
  716. var
  717.   PrevWorth: integer;
  718.   NewWorth: integer;
  719. begin
  720.   if Length(PrevPlaygroundMatrixes) > 1 then
  721.   begin
  722.     PrevWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  723.  
  724.     ClearMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1], false);
  725.     SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
  726.  
  727.     NewWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  728.     RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  729.     SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
  730.  
  731.     JumpHistory.Delete(JumpHistory.Count-1);
  732.  
  733.     Dec(LevelRemovedStones);
  734.     RefreshStonesRemoved;
  735.  
  736.     Dec(Points, NewWorth-PrevWorth);
  737.     RefreshPoints;
  738.  
  739.     // Sound abspielen
  740.     if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  741.   end;
  742.  
  743.   MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
  744. end;
  745.  
  746. procedure TMainForm.MHighScoresClick(Sender: TObject);
  747. begin
  748.   HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
  749. end;
  750.  
  751. procedure TMainForm.MPauseTimeClick(Sender: TObject);
  752. begin
  753.   MPauseTime.Enabled := false;
  754.   Timer.Enabled := false;
  755. end;
  756.  
  757. procedure TMainForm.LoadSettings;
  758. var
  759.   reg: TRegistry;
  760. begin
  761.   reg := TRegistry.Create;
  762.   try
  763.     reg.RootKey := HKEY_CURRENT_USER;
  764.     if reg.OpenKeyReadOnly(REG_KEY) then
  765.     begin
  766.       if reg.ValueExists(REG_SOUND) then
  767.         MEnableSound.Checked := reg.ReadBool(REG_SOUND);
  768.       reg.CloseKey;
  769.     end;
  770.   finally
  771.     reg.Free;
  772.   end;
  773. end;
  774.  
  775. procedure TMainForm.SaveSettings;
  776. var
  777.   reg: TRegistry;
  778. begin
  779.   reg := TRegistry.Create;
  780.   try
  781.     reg.RootKey := HKEY_CURRENT_USER;
  782.     if reg.OpenKey(REG_KEY, true) then
  783.     begin
  784.       reg.WriteBool(REG_SOUND, MEnableSound.Checked);
  785.       reg.CloseKey;
  786.     end;
  787.   finally
  788.     reg.Free;
  789.   end;
  790. end;
  791.  
  792.  
  793. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  794. begin
  795.   SaveSettings;
  796.   if FinishForm.NameEdit.Text <> '' then
  797.   begin
  798.     FinishForm.SaveSettings;
  799.   end;
  800. end;
  801.  
  802. procedure TMainForm.MHelpClick(Sender: TObject);
  803. begin
  804.   HelpForm.ShowModal;
  805. end;
  806.  
  807. procedure TMainForm.MEnableSoundClick(Sender: TObject);
  808. begin
  809.   MEnableSound.Checked := not MEnableSound.Checked;
  810. end;
  811.  
  812. end.
  813.