Subversion Repositories jumper

Rev

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