Subversion Repositories jumper

Rev

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