WebSVN – jumper – Diff – /trunk/Main.pas


unit Main;
 
interface
 
uses
  Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls,
  ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
 
type
  TMainForm = class(TForm)
    Playground: TPanel;
    MainMenu: TMainMenu;
    Help1: TMenuItem;
    MExit: TMenuItem;
    Statistics: TStatusBar;
    Timer: TTimer;
    MNewGame: TMenuItem;
    Help2: TMenuItem;
    MAbout: TMenuItem;
    MHelp: TMenuItem;
    N5: TMenuItem;
    MJumpHistory: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    MHighScores: TMenuItem;
    MRestartGame: TMenuItem;
    MSettings: TMenuItem;
    MEnableSound: TMenuItem;
    MPauseTime: TMenuItem;
    N1: TMenuItem;
    MUndo: TMenuItem;
    N3: TMenuItem;
    Aboutthislevel1: TMenuItem;
    procedure MExitClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure MNewGameClick(Sender: TObject);
    procedure MAboutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MJumpHistoryClick(Sender: TObject);
    procedure MRestartGameClick(Sender: TObject);
    procedure MHighScoresClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MHelpClick(Sender: TObject);
    procedure MUndoClick(Sender: TObject);
    procedure Aboutthislevel1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    NoCloseQuery: boolean;
    CountedSeconds: Integer;
    LevelFile: String;
 
    PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
    PlaygroundMatrix: TPlayGroundMatrix;
    Points: Integer;
    LevelTotalStones: Integer;
    LevelRemovedStones: Integer;
    JumpHistory: TStringList;
    Level: TLevel;
    procedure LoadSettings;
    procedure SaveSettings;
    procedure RestartLevel;
    procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
    procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
    function AskForLevel: String;
    procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
    procedure NewGame(Filename: string);
    function LevelTime: String;
    procedure DestroyLevel;
    procedure RefreshTime;
    procedure RefreshPoints;
    procedure RefreshStonesRemoved;
    procedure RemoveStone(x, y: integer; count_points: boolean);
    procedure DoJump(SourceTag, DestTag: integer);
    function MayJump(SourceTag, DestTag: integer): boolean; overload;
    procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
    function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
    function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
    function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
    procedure BuildPlayground(LevelArray: TLevelArray);
    procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
    function GoalStatus: TGoalStatus;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
 
{$R *.dfm}
 
{ TMainForm }
 
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
var
  x, y: integer;
begin
  for x := Low(Matrix.Fields) to High(Matrix.Fields) do
  begin
    for y := Low(Matrix.Fields[x]) to High(Matrix.Fields[x]) do
    begin
      if Assigned(Matrix.Fields[x][y].Stone) then
      begin
        LoadPictureForType(Matrix.Fields[x][y].FieldType, Matrix.Fields[x][y].Stone.Picture);
        StoneDraggingAllow(Matrix.Fields[x][y].Stone, Matrix.FieldState(Matrix.Fields[x][y].FieldType) <> fsAvailable);
      end;
    end;
  end;
end;
 
procedure TMainForm.DestroyLevel;
var
  i: Integer;
begin
  MPauseTime.Checked := false;
  MPauseTime.Enabled := false;
  Timer.Enabled := false;
 
  MRestartGame.Enabled := false;
 
  LevelFile := '';
 
  CountedSeconds := 0;
  RefreshTime;
 
  Points := 0;
  RefreshPoints;
 
  LevelRemovedStones := 0;
  LevelTotalStones := 0;
  RefreshStonesRemoved;
 
  JumpHistory.Clear;
 
  PlayGroundMatrix.ClearMatrix(true);
  for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
    PrevPlaygroundMatrixes[i].ClearMatrix(false);
  SetLength(PrevPlaygroundMatrixes, 0);
  MUndo.Enabled := false;
 
 
 
  if Assigned(Level) then FreeAndNil(Level);
end;
 
procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
begin
  case FieldType of
    ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
    ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
    ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
    ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
  end;
end;
 
function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
begin
  result := TImage.Create(panel);
  result.Parent := panel;
  LoadPictureForType(fieldtype, result.Picture);
  result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
  result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
  result.Left := MET_SHAPE_MARGIN;
  result.Top := MET_SHAPE_MARGIN;
  result.Center := true;
  result.Transparent := true;
 
  result.Tag := panel.Tag;
  result.OnDragOver := panel.OnDragOver;
  result.OnDragDrop := panel.OnDragDrop;
 
  StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
end;
 
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
begin
  if Allow then
  begin
    Stone.DragMode := dmAutomatic;
    (Stone.Parent as TPanel).DragMode := dmAutomatic;
  end
  else
  begin
    Stone.DragMode := dmManual;
    (Stone.Parent as TPanel).DragMode := dmManual;
  end;
end;
 
function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
begin
  result := TPanel.Create(Playground);
  result.Parent := Playground;
  if isGoal then
  begin
    result.BevelInner := bvLowered;
  end;
  result.Color := Playground.Color;
  result.BevelOuter := bvLowered;
  result.Width := MET_FIELD_SIZE;
  result.Height := MET_FIELD_SIZE;
  result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);
  result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
 
  result.Tag := tag;
  result.OnDragOver := StoneDragOver;
  result.OnDragDrop := StoneDragDrop;
end;
 
procedure TMainForm.MExitClick(Sender: TObject);
begin
  Close;
end;
 
procedure TMainForm.RefreshTime;
begin
  Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
end;
 
procedure TMainForm.RefreshStonesRemoved;
resourcestring
  LNG_STONES_REMOVED = '%d of %d stones removed';
begin
  Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
end;
 
procedure TMainForm.RefreshPoints;
begin
  Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
end;
 
procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
begin
  if count_points then
  begin
    Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));
    RefreshPoints;
 
    Inc(LevelRemovedStones);
    RefreshStonesRemoved;
  end;
 
  PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;
  LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);
  StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);
end;
 
procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
var
  mode: string;
  goalYeSNo: string;
resourcestring
  LNG_BOARD = 'Board: %s';
  LNG_MODE = 'Mode: %s';
  LNG_STONES_TOTAL = 'Stones: %d';
  LNG_GOAL_AVAILABLE = 'Target field defined';
  LNG_NO_GOAL = 'No target field';
begin
  case Level.GameMode of
    gmNormal:    mode := 'Diagonal';
    gmDiagonal:  mode := 'Normal';
    gmUndefined: mode := '?';
  end;
 
  if GoalStatus = gsNoGoal then
    goalYeSNo := LNG_NO_GOAL
  else
    goalYeSNo := LNG_GOAL_AVAILABLE;
 
  ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
              #13#10 +
              Format(LNG_MODE, [mode]) + #13#10 +
              Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
              goalYesNo);
end;
 
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
resourcestring
  LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
var
  d, s: TCoord;
  old_fieldtype: TFieldType;
  res: Integer;
begin
  if not MayJump(SourceTag, DestTag) then exit;
 
  s := PlaygroundMatrix.IndexToCoord(SourceTag);
  d := PlaygroundMatrix.IndexToCoord(DestTag);
 
  JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
 
  {$REGION 'Stein entfernen und Punkte vergeben'}
  if Level.GameMode = gmDiagonal then
  begin
    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);
    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);
    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);
    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);
  end;
 
  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);
  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);
  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);
  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);
  {$ENDREGION}
 
  // Den Timer erst nach dem ersten Zug starten
  // oder nach einer Pause neustarten
  MPauseTime.Checked := false;
  MPauseTime.Enabled := true;
  Timer.Enabled := true;
 
  // Sound abspielen
  if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
 
  {$REGION 'Nun den Stein springen lassen'}
  old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken
  RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
  PlayGroundMatrix.Fields[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
  LoadPictureForType(PlayGroundMatrix.Fields[d.X, d.Y].FieldType, PlayGroundMatrix.Fields[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
  StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
  {$ENDREGION}
 
  {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
  if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
  begin
    MPauseTime.Checked := false;
    MPauseTime.Enabled := false;
    Timer.Enabled := false;
    RefreshTime;
    if MEnableSound.Checked then
    begin
      if LevelRemovedStones = LevelTotalStones-1 then
      begin
        if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
          PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
        else
          PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
      end
      else
        PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
    end;
    res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
    if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
  end;
  {$ENDREGION}
 
  SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
  PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
  MUndo.Enabled := true;
end;
 
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
var
  s, d: TCoord;
begin
  s := PlayGroundMatrix.IndexToCoord(SourceTag);
  d := PlayGroundMatrix.IndexToCoord(DestTag);
 
  result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);
end;
 
procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
end;
 
procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
end;
 
function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
var
  newField: TField;
  index: integer;
begin
  ZeroMemory(@result, SizeOf(result));
  if t.Typ = ftFullSpace then exit;
 
  index := PlaygroundMatrix.CoordToIndex(x, y);
 
  newField.FieldType := t.Typ;
  newField.Goal := t.Goal;
  newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
  newField.Stone := DrawStone(t.Typ, newField.Panel);
 
 
 
 
 
 
 
 
 
 
  result := newField;
end;
 
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
var
  y, x: integer;
  max_x, max_y: integer;
  p: TPanel;
  newField: TField;
begin
  PlayGround.Visible := false;
 
  // Attention: PlaygroundMatrix is indexed [x,y] while LevelArray is indexed [y,x]
  // TODO: PlaygroundMatrix and LevelArray are redundant. Can't we just replace one with the other?
  PlaygroundMatrix.InitFieldArray(Length(LevelArray[0].Fields), Length(LevelArray));
 
  max_x := 0;
  max_y := 0;
  for y := Low(LevelArray) to High(LevelArray) do
  begin
    for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
    begin
      if TPlayGroundMatrix.FieldState(LevelArray[y].Fields[x].Typ) = fsStone then
        Inc(LevelTotalStones);
      newField := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent);
      PlaygroundMatrix.Fields[x, y] := newField;
      p := newField.Panel;
      if Assigned(p) then
      begin
        max_x := Max(max_x, p.Left + p.Width);
        max_y := Max(max_y, p.Top  + p.Height);
      end;
    end;
  end;
 
  PlayGround.Visible := true;
 
  // Das Form an das Level anpassen
  PlayGround.Top    := MET_OUTER_MARGIN;
  PlayGround.Left   := MET_OUTER_MARGIN;
  PlayGround.Width  := max_x;
  PlayGround.Height := max_y;
  ClientWidth       := 2 * MET_OUTER_MARGIN + PlayGround.Width;
  ClientHeight      := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
 
  // If the board is too small, ClientWidth/ClientHeight will stop at a minimum value
  // in this case, we make sure that the Playground is centered
  PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;
  PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;
 
  Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
  Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
 
  SetLength(PrevPlaygroundMatrixes,1);
  PrevPlaygroundMatrixes[0] := PlayGroundMatrix.CloneMatrix;
  MUndo.Enabled := false;
end;
 
procedure TMainForm.TimerTimer(Sender: TObject);
begin
  if MPauseTime.Checked then exit;
  if mainform.Focused then Inc(CountedSeconds);
  RefreshTime;
end;
 
function TMainForm.LevelTime: String;
begin
  result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)
end;
 
procedure TMainForm.NewGame(Filename: string);
resourcestring
  LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
var
  LevelArray: TLevelArray;
begin
  DestroyLevel;
 
  MPauseTime.Checked := true;
  MPauseTime.Enabled := true;
  Timer.Enabled := true;
  MRestartGame.Enabled := true;
 
  LevelFile := Filename;
  Level := TLevel.Create(LevelFile);
  LevelArray := Level.LevelStringToLevelArray(true);
  if Length(LevelArray) = 0 then Exit;
  BuildPlayground(LevelArray);
  if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
  begin
    MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
  end;
  RefreshTime;
  RefreshStonesRemoved;
  RefreshPoints;
end;
 
procedure TMainForm.MNewGameClick(Sender: TObject);
begin
  LevelFile := AskForLevel;
  if LevelFile <> '' then
  begin
    NewGame(LevelFile);
  end;
end;
 
procedure TMainForm.MAboutClick(Sender: TObject);
begin
  AboutBox.ShowModal;
end;
 
function TMainForm.AskForLevel: String;
begin
  LevelChoice.ShowModal;
 
  if LevelChoice.ModalResult <> mrOK then
  begin
    result := '';
    exit;
  end;
 
  result := LevelChoice.SelectedLevel;
end;
 
procedure TMainForm.FormShow(Sender: TObject);
begin
  LevelFile := AskForLevel;
  if LevelFile <> '' then
  begin
    NewGame(LevelFile);
  end
  else
  begin
    NoCloseQuery := true;
    Close;
  end;
end;
 
function TMainForm.GoalStatus: TGoalStatus;
var
  ft: TFieldType;
begin
  if not PlaygroundMatrix.MatrixHasGoal then
    result := gsNoGoal
  else if LevelRemovedStones < LevelTotalStones-1 then
    Result := gsMultipleStonesRemaining
  else
  begin
    ft := PlaygroundMatrix.GoalFieldType;
    if ft = ftRed then
      result := gsLastStoneInGoalRed
    else if ft = ftYellow then
      result := gsLastStoneInGoalYellow
    else if ft = ftGreen then
      result := gsLastStoneInGoalGreen
    else
      result := gsUndefined;
  end;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  JumpHistory := TStringList.Create;
  LoadSettings;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DestroyLevel;
  JumpHistory.Free;
end;
 
procedure TMainForm.MJumpHistoryClick(Sender: TObject);
begin
  HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
  HistoryForm.ShowModal;
end;
 
procedure TMainForm.RestartLevel;
var
  i: Integer;
begin
  MPauseTime.Checked := true;
  MPauseTime.Enabled := true;
  Timer.Enabled := true;
 
  CountedSeconds := 0;
  RefreshTime;
 
  Points := 0;
  RefreshPoints;
 
  LevelRemovedStones := 0;
  RefreshStonesRemoved;
 
  JumpHistory.Clear;
 
  RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
  SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
  for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
    PrevPlaygroundMatrixes[i].ClearMatrix(false);
  SetLength(PrevPlaygroundMatrixes, 1);
 
  MUndo.Enabled := false;
end;
 
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
begin
  PlayGroundMatrix.ClearMatrix(false); // Memory Leak verhindern
  PlayGroundMatrix := Matrix.CloneMatrix;
end;
 
procedure TMainForm.MRestartGameClick(Sender: TObject);
begin
  RestartLevel;
end;
 
procedure TMainForm.MUndoClick(Sender: TObject);
var
  PrevWorth: integer;
  NewWorth: integer;
begin
  if Length(PrevPlaygroundMatrixes) > 1 then
  begin
    PrevWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
 
    PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].ClearMatrix(false);
    SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
 
    NewWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
    RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
    SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
 
    JumpHistory.Delete(JumpHistory.Count-1);
 
    Dec(LevelRemovedStones);
    RefreshStonesRemoved;
 
    Dec(Points, NewWorth-PrevWorth);
    RefreshPoints;
 
    // Sound abspielen
    if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
  end;
 
  MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
end;
 
procedure TMainForm.MHighScoresClick(Sender: TObject);
begin
  HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
end;
 
procedure TMainForm.LoadSettings;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKeyReadOnly(REG_KEY) then
    begin
      if reg.ValueExists(REG_SOUND) then
        MEnableSound.Checked := reg.ReadBool(REG_SOUND);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
procedure TMainForm.SaveSettings;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if reg.OpenKey(REG_KEY, true) then
    begin
      reg.WriteBool(REG_SOUND, MEnableSound.Checked);
      reg.CloseKey;
    end;
  finally
    reg.Free;
  end;
end;
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveSettings;
  if FinishForm.NameEdit.Text <> '' then
  begin
    FinishForm.SaveSettings;
  end;
end;
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
resourcestring
  LNG_REALLY_QUIT = 'Do you really want to quit?';
begin
  CanClose := NoCloseQuery or (MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes);
end;
 
procedure TMainForm.MHelpClick(Sender: TObject);
begin
  HelpForm.ShowModal;
end;
 
end.
 

Rev 22	Rev 23
1	unit Main;	1	unit Main;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls,	6	Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls,
7	ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;	7	ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
8		8
9	type	9	type
10	TMainForm = class(TForm)	10	TMainForm = class(TForm)
11	Playground: TPanel;	11	Playground: TPanel;
12	MainMenu: TMainMenu;	12	MainMenu: TMainMenu;
13	Help1: TMenuItem;	13	Help1: TMenuItem;
14	MExit: TMenuItem;	14	MExit: TMenuItem;
15	Statistics: TStatusBar;	15	Statistics: TStatusBar;
16	Timer: TTimer;	16	Timer: TTimer;
17	MNewGame: TMenuItem;	17	MNewGame: TMenuItem;
18	Help2: TMenuItem;	18	Help2: TMenuItem;
19	MAbout: TMenuItem;	19	MAbout: TMenuItem;
20	MHelp: TMenuItem;	20	MHelp: TMenuItem;
21	N5: TMenuItem;	21	N5: TMenuItem;
22	MJumpHistory: TMenuItem;	22	MJumpHistory: TMenuItem;
23	N2: TMenuItem;	23	N2: TMenuItem;
24	N4: TMenuItem;	24	N4: TMenuItem;
25	MHighScores: TMenuItem;	25	MHighScores: TMenuItem;
26	MRestartGame: TMenuItem;	26	MRestartGame: TMenuItem;
27	MSettings: TMenuItem;	27	MSettings: TMenuItem;
28	MEnableSound: TMenuItem;	28	MEnableSound: TMenuItem;
29	MPauseTime: TMenuItem;	29	MPauseTime: TMenuItem;
30	N1: TMenuItem;	30	N1: TMenuItem;
31	MUndo: TMenuItem;	31	MUndo: TMenuItem;
32	N3: TMenuItem;	32	N3: TMenuItem;
33	Aboutthislevel1: TMenuItem;	33	Aboutthislevel1: TMenuItem;
34	procedure MExitClick(Sender: TObject);	34	procedure MExitClick(Sender: TObject);
35	procedure TimerTimer(Sender: TObject);	35	procedure TimerTimer(Sender: TObject);
36	procedure MNewGameClick(Sender: TObject);	36	procedure MNewGameClick(Sender: TObject);
37	procedure MAboutClick(Sender: TObject);	37	procedure MAboutClick(Sender: TObject);
38	procedure FormShow(Sender: TObject);	38	procedure FormShow(Sender: TObject);
39	procedure FormCreate(Sender: TObject);	39	procedure FormCreate(Sender: TObject);
40	procedure FormDestroy(Sender: TObject);	40	procedure FormDestroy(Sender: TObject);
41	procedure MJumpHistoryClick(Sender: TObject);	41	procedure MJumpHistoryClick(Sender: TObject);
42	procedure MRestartGameClick(Sender: TObject);	42	procedure MRestartGameClick(Sender: TObject);
43	procedure MHighScoresClick(Sender: TObject);	43	procedure MHighScoresClick(Sender: TObject);
44	procedure FormClose(Sender: TObject; var Action: TCloseAction);	44	procedure FormClose(Sender: TObject; var Action: TCloseAction);
45	procedure MHelpClick(Sender: TObject);	45	procedure MHelpClick(Sender: TObject);
46	procedure MUndoClick(Sender: TObject);	46	procedure MUndoClick(Sender: TObject);
47	procedure Aboutthislevel1Click(Sender: TObject);	47	procedure Aboutthislevel1Click(Sender: TObject);
48	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);	48	procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
49	private	49	private
50	NoCloseQuery: boolean;	50	NoCloseQuery: boolean;
51	CountedSeconds: Integer;	51	CountedSeconds: Integer;
52	LevelFile: String;	52	LevelFile: String;
53	LookupFieldCoordinateArray: array of TPoint;	-
54	PrevPlaygroundMatrixes: array of TPlayGroundMatrix;	53	PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
55	PlaygroundMatrix: TPlayGroundMatrix;	54	PlaygroundMatrix: TPlayGroundMatrix;
56	Points: Integer;	55	Points: Integer;
57	LevelTotalStones: Integer;	56	LevelTotalStones: Integer;
58	LevelRemovedStones: Integer;	57	LevelRemovedStones: Integer;
59	JumpHistory: TStringList;	58	JumpHistory: TStringList;
60	Level: TLevel;	59	Level: TLevel;
61	procedure LoadSettings;	60	procedure LoadSettings;
62	procedure SaveSettings;	61	procedure SaveSettings;
63	procedure RestartLevel;	62	procedure RestartLevel;
64	procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);	63	procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
65	procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);	64	procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
66	function AskForLevel: String;	65	function AskForLevel: String;
67	procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);	66	procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
68	procedure NewGame(Filename: string);	67	procedure NewGame(Filename: string);
69	function LevelTime: String;	68	function LevelTime: String;
70	procedure DestroyLevel;	69	procedure DestroyLevel;
71	procedure RefreshTime;	70	procedure RefreshTime;
72	procedure RefreshPoints;	71	procedure RefreshPoints;
73	procedure RefreshStonesRemoved;	72	procedure RefreshStonesRemoved;
74	procedure RemoveStone(x, y: integer; count_points: boolean);	73	procedure RemoveStone(x, y: integer; count_points: boolean);
75	procedure DoJump(SourceTag, DestTag: integer);	74	procedure DoJump(SourceTag, DestTag: integer);
76	function MayJump(SourceTag, DestTag: integer): boolean; overload;	75	function MayJump(SourceTag, DestTag: integer): boolean; overload;
77	procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);	76	procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
78	procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);	77	procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
79	function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;	78	function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
80	function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;	79	function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
81	function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;	80	function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
82	procedure BuildPlayground(LevelArray: TLevelArray);	81	procedure BuildPlayground(LevelArray: TLevelArray);
83	procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);	82	procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
84	function GoalStatus: TGoalStatus;	83	function GoalStatus: TGoalStatus;
85	end;	84	end;
86		85
87	var	86	var
88	MainForm: TMainForm;	87	MainForm: TMainForm;
89		88
90	implementation	89	implementation
91		90
92	uses	91	uses
93	About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;	92	About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
94		93
95	{$R *.dfm}	94	{$R *.dfm}
96		95
97	{ TMainForm }	96	{ TMainForm }
98		97
99	procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);	98	procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
100	var	99	var
101	i, j: integer;	100	x, y: integer;
102	begin	101	begin
103	for i := Low(Matrix.Fields) to High(Matrix.Fields) do	102	for x := Low(Matrix.Fields) to High(Matrix.Fields) do
104	begin	103	begin
105	for j := Low(Matrix.Fields[i]) to High(Matrix.Fields[i]) do	104	for y := Low(Matrix.Fields[x]) to High(Matrix.Fields[x]) do
106	begin	105	begin
107	if Assigned(Matrix.Fields[i][j].Stone) then	106	if Assigned(Matrix.Fields[x][y].Stone) then
108	begin	107	begin
109	LoadPictureForType(Matrix.Fields[i][j].FieldType, Matrix.Fields[i][j].Stone.Picture);	108	LoadPictureForType(Matrix.Fields[x][y].FieldType, Matrix.Fields[x][y].Stone.Picture);
110	StoneDraggingAllow(Matrix.Fields[i][j].Stone, Matrix.FieldState(Matrix.Fields[i][j].FieldType) <> fsAvailable);	109	StoneDraggingAllow(Matrix.Fields[x][y].Stone, Matrix.FieldState(Matrix.Fields[x][y].FieldType) <> fsAvailable);
111	end;	110	end;
112	end;	111	end;
113	end;	112	end;
114	end;	113	end;
115		114
116	procedure TMainForm.DestroyLevel;	115	procedure TMainForm.DestroyLevel;
117	var	116	var
118	i: Integer;	117	i: Integer;
119	begin	118	begin
120	MPauseTime.Checked := false;	119	MPauseTime.Checked := false;
121	MPauseTime.Enabled := false;	120	MPauseTime.Enabled := false;
122	Timer.Enabled := false;	121	Timer.Enabled := false;
123		122
124	MRestartGame.Enabled := false;	123	MRestartGame.Enabled := false;
125		124
126	LevelFile := '';	125	LevelFile := '';
127		126
128	CountedSeconds := 0;	127	CountedSeconds := 0;
129	RefreshTime;	128	RefreshTime;
130		129
131	Points := 0;	130	Points := 0;
132	RefreshPoints;	131	RefreshPoints;
133		132
134	LevelRemovedStones := 0;	133	LevelRemovedStones := 0;
135	LevelTotalStones := 0;	134	LevelTotalStones := 0;
136	RefreshStonesRemoved;	135	RefreshStonesRemoved;
137		136
138	JumpHistory.Clear;	137	JumpHistory.Clear;
139		138
140	PlayGroundMatrix.ClearMatrix(true);	139	PlayGroundMatrix.ClearMatrix(true);
141	for i := 0 to Length(PrevPlaygroundMatrixes)-1 do	140	for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
142	PrevPlaygroundMatrixes[i].ClearMatrix(false);	141	PrevPlaygroundMatrixes[i].ClearMatrix(false);
143	SetLength(PrevPlaygroundMatrixes, 0);	142	SetLength(PrevPlaygroundMatrixes, 0);
144	MUndo.Enabled := false;	143	MUndo.Enabled := false;
145		144
146	SetLength(LookupFieldCoordinateArray, 0);	-
147		-
148	if Assigned(Level) then FreeAndNil(Level);	145	if Assigned(Level) then FreeAndNil(Level);
149	end;	146	end;
150		147
151	procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);	148	procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
152	begin	149	begin
153	case FieldType of	150	case FieldType of
154	ftEmpty: Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);	151	ftEmpty: Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
155	ftGreen: Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);	152	ftGreen: Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
156	ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);	153	ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
157	ftRed: Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);	154	ftRed: Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
158	end;	155	end;
159	end;	156	end;
160		157
161	function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;	158	function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
162	begin	159	begin
163	result := TImage.Create(panel);	160	result := TImage.Create(panel);
164	result.Parent := panel;	161	result.Parent := panel;
165	LoadPictureForType(fieldtype, result.Picture);	162	LoadPictureForType(fieldtype, result.Picture);
166	result.Width := panel.Width - 2*MET_SHAPE_MARGIN;	163	result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
167	result.Height := panel.Height - 2*MET_SHAPE_MARGIN;	164	result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
168	result.Left := MET_SHAPE_MARGIN;	165	result.Left := MET_SHAPE_MARGIN;
169	result.Top := MET_SHAPE_MARGIN;	166	result.Top := MET_SHAPE_MARGIN;
170	result.Center := true;	167	result.Center := true;
171	result.Transparent := true;	168	result.Transparent := true;
172		169
173	result.Tag := panel.Tag;	170	result.Tag := panel.Tag;
174	result.OnDragOver := panel.OnDragOver;	171	result.OnDragOver := panel.OnDragOver;
175	result.OnDragDrop := panel.OnDragDrop;	172	result.OnDragDrop := panel.OnDragDrop;
176		173
177	StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);	174	StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
178	end;	175	end;
179		176
180	procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);	177	procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
181	begin	178	begin
182	if Allow then	179	if Allow then
183	begin	180	begin
184	Stone.DragMode := dmAutomatic;	181	Stone.DragMode := dmAutomatic;
185	(Stone.Parent as TPanel).DragMode := dmAutomatic;	182	(Stone.Parent as TPanel).DragMode := dmAutomatic;
186	end	183	end
187	else	184	else
188	begin	185	begin
189	Stone.DragMode := dmManual;	186	Stone.DragMode := dmManual;
190	(Stone.Parent as TPanel).DragMode := dmManual;	187	(Stone.Parent as TPanel).DragMode := dmManual;
191	end;	188	end;
192	end;	189	end;
193		190
194	function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;	191	function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
195	begin	192	begin
196	result := TPanel.Create(Playground);	193	result := TPanel.Create(Playground);
197	result.Parent := Playground;	194	result.Parent := Playground;
198	if isGoal then	195	if isGoal then
199	begin	196	begin
200	result.BevelInner := bvLowered;	197	result.BevelInner := bvLowered;
201	end;	198	end;
202	result.Color := Playground.Color;	199	result.Color := Playground.Color;
203	result.BevelOuter := bvLowered;	200	result.BevelOuter := bvLowered;
204	result.Width := MET_FIELD_SIZE;	201	result.Width := MET_FIELD_SIZE;
205	result.Height := MET_FIELD_SIZE;	202	result.Height := MET_FIELD_SIZE;
206	result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);	203	result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);
207	result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;	204	result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
208		205
209	result.Tag := tag;	206	result.Tag := tag;
210	result.OnDragOver := StoneDragOver;	207	result.OnDragOver := StoneDragOver;
211	result.OnDragDrop := StoneDragDrop;	208	result.OnDragDrop := StoneDragDrop;
212	end;	209	end;
213		210
214	procedure TMainForm.MExitClick(Sender: TObject);	211	procedure TMainForm.MExitClick(Sender: TObject);
215	begin	212	begin
216	Close;	213	Close;
217	end;	214	end;
218		215
219	procedure TMainForm.RefreshTime;	216	procedure TMainForm.RefreshTime;
220	begin	217	begin
221	Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);	218	Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
222	end;	219	end;
223		220
224	procedure TMainForm.RefreshStonesRemoved;	221	procedure TMainForm.RefreshStonesRemoved;
225	resourcestring	222	resourcestring
226	LNG_STONES_REMOVED = '%d of %d stones removed';	223	LNG_STONES_REMOVED = '%d of %d stones removed';
227	begin	224	begin
228	Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);	225	Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
229	end;	226	end;
230		227
231	procedure TMainForm.RefreshPoints;	228	procedure TMainForm.RefreshPoints;
232	begin	229	begin
233	Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);	230	Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
234	end;	231	end;
235		232
236	procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);	233	procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
237	begin	234	begin
238	if count_points then	235	if count_points then
239	begin	236	begin
240	Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));	237	Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));
241	RefreshPoints;	238	RefreshPoints;
242		239
243	Inc(LevelRemovedStones);	240	Inc(LevelRemovedStones);
244	RefreshStonesRemoved;	241	RefreshStonesRemoved;
245	end;	242	end;
-		243
246	PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;	244	PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;
247	LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);	245	LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);
248	StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);	246	StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);
249	end;	247	end;
250		248
251	procedure TMainForm.Aboutthislevel1Click(Sender: TObject);	249	procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
252	var	250	var
253	mode: string;	251	mode: string;
254	goalYeSNo: string;	252	goalYeSNo: string;
255	resourcestring	253	resourcestring
256	LNG_BOARD = 'Board: %s';	254	LNG_BOARD = 'Board: %s';
257	LNG_MODE = 'Mode: %s';	255	LNG_MODE = 'Mode: %s';
258	LNG_STONES_TOTAL = 'Stones: %d';	256	LNG_STONES_TOTAL = 'Stones: %d';
259	LNG_GOAL_AVAILABLE = 'Target field defined';	257	LNG_GOAL_AVAILABLE = 'Target field defined';
260	LNG_NO_GOAL = 'No target field';	258	LNG_NO_GOAL = 'No target field';
261	begin	259	begin
262	case Level.GameMode of	260	case Level.GameMode of
263	gmNormal: mode := 'Diagonal';	261	gmNormal: mode := 'Diagonal';
264	gmDiagonal: mode := 'Normal';	262	gmDiagonal: mode := 'Normal';
265	gmUndefined: mode := '?';	263	gmUndefined: mode := '?';
266	end;	264	end;
267		265
268	if GoalStatus = gsNoGoal then	266	if GoalStatus = gsNoGoal then
269	goalYeSNo := LNG_NO_GOAL	267	goalYeSNo := LNG_NO_GOAL
270	else	268	else
271	goalYeSNo := LNG_GOAL_AVAILABLE;	269	goalYeSNo := LNG_GOAL_AVAILABLE;
272		270
273	ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +	271	ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
274	#13#10 +	272	#13#10 +
275	Format(LNG_MODE, [mode]) + #13#10 +	273	Format(LNG_MODE, [mode]) + #13#10 +
276	Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +	274	Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
277	goalYesNo);	275	goalYesNo);
278	end;	276	end;
279		277
280	procedure TMainForm.DoJump(SourceTag, DestTag: integer);	278	procedure TMainForm.DoJump(SourceTag, DestTag: integer);
281	resourcestring	279	resourcestring
282	LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';	280	LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
283	var	281	var
284	d, s: TPoint;	282	d, s: TCoord;
285	old_fieldtype: TFieldType;	283	old_fieldtype: TFieldType;
286	res: Integer;	284	res: Integer;
287	begin	285	begin
288	if not MayJump(SourceTag, DestTag) then exit;	286	if not MayJump(SourceTag, DestTag) then exit;
289		287
290	d := LookupFieldCoordinateArray[DestTag];	288	s := PlaygroundMatrix.IndexToCoord(SourceTag);
291	s := LookupFieldCoordinateArray[SourceTag];	289	d := PlaygroundMatrix.IndexToCoord(DestTag);
292		290
293	JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));	291	JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
294		292
295	{$REGION 'Stein entfernen und Punkte vergeben'}	293	{$REGION 'Stein entfernen und Punkte vergeben'}
296	if Level.GameMode = gmDiagonal then	294	if Level.GameMode = gmDiagonal then
297	begin	295	begin
298	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);	296	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);
299	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);	297	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);
300	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);	298	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);
301	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);	299	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);
302	end;	300	end;
303		301
304	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);	302	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);
305	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);	303	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);
306	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);	304	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);
307	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);	305	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);
308	{$ENDREGION}	306	{$ENDREGION}
309		307
310	// Den Timer erst nach dem ersten Zug starten	308	// Den Timer erst nach dem ersten Zug starten
311	// oder nach einer Pause neustarten	309	// oder nach einer Pause neustarten
312	MPauseTime.Checked := false;	310	MPauseTime.Checked := false;
313	MPauseTime.Enabled := true;	311	MPauseTime.Enabled := true;
314	Timer.Enabled := true;	312	Timer.Enabled := true;
315		313
316	// Sound abspielen	314	// Sound abspielen
317	if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);	315	if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
318		316
319	{$REGION 'Nun den Stein springen lassen'}	317	{$REGION 'Nun den Stein springen lassen'}
320	old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken	318	old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken
321	RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt	319	RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
322	PlayGroundMatrix.Fields[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen	320	PlayGroundMatrix.Fields[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
323	LoadPictureForType(PlayGroundMatrix.Fields[d.X, d.Y].FieldType, PlayGroundMatrix.Fields[d.X, d.Y].Stone.Picture); // Stein an neue Position malen	321	LoadPictureForType(PlayGroundMatrix.Fields[d.X, d.Y].FieldType, PlayGroundMatrix.Fields[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
324	StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern	322	StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
325	{$ENDREGION}	323	{$ENDREGION}
326		324
327	{$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}	325	{$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
328	if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then	326	if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
329	begin	327	begin
330	MPauseTime.Checked := false;	328	MPauseTime.Checked := false;
331	MPauseTime.Enabled := false;	329	MPauseTime.Enabled := false;
332	Timer.Enabled := false;	330	Timer.Enabled := false;
333	RefreshTime;	331	RefreshTime;
334	if MEnableSound.Checked then	332	if MEnableSound.Checked then
335	begin	333	begin
336	if LevelRemovedStones = LevelTotalStones-1 then	334	if LevelRemovedStones = LevelTotalStones-1 then
337	begin	335	begin
338	if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then	336	if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
339	PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)	337	PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
340	else	338	else
341	PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)	339	PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
342	end	340	end
343	else	341	else
344	PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);	342	PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
345	end;	343	end;
346	res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);	344	res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
347	if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;	345	if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
348	end;	346	end;
349	{$ENDREGION}	347	{$ENDREGION}
350		348
351	SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);	349	SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
352	PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;	350	PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
353	MUndo.Enabled := true;	351	MUndo.Enabled := true;
354	end;	352	end;
355		353
356	function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;	354	function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
357	var	355	var
358	s, d: TPoint;	356	s, d: TCoord;
359	begin	357	begin
360	d := LookupFieldCoordinateArray[DestTag];	358	s := PlayGroundMatrix.IndexToCoord(SourceTag);
361	s := LookupFieldCoordinateArray[SourceTag];	359	d := PlayGroundMatrix.IndexToCoord(DestTag);
362		360
363	result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);	361	result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);
364	end;	362	end;
365		363
366	procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);	364	procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
367	begin	365	begin
368	DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);	366	DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
369	end;	367	end;
370		368
371	procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,	369	procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
372	Y: Integer; State: TDragState; var Accept: Boolean);	370	Y: Integer; State: TDragState; var Accept: Boolean);
373	begin	371	begin
374	Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);	372	Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
375	end;	373	end;
376		374
377	function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;	375	function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
378	var	376	var
379	newField: TField;	377	newField: TField;
380	index: integer;	378	index: integer;
381	begin	379	begin
382	ZeroMemory(@result, SizeOf(result));	380	ZeroMemory(@result, SizeOf(result));
383	if t.Typ = ftFullSpace then exit;	381	if t.Typ = ftFullSpace then exit;
384		382
385	index := Length(LookupFieldCoordinateArray);	383	index := PlaygroundMatrix.CoordToIndex(x, y);
386		384
387	newField.FieldType := t.Typ;	385	newField.FieldType := t.Typ;
388	newField.Goal := t.Goal;	386	newField.Goal := t.Goal;
389	newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);	387	newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
390	newField.Stone := DrawStone(t.Typ, newField.Panel);	388	newField.Stone := DrawStone(t.Typ, newField.Panel);
391	if PlayGroundMatrix.FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);	-
392		-
393	SetLength(LookupFieldCoordinateArray, index + 1);	-
394	LookupFieldCoordinateArray[index].X := x;	-
395	LookupFieldCoordinateArray[index].Y := y;	-
396		-
397	if Length(PlayGroundMatrix.Fields) < x+1 then SetLength(PlayGroundMatrix.Fields, x+1);	-
398	if Length(PlayGroundMatrix.Fields[x]) < y+1 then SetLength(PlayGroundMatrix.Fields[x], y+1);	-
399	PlaygroundMatrix.Fields[x, y] := newField;	-
400		389
401	result := newField;	390	result := newField;
402	end;	391	end;
403		392
404	procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);	393	procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
405	var	394	var
406	y, x: integer;	395	y, x: integer;
407	max_x, max_y: integer;	396	max_x, max_y: integer;
408	p: TPanel;	397	p: TPanel;
-		398	newField: TField;
409	begin	399	begin
410	PlayGround.Visible := false;	400	PlayGround.Visible := false;
411		401
412	// Die Dimensionen ermitteln	402	// Attention: PlaygroundMatrix is indexed [x,y] while LevelArray is indexed [y,x]
-		403	// TODO: PlaygroundMatrix and LevelArray are redundant. Can't we just replace one with the other?
-		404	PlaygroundMatrix.InitFieldArray(Length(LevelArray[0].Fields), Length(LevelArray));
-		405
413	max_x := 0;	406	max_x := 0;
414	max_y := 0;	407	max_y := 0;
415	for y := Low(LevelArray) to High(LevelArray) do	408	for y := Low(LevelArray) to High(LevelArray) do
416	begin	409	begin
417	for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do	410	for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
418	begin	411	begin
-		412	if TPlayGroundMatrix.FieldState(LevelArray[y].Fields[x].Typ) = fsStone then
-		413	Inc(LevelTotalStones);
419	p := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent).Panel;	414	newField := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent);
-		415	PlaygroundMatrix.Fields[x, y] := newField;
-		416	p := newField.Panel;
420	if Assigned(p) then	417	if Assigned(p) then
421	begin	418	begin
422	max_x := Max(max_x, p.Left + p.Width);	419	max_x := Max(max_x, p.Left + p.Width);
423	max_y := Max(max_y, p.Top + p.Height);	420	max_y := Max(max_y, p.Top + p.Height);
424	end;	421	end;
425	end;	422	end;
426	end;	423	end;
427		424
428	PlayGround.Visible := true;	425	PlayGround.Visible := true;
429		426
430	// Das Form an das Level anpassen	427	// Das Form an das Level anpassen
431	PlayGround.Top := MET_OUTER_MARGIN;	428	PlayGround.Top := MET_OUTER_MARGIN;
432	PlayGround.Left := MET_OUTER_MARGIN;	429	PlayGround.Left := MET_OUTER_MARGIN;
433	PlayGround.Width := max_x;	430	PlayGround.Width := max_x;
434	PlayGround.Height := max_y;	431	PlayGround.Height := max_y;
435	ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width;	432	ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width;
436	ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;	433	ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
437		434
438	// If the board is too small, ClientWidth/ClientHeight will stop at a minimum value	435	// If the board is too small, ClientWidth/ClientHeight will stop at a minimum value
439	// in this case, we make sure that the Playground is centered	436	// in this case, we make sure that the Playground is centered
440	PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;	437	PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;
441	PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;	438	PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;
442		439
443	Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);	440	Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
444	Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);	441	Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
445		442
446	SetLength(PrevPlaygroundMatrixes,1);	443	SetLength(PrevPlaygroundMatrixes,1);
447	PrevPlaygroundMatrixes[0] := PlayGroundMatrix.CloneMatrix;	444	PrevPlaygroundMatrixes[0] := PlayGroundMatrix.CloneMatrix;
448	MUndo.Enabled := false;	445	MUndo.Enabled := false;
449	end;	446	end;
450		447
451	procedure TMainForm.TimerTimer(Sender: TObject);	448	procedure TMainForm.TimerTimer(Sender: TObject);
452	begin	449	begin
453	if MPauseTime.Checked then exit;	450	if MPauseTime.Checked then exit;
454	if mainform.Focused then Inc(CountedSeconds);	451	if mainform.Focused then Inc(CountedSeconds);
455	RefreshTime;	452	RefreshTime;
456	end;	453	end;
457		454
458	function TMainForm.LevelTime: String;	455	function TMainForm.LevelTime: String;
459	begin	456	begin
460	result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)	457	result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)
461	end;	458	end;
462		459
463	procedure TMainForm.NewGame(Filename: string);	460	procedure TMainForm.NewGame(Filename: string);
464	resourcestring	461	resourcestring
465	LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';	462	LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
466	var	463	var
467	LevelArray: TLevelArray;	464	LevelArray: TLevelArray;
468	begin	465	begin
469	DestroyLevel;	466	DestroyLevel;
470		467
471	MPauseTime.Checked := true;	468	MPauseTime.Checked := true;
472	MPauseTime.Enabled := true;	469	MPauseTime.Enabled := true;
473	Timer.Enabled := true;	470	Timer.Enabled := true;
474	MRestartGame.Enabled := true;	471	MRestartGame.Enabled := true;
475		472
476	LevelFile := Filename;	473	LevelFile := Filename;
477	Level := TLevel.Create(LevelFile);	474	Level := TLevel.Create(LevelFile);
478	LevelArray := Level.LevelStringToLevelArray(true);	475	LevelArray := Level.LevelStringToLevelArray(true);
479	if Length(LevelArray) = 0 then Exit;	476	if Length(LevelArray) = 0 then Exit;
480	BuildPlayground(LevelArray);	477	BuildPlayground(LevelArray);
481	if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then	478	if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
482	begin	479	begin
483	MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);	480	MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
484	end;	481	end;
485	RefreshTime;	482	RefreshTime;
486	RefreshStonesRemoved;	483	RefreshStonesRemoved;
487	RefreshPoints;	484	RefreshPoints;
488	end;	485	end;
489		486
490	procedure TMainForm.MNewGameClick(Sender: TObject);	487	procedure TMainForm.MNewGameClick(Sender: TObject);
491	begin	488	begin

Subversion Repositories jumper

jumper/trunk/Main.pas – Rev 22 → 23