Subversion Repositories jumper

Compare Revisions

Regard whitespace Rev HEAD → Rev 1

/trunk/Main.pas
7,6 → 7,17
ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
 
type
TField = record
FieldType: TFieldType;
Goal: Boolean;
Panel: TPanel;
Stone: TImage;
end;
 
TFieldState = (fsError, fsLocked, fsAvailable, fsStone);
 
TPlayGroundMatrix = array of array of TField;
 
TMainForm = class(TForm)
Playground: TPanel;
MainMenu: TMainMenu;
29,8 → 40,8
MPauseTime: TMenuItem;
N1: TMenuItem;
MUndo: TMenuItem;
MRedo: TMenuItem;
N3: TMenuItem;
Aboutthislevel1: TMenuItem;
procedure MExitClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure MNewGameClick(Sender: TObject);
41,22 → 52,20
procedure MJumpHistoryClick(Sender: TObject);
procedure MRestartGameClick(Sender: TObject);
procedure MHighScoresClick(Sender: TObject);
procedure MPauseTimeClick(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);
procedure MEnableSoundClick(Sender: TObject);
private
NoCloseQuery: boolean;
CountedSeconds: Integer;
LevelFile: String;
PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
LookupFieldCoordinateArray: array of TPoint;
OriginalPlayGroundMatrix: TPlayGroundMatrix;
PlaygroundMatrix: TPlayGroundMatrix;
Points: Integer;
LevelTotalStones: Integer;
LevelRemovedStones: Integer;
JumpHistory: TStringList;
Level: TLevel;
procedure LoadSettings;
procedure SaveSettings;
procedure RestartLevel;
63,6 → 72,7
procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
function AskForLevel: String;
function AreJumpsPossible: boolean;
procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
procedure NewGame(Filename: string);
function LevelTime: String;
70,16 → 80,25
procedure RefreshTime;
procedure RefreshPoints;
procedure RefreshStonesRemoved;
procedure CountPoints(t: TFieldType);
procedure RemoveStone(x, y: integer; count_points: boolean);
procedure DoJump(SourceTag, DestTag: integer);
function CanJump(x, y: integer): boolean;
function MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; overload;
function MayJump(SourceTag, DestTag: integer): boolean; overload;
procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
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 DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
procedure BuildPlayground(LevelArray: TLevelArray);
function FieldState(t: TFieldType): TFieldState; overload;
function FieldState(f: TField): TFieldState; overload;
function FieldState(x, y: integer): TFieldState; overload;
procedure ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
function CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
function GoalStatus: TGoalStatus;
end;
 
var
88,35 → 107,41
implementation
 
uses
About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
About, Finish, Choice, Functions, History, HighScore, Help, Constants;
 
{$R *.dfm}
 
type
TFieldVclData = class(TObject)
public
Panel: TPanel;
Stone: TImage;
destructor Destroy; override;
procedure TMainForm.ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
var
i, j: integer;
begin
for i := Low(Matrix) to High(Matrix) do
begin
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
if FreeVCL then
begin
if Assigned(Matrix[i][j].Stone) then Matrix[i][j].Stone.Free;
if Assigned(Matrix[i][j].Panel) then Matrix[i][j].Panel.Free;
end;
end;
SetLength(Matrix[i], 0);
end;
SetLength(Matrix, 0);
end;
 
{ TMainForm }
 
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
var
x, y: integer;
i, j: integer;
begin
for x := Low(Matrix.Fields) to High(Matrix.Fields) do
for i := Low(Matrix) to High(Matrix) do
begin
for y := Low(Matrix.Fields[x]) to High(Matrix.Fields[x]) do
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
if Assigned(Matrix.Fields[x,y].Data) and
Assigned(TFieldVclData(Matrix.Fields[x,y].Data).Stone) then
if Assigned(Matrix[i][j].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);
LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture);
StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable);
end;
end;
end;
123,10 → 148,7
end;
 
procedure TMainForm.DestroyLevel;
var
i: Integer;
begin
MPauseTime.Checked := false;
MPauseTime.Enabled := false;
Timer.Enabled := false;
 
146,13 → 168,10
 
JumpHistory.Clear;
 
PlayGroundMatrix.ClearMatrix(true);
for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
PrevPlaygroundMatrixes[i].ClearMatrix(false);
SetLength(PrevPlaygroundMatrixes, 0);
MUndo.Enabled := false;
ClearMatrix(PlayGroundMatrix, true);
ClearMatrix(OriginalPlayGroundMatrix, false);
 
if Assigned(Level) then FreeAndNil(Level);
SetLength(LookupFieldCoordinateArray, 0);
end;
 
procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
165,15 → 184,11
end;
end;
 
function TMainForm.DrawStone(f: TField): TImage;
var
panel: TPanel;
function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
begin
panel := TFieldVclData(f.Data).Panel;
 
result := TImage.Create(panel);
result.Parent := panel;
LoadPictureForType(f.FieldType, result.Picture);
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;
185,7 → 200,7
result.OnDragOver := panel.OnDragOver;
result.OnDragDrop := panel.OnDragDrop;
 
StoneDraggingAllow(result, f.FieldState <> fsAvailable);
StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable);
end;
 
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
202,11 → 217,11
end;
end;
 
function TMainForm.DrawStoneBox(x, y, tag: integer; f: TField): TPanel;
function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
begin
result := TPanel.Create(Playground);
result.Parent := Playground;
if f.Goal then
if isGoal then
begin
result.BevelInner := bvLowered;
end;
214,7 → 229,7
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.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;
227,6 → 242,33
Close;
end;
 
function TMainForm.FieldState(t: TFieldType): TFieldState;
begin
result := fsError;
case t of
ftLocked: result := fsLocked;
ftLockedWithTab: result := fsLocked;
ftEmpty: result := fsAvailable;
ftGreen: result := fsStone;
ftYellow: result := fsStone;
ftRed: result := fsStone;
end;
end;
 
function TMainForm.FieldState(f: TField): TFieldState;
begin
result := FieldState(f.FieldType);
end;
 
function TMainForm.FieldState(x, y: integer): TFieldState;
begin
result := fsError;
if (x < Low(PlayGroundMatrix)) or (x > High(PlayGroundMatrix)) then exit;
if (y < Low(PlayGroundMatrix[x])) or (y > High(PlayGroundMatrix[x])) then exit;
 
result := FieldState(PlayGroundMatrix[x][y]);
end;
 
procedure TMainForm.RefreshTime;
begin
Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
233,10 → 275,8
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]);
Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones]);
end;
 
procedure TMainForm.RefreshPoints;
244,137 → 284,160
Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
end;
 
procedure TMainForm.CountPoints(t: TFieldType);
begin
if t = ftGreen then inc(Points, 10);
if t = ftYellow then inc(Points, 20);
if t = ftRed then inc(Points, 30);
RefreshPoints;
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;
 
CountPoints(PlayGroundMatrix[x, y].FieldType);
Inc(LevelRemovedStones);
RefreshStonesRemoved;
end;
PlayGroundMatrix[x, y].FieldType := ftEmpty;
LoadPictureForType(PlayGroundMatrix[x, y].FieldType, PlayGroundMatrix[x, y].Stone.Picture);
StoneDraggingAllow(PlayGroundMatrix[x, y].Stone, false);
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);
function TMainForm.CanJump(x, y: integer): boolean;
begin
if FieldState(x, y) <> fsStone then
begin
result := false;
exit;
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';
result := true;
 
if MayJump(x, y, x+2, y) then exit;
if MayJump(x, y, x-2, y) then exit;
if MayJump(x, y, x, y+2) then exit;
if MayJump(x, y, x, y-2) then exit;
 
if AllowDiagonalMoves then
begin
case Level.GameMode of
gmNormal: mode := 'Diagonal';
gmDiagonal: mode := 'Normal';
gmUndefined: mode := '?';
if MayJump(x, y, x-2, y-2) then exit;
if MayJump(x, y, x+2, y-2) then exit;
if MayJump(x, y, x-2, y+2) then exit;
if MayJump(x, y, x+2, y+2) then exit;
end;
 
if GoalStatus = gsNoGoal then
goalYeSNo := LNG_NO_GOAL
else
goalYeSNo := LNG_GOAL_AVAILABLE;
result := false;
end;
 
ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
#13#10 +
Format(LNG_MODE, [mode]) + #13#10 +
Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
goalYesNo);
function TMainForm.AreJumpsPossible: boolean;
var
i, j: integer;
begin
result := false;
for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do
begin
for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do
begin
if CanJump(i, j) then
begin
result := true;
break;
end;
if result then break;
end;
end;
end;
 
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
resourcestring
LNG_JUMP_LOG = '[%d, %d] -> [%d, %d];';
var
d, s: TCoord;
d, s: TPoint;
old_fieldtype: TFieldType;
res: Integer;
begin
if not MayJump(SourceTag, DestTag) then exit;
 
s := PlaygroundMatrix.IndexToCoord(SourceTag);
d := PlaygroundMatrix.IndexToCoord(DestTag);
d := LookupFieldCoordinateArray[DestTag];
s := LookupFieldCoordinateArray[SourceTag];
 
JumpHistory.Add(Format(LNG_JUMP_LOG, [s.x+1, s.y+1, d.x+1, d.y+1]));
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
if AllowDiagonalMoves 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);
if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (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 (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 (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 (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 ) = 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}
if (s.X+2 = d.X) and (s.Y = d.Y) and (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 (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 (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 (FieldState(s.X , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true);
 
// Den Timer erst nach dem ersten Zug starten
// oder nach einer Pause neustarten
MPauseTime.Checked := false;
if not Timer.Enabled then
begin
MPauseTime.Enabled := true;
Timer.Enabled := true;
end;
 
if not MRestartGame.Enabled then MRestartGame.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}
// Nun den Stein springen lassen
old_fieldtype := PlayGroundMatrix[s.X, s.Y].FieldType; // Steinfarbe merken
RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen
PlayGroundMatrix[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
LoadPictureForType(PlayGroundMatrix[d.X, d.Y].FieldType, PlayGroundMatrix[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
StoneDraggingAllow(PlayGroundMatrix[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
 
{$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
// Ist ein weiterer Sprung möglich?
if not AreJumpsPossible then
begin
MPauseTime.Checked := false;
MPauseTime.Enabled := false;
Timer.Enabled := false;
RefreshTime;
if MEnableSound.Checked then
if MEnableSound.Checked then PlaySound(RES_FINISH, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, JumpHistory);
if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
end;
end;
 
function TMainForm.MayJump(SourceX, SourceY, DestX, DestY: integer): boolean;
begin
if LevelRemovedStones = LevelTotalStones-1 then
result := false;
 
// Check 1: Ist das Zielfeld überhaupt leer?
if FieldState(DestX, DestY) <> fsAvailable then exit;
 
// Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
if AllowDiagonalMoves 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);
if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true;
if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true;
if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true;
if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
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;
if (SourceX+2 = DestX) and (SourceY = DestY) and (FieldState(SourceX+1, SourceY ) = fsStone) then result := true;
if (SourceX-2 = DestX) and (SourceY = DestY) and (FieldState(SourceX-1, SourceY ) = fsStone) then result := true;
if (SourceX = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX , SourceY+1) = fsStone) then result := true;
if (SourceX = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX , SourceY-1) = fsStone) then result := true;
end;
 
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
var
s, d: TCoord;
s, d: TPoint;
begin
s := PlayGroundMatrix.IndexToCoord(SourceTag);
d := PlayGroundMatrix.IndexToCoord(DestTag);
d := LookupFieldCoordinateArray[DestTag];
s := LookupFieldCoordinateArray[SourceTag];
 
result := PlaygroundMatrix.CanJump(s, d, Level.GameMode = gmDiagonal);
result := MayJump(s.X, s.Y, d.X, d.Y);
end;
 
procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
388,101 → 451,126
Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
end;
 
procedure TMainForm.DrawField(x, y: integer; var f: TField);
procedure TMainForm.DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
var
newField: TField;
index: integer;
begin
if f.FieldType = ftFullSpace then exit;
if (t.Typ = ftLocked) or (t.Typ = ftLockedWithTab) then exit;
 
index := PlaygroundMatrix.CoordToIndex(x, y);
index := Length(LookupFieldCoordinateArray);
 
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;
newField.FieldType := t.Typ;
newField.Goal := t.Goal;
newField.Panel := DrawStoneBox(x, y, index, halftabs, t.Goal);
newField.Stone := DrawStone(t.Typ, newField.Panel);
if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
 
procedure TMainForm.TimerTimer(Sender: TObject);
begin
if MPauseTime.Checked then exit;
if mainform.Focused then Inc(CountedSeconds);
RefreshTime;
SetLength(LookupFieldCoordinateArray, index + 1);
LookupFieldCoordinateArray[index].X := x;
LookupFieldCoordinateArray[index].Y := y;
 
if Length(PlayGroundMatrix) < x+1 then SetLength(PlayGroundMatrix, x+1);
if Length(PlayGroundMatrix[x]) < y+1 then SetLength(PlayGroundMatrix[x], y+1);
PlaygroundMatrix[x, y] := newField;
end;
 
function TMainForm.LevelTime: String;
function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
var
i, j: integer;
begin
result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)
SetLength(result, Length(Source));
for i := Low(Source) to High(Source) do
begin
SetLength(result[i], Length(Source[i]));
for j := Low(Source[i]) to High(Source[i]) do
begin
result[i][j].FieldType := Source[i][j].FieldType;
result[i][j].Goal := Source[i][j].Goal;
result[i][j].Panel := Source[i][j].Panel;
result[i][j].Stone := Source[i][j].Stone;
end;
end;
end;
 
procedure TMainForm.NewGame(Filename: string);
resourcestring
LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
var
y, x: integer;
max_x, max_y: integer;
p: TPanel;
i, j, halftabs, cur_x: integer;
max_x, max_y, old_cw, old_ch: integer;
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;
 
// Die Dimensionen ermitteln
max_x := 0;
max_y := 0;
for x := Low(PlaygroundMatrix.Fields) to High(PlaygroundMatrix.Fields) do
for i := Low(LevelArray) to High(LevelArray) do
begin
for y := Low(PlaygroundMatrix.Fields[x]) to High(PlaygroundMatrix.Fields[x]) do
halftabs := 0;
for j := Low(LevelArray[i]) to High(LevelArray[i]) 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);
if LevelArray[i][j].Typ = ftLockedWithTab then inc(halftabs);
DrawField(j, i, LevelArray[i][j], halftabs);
end;
cur_x := High(LevelArray[i]) + 1;
if cur_x > max_x then max_x := cur_x;
end;
end;
end;
max_y := High(LevelArray) + 1;
 
PlayGround.Visible := true;
 
// Die aktuellen Dimensionen merken
old_cw := ClientWidth;
old_ch := ClientHeight;
 
// Das Form an das Level anpassen
PlayGround.Top := MET_OUTER_MARGIN;
PlayGround.Left := MET_OUTER_MARGIN;
PlayGround.Width := max_x;
PlayGround.Height := max_y;
PlayGround.Width := MET_FIELD_SPACE + max_x * (MET_FIELD_SPACE + MET_FIELD_SIZE);
PlayGround.Height := MET_FIELD_SPACE + max_y * (MET_FIELD_SPACE + MET_FIELD_SIZE);
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;
// Wenn sich das Form vergrößert oder verkleinert hat, neu justieren
if (old_cw <> ClientWidth) or (old_ch <> ClientHeight) then
begin
Left := Screen.Width div 2 - Width div 2;
Top := Screen.Height div 2 - Height div 2;
 
if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
// Playground mittig setzen, falls die Mindestgröße für die
// Punkteanzeige unterschritten wurde,
PlayGround.Left := ClientWidth div 2 - PlayGround.Width div 2;
PlayGround.Top := ClientHeight div 2 - PlayGround.Height div 2;
end;
 
OriginalPlayGroundMatrix := CloneMatrix(PlayGroundMatrix);
end;
 
procedure TMainForm.TimerTimer(Sender: TObject);
begin
MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
if mainform.Focused then Inc(CountedSeconds);
RefreshTime;
end;
 
function TMainForm.LevelTime: String;
begin
result := SecondsToTimeString(CountedSeconds);
end;
 
procedure TMainForm.NewGame(Filename: string);
var
LevelString: String;
LevelArray: TLevelArray;
begin
DestroyLevel;
LevelFile := Filename;
LevelString := ReadFile(LevelFile);
LevelArray := LevelStringToLevelArray(LevelString, true);
if Length(LevelArray) = 0 then Exit;
BuildPlayground(LevelArray);
if not AreJumpsPossible then
begin
ShowMessage(LNG_LVL_INVALID_NO_JUMP);
end;
RefreshTime;
RefreshStonesRemoved;
RefreshPoints;
522,18 → 610,9
begin
NewGame(LevelFile);
end
else
begin
NoCloseQuery := true;
Close;
else Close();
end;
end;
 
function TMainForm.GoalStatus: TGoalStatus;
begin
result := PlaygroundMatrix.GoalStatus(LevelTotalStones - LevelRemovedStones);
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
JumpHistory := TStringList.Create;
542,7 → 621,6
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
DestroyLevel;
JumpHistory.Free;
end;
 
553,13 → 631,12
end;
 
procedure TMainForm.RestartLevel;
var
i: Integer;
begin
MPauseTime.Checked := true;
MPauseTime.Enabled := true;
Timer.Enabled := true;
MPauseTime.Enabled := false;
Timer.Enabled := false;
 
MRestartGame.Enabled := false;
 
CountedSeconds := 0;
RefreshTime;
 
571,19 → 648,14
 
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;
RedrawStonesFromMatrix(OriginalPlayGroundMatrix);
SetNewPlayGroundMatrix(OriginalPlayGroundMatrix);
end;
 
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
begin
PlayGroundMatrix.ClearMatrix(false); // Memory Leak verhindern
PlayGroundMatrix := Matrix.CloneMatrix;
ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
PlayGroundMatrix := CloneMatrix(Matrix);
end;
 
procedure TMainForm.MRestartGameClick(Sender: TObject);
591,40 → 663,15
RestartLevel;
end;
 
procedure TMainForm.MUndoClick(Sender: TObject);
var
PrevWorth: integer;
NewWorth: integer;
procedure TMainForm.MHighScoresClick(Sender: TObject);
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);
HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
end;
 
MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
end;
 
procedure TMainForm.MHighScoresClick(Sender: TObject);
procedure TMainForm.MPauseTimeClick(Sender: TObject);
begin
HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
MPauseTime.Enabled := false;
Timer.Enabled := false;
end;
 
procedure TMainForm.LoadSettings;
662,6 → 709,7
end;
end;
 
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SaveSettings;
671,25 → 719,14
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;
procedure TMainForm.MEnableSoundClick(Sender: TObject);
begin
if Assigned(Stone) then Stone.Free;
if Assigned(Panel) then Panel.Free;
inherited;
MEnableSound.Checked := not MEnableSound.Checked;
end;
 
end.