Subversion Repositories jumper

Rev

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