Subversion Repositories jumper

Rev

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