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;
    LookupFieldCoordinateArray: array of TPoint;
    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
  i, j: integer;
begin
  for i := Low(Matrix.Fields) to High(Matrix.Fields) do
  begin
    for j := Low(Matrix.Fields[i]) to High(Matrix.Fields[i]) do
    begin
      if Assigned(Matrix.Fields[i][j].Stone) then
      begin
        LoadPictureForType(Matrix.Fields[i][j].FieldType, Matrix.Fields[i][j].Stone.Picture);
        StoneDraggingAllow(Matrix.Fields[i][j].Stone, Matrix.FieldState(Matrix.Fields[i][j].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;
 
  SetLength(LookupFieldCoordinateArray, 0);
 
  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: TPoint;
  old_fieldtype: TFieldType;
  res: Integer;
begin
  if not MayJump(SourceTag, DestTag) then exit;
 
  d := LookupFieldCoordinateArray[DestTag];
  s := LookupFieldCoordinateArray[SourceTag];
 
  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: TPoint;
begin
  d := LookupFieldCoordinateArray[DestTag];
  s := LookupFieldCoordinateArray[SourceTag];
 
  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 := Length(LookupFieldCoordinateArray);
 
  newField.FieldType := t.Typ;
  newField.Goal := t.Goal;
  newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
  newField.Stone := DrawStone(t.Typ, newField.Panel);
  if PlayGroundMatrix.FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
 
  SetLength(LookupFieldCoordinateArray, index + 1);
  LookupFieldCoordinateArray[index].X := x;
  LookupFieldCoordinateArray[index].Y := y;
 
  if Length(PlayGroundMatrix.Fields) < x+1 then SetLength(PlayGroundMatrix.Fields, x+1);
  if Length(PlayGroundMatrix.Fields[x]) < y+1 then SetLength(PlayGroundMatrix.Fields[x], y+1);
  PlaygroundMatrix.Fields[x, y] := newField;
 
  result := newField;
end;
 
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
var
  y, x: integer;
  max_x, max_y: integer;
  p: TPanel;
begin
  PlayGround.Visible := false;
 
  // Die Dimensionen ermitteln
  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
      p := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent).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 21	Rev 22
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;	53	LookupFieldCoordinateArray: array of TPoint;
54	PrevPlaygroundMatrixes: array of TPlayGroundMatrix;	54	PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
55	PlaygroundMatrix: TPlayGroundMatrix;	55	PlaygroundMatrix: TPlayGroundMatrix;
56	Points: Integer;	56	Points: Integer;
57	LevelTotalStones: Integer;	57	LevelTotalStones: Integer;
58	LevelRemovedStones: Integer;	58	LevelRemovedStones: Integer;
59	JumpHistory: TStringList;	59	JumpHistory: TStringList;
60	Level: TLevel;	60	Level: TLevel;
61	procedure LoadSettings;	61	procedure LoadSettings;
62	procedure SaveSettings;	62	procedure SaveSettings;
63	procedure RestartLevel;	63	procedure RestartLevel;
64	procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);	64	procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
65	procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);	65	procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
66	function AskForLevel: String;	66	function AskForLevel: String;
67	function AreJumpsPossible: boolean;	-
68	procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);	67	procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
69	procedure NewGame(Filename: string);	68	procedure NewGame(Filename: string);
70	function LevelTime: String;	69	function LevelTime: String;
71	procedure DestroyLevel;	70	procedure DestroyLevel;
72	procedure RefreshTime;	71	procedure RefreshTime;
73	procedure RefreshPoints;	72	procedure RefreshPoints;
74	procedure RefreshStonesRemoved;	73	procedure RefreshStonesRemoved;
75	procedure CountPoints(t: TFieldType);	-
76	procedure RemoveStone(x, y: integer; count_points: boolean);	74	procedure RemoveStone(x, y: integer; count_points: boolean);
77	procedure DoJump(SourceTag, DestTag: integer);	75	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;	76	function MayJump(SourceTag, DestTag: integer): boolean; overload;
81	procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);	77	procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
82	procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);	78	procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
83	function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;	79	function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
84	function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;	80	function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
85	function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;	81	function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
86	procedure BuildPlayground(LevelArray: TLevelArray);	82	procedure BuildPlayground(LevelArray: TLevelArray);
87	procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);	83	procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
88	function GoalStatus: TGoalStatus;	84	function GoalStatus: TGoalStatus;
89	end;	85	end;
90		86
91	var	87	var
92	MainForm: TMainForm;	88	MainForm: TMainForm;
93		89
94	implementation	90	implementation
95		91
96	uses	92	uses
97	About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;	93	About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
98		94
99	{$R *.dfm}	95	{$R *.dfm}
100		96
101	{ TMainForm }	97	{ TMainForm }
102		98
103	procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);	99	procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
104	var	100	var
105	i, j: integer;	101	i, j: integer;
106	begin	102	begin
107	for i := Low(Matrix.Fields) to High(Matrix.Fields) do	103	for i := Low(Matrix.Fields) to High(Matrix.Fields) do
108	begin	104	begin
109	for j := Low(Matrix.Fields[i]) to High(Matrix.Fields[i]) do	105	for j := Low(Matrix.Fields[i]) to High(Matrix.Fields[i]) do
110	begin	106	begin
111	if Assigned(Matrix.Fields[i][j].Stone) then	107	if Assigned(Matrix.Fields[i][j].Stone) then
112	begin	108	begin
113	LoadPictureForType(Matrix.Fields[i][j].FieldType, Matrix.Fields[i][j].Stone.Picture);	109	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);	110	StoneDraggingAllow(Matrix.Fields[i][j].Stone, Matrix.FieldState(Matrix.Fields[i][j].FieldType) <> fsAvailable);
115	end;	111	end;
116	end;	112	end;
117	end;	113	end;
118	end;	114	end;
119		115
120	procedure TMainForm.DestroyLevel;	116	procedure TMainForm.DestroyLevel;
121	var	117	var
122	i: Integer;	118	i: Integer;
123	begin	119	begin
124	MPauseTime.Checked := false;	120	MPauseTime.Checked := false;
125	MPauseTime.Enabled := false;	121	MPauseTime.Enabled := false;
126	Timer.Enabled := false;	122	Timer.Enabled := false;
127		123
128	MRestartGame.Enabled := false;	124	MRestartGame.Enabled := false;
129		125
130	LevelFile := '';	126	LevelFile := '';
131		127
132	CountedSeconds := 0;	128	CountedSeconds := 0;
133	RefreshTime;	129	RefreshTime;
134		130
135	Points := 0;	131	Points := 0;
136	RefreshPoints;	132	RefreshPoints;
137		133
138	LevelRemovedStones := 0;	134	LevelRemovedStones := 0;
139	LevelTotalStones := 0;	135	LevelTotalStones := 0;
140	RefreshStonesRemoved;	136	RefreshStonesRemoved;
141		137
142	JumpHistory.Clear;	138	JumpHistory.Clear;
143		139
144	PlayGroundMatrix.ClearMatrix(true);	140	PlayGroundMatrix.ClearMatrix(true);
145	for i := 0 to Length(PrevPlaygroundMatrixes)-1 do	141	for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
146	PrevPlaygroundMatrixes[i].ClearMatrix(false);	142	PrevPlaygroundMatrixes[i].ClearMatrix(false);
147	SetLength(PrevPlaygroundMatrixes, 0);	143	SetLength(PrevPlaygroundMatrixes, 0);
148	MUndo.Enabled := false;	144	MUndo.Enabled := false;
149		145
150	SetLength(LookupFieldCoordinateArray, 0);	146	SetLength(LookupFieldCoordinateArray, 0);
151		147
152	if Assigned(Level) then FreeAndNil(Level);	148	if Assigned(Level) then FreeAndNil(Level);
153	end;	149	end;
154		150
155	procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);	151	procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
156	begin	152	begin
157	case FieldType of	153	case FieldType of
158	ftEmpty: Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);	154	ftEmpty: Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
159	ftGreen: Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);	155	ftGreen: Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
160	ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);	156	ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
161	ftRed: Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);	157	ftRed: Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
162	end;	158	end;
163	end;	159	end;
164		160
165	function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;	161	function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
166	begin	162	begin
167	result := TImage.Create(panel);	163	result := TImage.Create(panel);
168	result.Parent := panel;	164	result.Parent := panel;
169	LoadPictureForType(fieldtype, result.Picture);	165	LoadPictureForType(fieldtype, result.Picture);
170	result.Width := panel.Width - 2*MET_SHAPE_MARGIN;	166	result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
171	result.Height := panel.Height - 2*MET_SHAPE_MARGIN;	167	result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
172	result.Left := MET_SHAPE_MARGIN;	168	result.Left := MET_SHAPE_MARGIN;
173	result.Top := MET_SHAPE_MARGIN;	169	result.Top := MET_SHAPE_MARGIN;
174	result.Center := true;	170	result.Center := true;
175	result.Transparent := true;	171	result.Transparent := true;
176		172
177	result.Tag := panel.Tag;	173	result.Tag := panel.Tag;
178	result.OnDragOver := panel.OnDragOver;	174	result.OnDragOver := panel.OnDragOver;
179	result.OnDragDrop := panel.OnDragDrop;	175	result.OnDragDrop := panel.OnDragDrop;
180		176
181	StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);	177	StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
182	end;	178	end;
183		179
184	procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);	180	procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
185	begin	181	begin
186	if Allow then	182	if Allow then
187	begin	183	begin
188	Stone.DragMode := dmAutomatic;	184	Stone.DragMode := dmAutomatic;
189	(Stone.Parent as TPanel).DragMode := dmAutomatic;	185	(Stone.Parent as TPanel).DragMode := dmAutomatic;
190	end	186	end
191	else	187	else
192	begin	188	begin
193	Stone.DragMode := dmManual;	189	Stone.DragMode := dmManual;
194	(Stone.Parent as TPanel).DragMode := dmManual;	190	(Stone.Parent as TPanel).DragMode := dmManual;
195	end;	191	end;
196	end;	192	end;
197		193
198	function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;	194	function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
199	begin	195	begin
200	result := TPanel.Create(Playground);	196	result := TPanel.Create(Playground);
201	result.Parent := Playground;	197	result.Parent := Playground;
202	if isGoal then	198	if isGoal then
203	begin	199	begin
204	result.BevelInner := bvLowered;	200	result.BevelInner := bvLowered;
205	end;	201	end;
206	result.Color := Playground.Color;	202	result.Color := Playground.Color;
207	result.BevelOuter := bvLowered;	203	result.BevelOuter := bvLowered;
208	result.Width := MET_FIELD_SIZE;	204	result.Width := MET_FIELD_SIZE;
209	result.Height := MET_FIELD_SIZE;	205	result.Height := MET_FIELD_SIZE;
210	result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);	206	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;	207	result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
212		208
213	result.Tag := tag;	209	result.Tag := tag;
214	result.OnDragOver := StoneDragOver;	210	result.OnDragOver := StoneDragOver;
215	result.OnDragDrop := StoneDragDrop;	211	result.OnDragDrop := StoneDragDrop;
216	end;	212	end;
217		213
218	procedure TMainForm.MExitClick(Sender: TObject);	214	procedure TMainForm.MExitClick(Sender: TObject);
219	begin	215	begin
220	Close;	216	Close;
221	end;	217	end;
222		218
223	procedure TMainForm.RefreshTime;	219	procedure TMainForm.RefreshTime;
224	begin	220	begin
225	Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);	221	Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
226	end;	222	end;
227		223
228	procedure TMainForm.RefreshStonesRemoved;	224	procedure TMainForm.RefreshStonesRemoved;
229	resourcestring	225	resourcestring
230	LNG_STONES_REMOVED = '%d of %d stones removed';	226	LNG_STONES_REMOVED = '%d of %d stones removed';
231	begin	227	begin
232	Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);	228	Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
233	end;	229	end;
234		230
235	procedure TMainForm.RefreshPoints;	231	procedure TMainForm.RefreshPoints;
236	begin	232	begin
237	Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);	233	Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
238	end;	234	end;
239		235
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);	236	procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
247	begin	237	begin
248	if count_points then	238	if count_points then
249	begin	239	begin
250	CountPoints(PlayGroundMatrix.Fields[x, y].FieldType);	240	Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));
-		241	RefreshPoints;
-		242
251	Inc(LevelRemovedStones);	243	Inc(LevelRemovedStones);
252	RefreshStonesRemoved;	244	RefreshStonesRemoved;
253	end;	245	end;
254	PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;	246	PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;
255	LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);	247	LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);
256	StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);	248	StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);
257	end;	249	end;
258		250
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);	251	procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
286	var	252	var
287	mode: string;	253	mode: string;
288	goalYeSNo: string;	254	goalYeSNo: string;
289	resourcestring	255	resourcestring
290	LNG_BOARD = 'Board: %s';	256	LNG_BOARD = 'Board: %s';
291	LNG_MODE = 'Mode: %s';	257	LNG_MODE = 'Mode: %s';
292	LNG_STONES_TOTAL = 'Stones: %d';	258	LNG_STONES_TOTAL = 'Stones: %d';
293	LNG_GOAL_AVAILABLE = 'Target field defined';	259	LNG_GOAL_AVAILABLE = 'Target field defined';
294	LNG_NO_GOAL = 'No target field';	260	LNG_NO_GOAL = 'No target field';
295	begin	261	begin
296	if Level.GetGameMode = gmDiagonal then	262	case Level.GameMode of
297	mode := 'Diagonal'	263	gmNormal: mode := 'Diagonal';
298	else if Level.GetGameMode = gmNormal then	264	gmDiagonal: mode := 'Normal';
299	mode := 'Normal'	265	gmUndefined: mode := '?';
300	else	266	end;
301	mode := '?';	-
302		267
303	if GoalStatus = gsNoGoal then	268	if GoalStatus = gsNoGoal then
304	goalYeSNo := LNG_NO_GOAL	269	goalYeSNo := LNG_NO_GOAL
305	else	270	else
306	goalYeSNo := LNG_GOAL_AVAILABLE;	271	goalYeSNo := LNG_GOAL_AVAILABLE;
307		272
308	ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +	273	ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
309	#13#10 +	274	#13#10 +
310	Format(LNG_MODE, [mode]) + #13#10 +	275	Format(LNG_MODE, [mode]) + #13#10 +
311	Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +	276	Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
312	goalYesNo);	277	goalYesNo);
313	end;	278	end;
314		279
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);	280	procedure TMainForm.DoJump(SourceTag, DestTag: integer);
335	resourcestring	281	resourcestring
336	LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';	282	LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
337	var	283	var
338	d, s: TPoint;	284	d, s: TPoint;
339	old_fieldtype: TFieldType;	285	old_fieldtype: TFieldType;
340	res: Integer;	286	res: Integer;
341	begin	287	begin
342	if not MayJump(SourceTag, DestTag) then exit;	288	if not MayJump(SourceTag, DestTag) then exit;
343		289
344	d := LookupFieldCoordinateArray[DestTag];	290	d := LookupFieldCoordinateArray[DestTag];
345	s := LookupFieldCoordinateArray[SourceTag];	291	s := LookupFieldCoordinateArray[SourceTag];
346		292
347	JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));	293	JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
348		294
349	{$REGION 'Stein entfernen und Punkte vergeben'}	295	{$REGION 'Stein entfernen und Punkte vergeben'}
350	if Level.GetGameMode = gmDiagonal then	296	if Level.GameMode = gmDiagonal then
351	begin	297	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);	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);
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);	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);
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);	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);
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);	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);
356	end;	302	end;
357		303
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);	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);
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);	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);
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);	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);
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);	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);
362	{$ENDREGION}	308	{$ENDREGION}
363		309
364	// Den Timer erst nach dem ersten Zug starten	310	// Den Timer erst nach dem ersten Zug starten
365	// oder nach einer Pause neustarten	311	// oder nach einer Pause neustarten
366	MPauseTime.Checked := false;	312	MPauseTime.Checked := false;
367	MPauseTime.Enabled := true;	313	MPauseTime.Enabled := true;
368	Timer.Enabled := true;	314	Timer.Enabled := true;
369		315
370	// Sound abspielen	316	// Sound abspielen
371	if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);	317	if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
372		318
373	{$REGION 'Nun den Stein springen lassen'}	319	{$REGION 'Nun den Stein springen lassen'}
374	old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken	320	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	321	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	322	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	323	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	324	StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
379	{$ENDREGION}	325	{$ENDREGION}
380		326
381	{$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}	327	{$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
382	if not AreJumpsPossible then	328	if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
383	begin	329	begin
384	MPauseTime.Checked := false;	330	MPauseTime.Checked := false;
385	MPauseTime.Enabled := false;	331	MPauseTime.Enabled := false;
386	Timer.Enabled := false;	332	Timer.Enabled := false;
387	RefreshTime;	333	RefreshTime;
388	if MEnableSound.Checked then	334	if MEnableSound.Checked then
389	begin	335	begin
390	if LevelRemovedStones = LevelTotalStones-1 then	336	if LevelRemovedStones = LevelTotalStones-1 then
391	begin	337	begin
392	if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then	338	if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
393	PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)	339	PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
394	else	340	else
395	PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)	341	PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
396	end	342	end
397	else	343	else
398	PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);	344	PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
399	end;	345	end;
400	res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);	346	res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
401	if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;	347	if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
402	end;	348	end;
403	{$ENDREGION}	349	{$ENDREGION}
404		350
405	SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);	351	SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
406	PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;	352	PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
407	MUndo.Enabled := true;	353	MUndo.Enabled := true;
408	end;	354	end;
409		355
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;	356	function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
433	var	357	var
434	s, d: TPoint;	358	s, d: TPoint;
435	begin	359	begin
436	d := LookupFieldCoordinateArray[DestTag];	360	d := LookupFieldCoordinateArray[DestTag];
437	s := LookupFieldCoordinateArray[SourceTag];	361	s := LookupFieldCoordinateArray[SourceTag];
438		362
439	result := MayJump(s.X, s.Y, d.X, d.Y);	363	result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);
440	end;	364	end;
441		365
442	procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);	366	procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
443	begin	367	begin
444	DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);	368	DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
445	end;	369	end;
446		370
447	procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,	371	procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
448	Y: Integer; State: TDragState; var Accept: Boolean);	372	Y: Integer; State: TDragState; var Accept: Boolean);
449	begin	373	begin
450	Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);	374	Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
451	end;	375	end;
452		376
453	function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;	377	function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
454	var	378	var
455	newField: TField;	379	newField: TField;
456	index: integer;	380	index: integer;
457	begin	381	begin
458	ZeroMemory(@result, SizeOf(result));	382	ZeroMemory(@result, SizeOf(result));
459	if t.Typ = ftFullSpace then exit;	383	if t.Typ = ftFullSpace then exit;
460		384
461	index := Length(LookupFieldCoordinateArray);	385	index := Length(LookupFieldCoordinateArray);
462		386
463	newField.FieldType := t.Typ;	387	newField.FieldType := t.Typ;
464	newField.Goal := t.Goal;	388	newField.Goal := t.Goal;
465	newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);	389	newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
466	newField.Stone := DrawStone(t.Typ, newField.Panel);	390	newField.Stone := DrawStone(t.Typ, newField.Panel);
467	if PlayGroundMatrix.FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);	391	if PlayGroundMatrix.FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
468		392
469	SetLength(LookupFieldCoordinateArray, index + 1);	393	SetLength(LookupFieldCoordinateArray, index + 1);
470	LookupFieldCoordinateArray[index].X := x;	394	LookupFieldCoordinateArray[index].X := x;
471	LookupFieldCoordinateArray[index].Y := y;	395	LookupFieldCoordinateArray[index].Y := y;
472		396
473	if Length(PlayGroundMatrix.Fields) < x+1 then SetLength(PlayGroundMatrix.Fields, x+1);	397	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);	398	if Length(PlayGroundMatrix.Fields[x]) < y+1 then SetLength(PlayGroundMatrix.Fields[x], y+1);
475	PlaygroundMatrix.Fields[x, y] := newField;	399	PlaygroundMatrix.Fields[x, y] := newField;
476		400
477	result := newField;	401	result := newField;
478	end;	402	end;
479		403
480	procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);	404	procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
481	var	405	var
482	y, x: integer;	406	y, x: integer;
483	max_x, max_y: integer;	407	max_x, max_y: integer;
484	p: TPanel;	408	p: TPanel;
485	begin	409	begin
486	PlayGround.Visible := false;	410	PlayGround.Visible := false;
487		411
488	// Die Dimensionen ermitteln	412	// Die Dimensionen ermitteln
489	max_x := 0;	413	max_x := 0;
490	max_y := 0;	414	max_y := 0;
491	for y := Low(LevelArray) to High(LevelArray) do	415	for y := Low(LevelArray) to High(LevelArray) do
492	begin	416	begin
493	for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do	417	for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
494	begin	418	begin
495	p := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent).Panel;	419	p := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent).Panel;
496	if Assigned(p) then	420	if Assigned(p) then
497	begin	421	begin
498	max_x := Max(max_x, p.Left + p.Width);	422	max_x := Max(max_x, p.Left + p.Width);

Subversion Repositories jumper

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