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);
    procedure DrawField(x, y: integer; var f: TField);
    function DrawStone(f: TField): TImage;
    function DrawStoneBox(x, y, tag: integer; f: TField): TPanel;
    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}
 
type
  TFieldVclData = class(TObject)
  public
    Panel: TPanel;
    Stone: TImage;
    destructor Destroy; override;
  end;
 
{ 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].Data) and
         Assigned(TFieldVclData(Matrix.Fields[x,y].Data).Stone) then
      begin
        LoadPictureForType(Matrix.Fields[x,y].FieldType,
                           TFieldVclData(Matrix.Fields[x,y].Data).Stone.Picture);
        StoneDraggingAllow(TFieldVclData(Matrix.Fields[x,y].Data).Stone,
                           Matrix.Fields[x,y].FieldState <> 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(f: TField): TImage;
var
  panel: TPanel;
begin
  panel := TFieldVclData(f.Data).Panel;
 
  result := TImage.Create(panel);
  result.Parent := panel;
  LoadPictureForType(f.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, f.FieldState <> 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: integer; f: TField): TPanel;
begin
  result := TPanel.Create(Playground);
  result.Parent := Playground;
  if f.Goal 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 + (f.Indent*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'; // Jumping stone not counted
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,
                     TFieldVclData(PlayGroundMatrix.Fields[x,y].Data).Stone.Picture);
  StoneDraggingAllow(TFieldVclData(PlayGroundMatrix.Fields[x,y].Data).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];';
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, [s.x+1, s.y+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) = fsOccupied) 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) = fsOccupied) 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) = fsOccupied) 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) = fsOccupied) 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  ) = fsOccupied) 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  ) = fsOccupied) 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) = fsOccupied) 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) = fsOccupied) 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,
                     TFieldVclData(PlayGroundMatrix.Fields[d.X, d.Y].Data).Stone.Picture); // Stein an neue Position malen
  StoneDraggingAllow(TFieldVclData(PlayGroundMatrix.Fields[d.X, d.Y].Data).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, d, 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;
 
procedure TMainForm.DrawField(x, y: integer; var f: TField);
var
  index: integer;
begin
  if f.FieldType = ftFullSpace then exit;
 
  index := PlaygroundMatrix.CoordToIndex(x, y);
 
  if not Assigned(f.Data) then f.Data := TFieldVclData.Create;
  TFieldVclData(f.Data).Panel := DrawStoneBox(x, y, index, f);
  TFieldVclData(f.Data).Stone := DrawStone(f);
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
  y, x: integer;
  max_x, max_y: integer;
  p: TPanel;
begin
  DestroyLevel;
 
  MPauseTime.Checked := true;
  MPauseTime.Enabled := true;
  Timer.Enabled := true;
  MRestartGame.Enabled := true;
 
  LevelFile := Filename;
  Level := TLevel.Create(LevelFile);
 
  Level.FillPlaygroundMatrix(PlaygroundMatrix, true);
  if Length(PlaygroundMatrix.Fields) = 0 then Exit;
 
  PlayGround.Visible := false;
 
  max_x := 0;
  max_y := 0;
  for x := Low(PlaygroundMatrix.Fields) to High(PlaygroundMatrix.Fields) do
  begin
    for y := Low(PlaygroundMatrix.Fields[x]) to High(PlaygroundMatrix.Fields[x]) do
    begin
      if PlaygroundMatrix.Fields[x,y].FieldState = fsOccupied then
        Inc(LevelTotalStones);
      DrawField(x, y, PlaygroundMatrix.Fields[x,y]);
      if Assigned(PlaygroundMatrix.Fields[x,y].Data) then
      begin
        p := TFieldVclData(PlaygroundMatrix.Fields[x,y].Data).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;
  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;
 
  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;
begin
  result := PlaygroundMatrix.GoalStatus(LevelTotalStones - LevelRemovedStones);
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;
 
{ TFieldVclData }
 
destructor TFieldVclData.Destroy;
begin
  if Assigned(Stone) then Stone.Free;
  if Assigned(Panel) then Panel.Free;
  inherited;
end;
 
end.
 

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

Subversion Repositories jumper

jumper/trunk/Main.pas @ 11 – Rev 26 → 29