Subversion Repositories jumper

Compare Revisions

Regard whitespace Rev 20 → Rev 21

/trunk/Choice.dfm
2,8 → 2,8
Left = 257
Top = 146
Caption = 'ViaThinkSoft Peg Solitaire - Board choice'
ClientHeight = 415
ClientWidth = 656
ClientHeight = 423
ClientWidth = 820
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
13,57 → 13,79
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnResize = FormResize
OnShow = FormShow
DesignSize = (
820
423)
PixelsPerInch = 96
TextHeight = 13
object PlayBtn: TButton
Left = 336
Top = 384
Left = 515
Top = 390
Width = 121
Height = 25
Anchors = [akRight, akBottom]
Caption = 'Play!'
Default = True
Enabled = False
TabOrder = 2
OnClick = PlayBtnClick
ExplicitLeft = 513
ExplicitTop = 382
end
object CancelBtn: TButton
Left = 8
Top = 384
Top = 392
Width = 121
Height = 25
Anchors = [akLeft, akBottom]
Cancel = True
Caption = 'Cancel'
TabOrder = 3
OnClick = CancelBtnClick
ExplicitTop = 384
end
object PreviewGrp: TGroupBox
Left = 464
Left = 642
Top = 8
Width = 169
Height = 369
Width = 170
Height = 377
Anchors = [akTop, akRight, akBottom]
Caption = 'Preview'
TabOrder = 1
ExplicitLeft = 640
ExplicitHeight = 369
DesignSize = (
170
377)
object PreviewImage: TImage
Left = 8
Top = 16
Width = 153
Height = 345
Height = 353
Anchors = [akLeft, akTop, akRight, akBottom]
ExplicitHeight = 345
end
end
object LevelGrp: TGroupBox
Left = 8
Top = 8
Width = 449
Height = 369
Width = 628
Height = 377
Anchors = [akLeft, akTop, akRight, akBottom]
Caption = 'Please select the board you want to play with'
TabOrder = 0
ExplicitWidth = 626
ExplicitHeight = 369
DesignSize = (
628
377)
object LevelList: TListView
Left = 8
Top = 16
Width = 433
Height = 345
Width = 612
Height = 353
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <>
IconOptions.AutoArrange = True
LargeImages = LevelImageList
75,6 → 97,8
OnChange = LevelListChange
OnClick = LevelListClick
OnDblClick = PlayBtnClick
ExplicitWidth = 433
ExplicitHeight = 345
end
end
object LevelImageList: TImageList
83,7 → 107,7
Left = 24
Top = 32
Bitmap = {
494C0101030018003C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
494C010103001800400020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000800000002000000001002000000000000040
0000000000000000000000000000000000000000000000000000000000000000
0000800000008000000080000000800000008000000080000000800000008000
/trunk/Choice.pas
4,7 → 4,7
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList;
Dialogs, StdCtrls, ImgList, ComCtrls, Menus, ExtCtrls, System.ImageList, LevelFunctions;
 
type
TLevelChoice = class(TForm)
22,13 → 22,12
procedure CancelBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure LevelListClick(Sender: TObject);
procedure LevelListChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure LevelListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
procedure PRefreshListClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure RefreshList;
procedure DrawLevelPreview(Level: TLevel);
public
function SelectedLevel: string;
end;
41,8 → 40,57
{$R *.dfm}
 
uses
Functions, LevelFunctions, Constants;
Functions, Constants;
 
procedure TLevelChoice.DrawLevelPreview(Level: TLevel);
var
LevelArray: TLevelArray;
y, x: integer;
t: TFieldType;
indent: Integer;
Image: TImage;
BackgroundColor: TColor;
const
PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
begin
Image := PreviewImage;
BackgroundColor := Self.Color;
 
LevelArray := nil;
 
ClearImage(Image, BackgroundColor);
 
LevelArray := Level.LevelStringToLevelArray(false);
 
for y := Low(LevelArray) to High(LevelArray) do
begin
for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
begin
t := LevelArray[y].Fields[x].Typ;
indent := LevelArray[y].Indent;
 
case t of
ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
ftEmpty: Image.Canvas.Brush.Color := clWhite;
ftGreen: Image.Canvas.Brush.Color := clLime;
ftYellow: Image.Canvas.Brush.Color := clYellow;
ftRed: Image.Canvas.Brush.Color := clRed;
end;
 
if LevelArray[y].Fields[x].Goal then
Image.Canvas.Pen.Color := clBlack
else
Image.Canvas.Pen.Color := BackgroundColor;
 
Image.Canvas.Rectangle(x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE,
y*PREVIEW_BLOCK_SIZE,
x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
y*PREVIEW_BLOCK_SIZE + PREVIEW_BLOCK_SIZE);
end;
end;
end;
 
function TLevelChoice.SelectedLevel: string;
begin
result := Format(LVL_FILE, [LevelList.Selected.Caption]);
93,7 → 141,7
LevelFile := Format(LVL_FILE, [LevelList.Selected.Caption]);
Level := TLevel.Create(LevelFile);
try
DrawLevelPreview(Level, PreviewImage, Color);
DrawLevelPreview(Level);
finally
FreeAndNil(Level);
end;
144,30 → 192,6
end;
end;
 
procedure TLevelChoice.FormResize(Sender: TObject);
var
p: integer;
begin
// WIDTH
p := ClientWidth - 3*LevelGrp.Left; // 100% useable
LevelGrp.Width := Round((1-MET_PREVIEW_SIZE_RATIO) * p);
PreviewGrp.Width := Round(MET_PREVIEW_SIZE_RATIO * p);
PreviewGrp.Left := 2*LevelGrp.Left + LevelGrp.Width;
LevelList.Width := LevelGrp.Width - 2*LevelList.Left;
PreviewImage.Width := PreviewGrp.Width - 2*PreviewImage.Left;
PlayBtn.Left := (LevelGrp.Left + LevelGrp.Width) - PlayBtn.Width;
 
// HEIGHT
LevelGrp.Height := ClientHeight - 3*LevelGrp.Top - PlayBtn.Height;
PreviewGrp.Height := LevelGrp.Height;
PlayBtn.Top := 2*LevelGrp.Top + LevelGrp.Height;
CancelBtn.Top := PlayBtn.Top;
LevelList.Height := LevelGrp.Height - 2*LevelList.Top;
PreviewImage.Height := PreviewGrp.Height - 2*PreviewImage.Top;
 
// TODO: Icons rearrangieren
end;
 
procedure TLevelChoice.FormCreate(Sender: TObject);
begin
if not ForceDirectories(ExtractFilePath(Application.ExeName) + LVL_PATH) then
/trunk/Constants.pas
46,22 → 46,9
JNL_ENTRY = '%s' + JNL_SEP + '%s' + JNL_SEP + '%d' + JNL_SEP + '%d' + JNL_SEP + '%d' + JNL_SEP + '%d';
 
resourcestring
LNG_SAVED = 'History successfully saved!';
LNG_STONES_REMOVED = '%d of %d stones removed';
LNG_POINTS = 'Score: %d';
LNG_TIME = 'Time: %s';
LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
LNG_COULD_NOT_CREATE_DIR = 'Warning: Could not create directory "%s".';
LNG_SCORE = 'Score: %d';
LNG_REMAINING = 'Remaining stones: %d (%f%%)';
LNG_TIME_SECONDS = 'Time: %d seconds';
LNG_POINTS_PER_MINUTE = '%d points per minute';
LNG_ENTER_NAME = 'Please enter your name to get added to the high score lists.';
LNG_GOAL_RED = 'Red stone in target field (%d points)';
LNG_GOAL_YELLOW = 'Yellow stone in target field (%d points)';
LNG_GOAL_GREEN = 'Green stone in target field (%d points)';
LNG_GOAL_MISSED = 'No stone in target field (%d points)';
 
implementation
 
/trunk/Finish.pas
4,7 → 4,7
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, MMSystem, Math, ExtCtrls, Registry, Main;
Dialogs, StdCtrls, MMSystem, Math, ExtCtrls, Registry, LevelFunctions;
 
type
TFinishForm = class(TForm)
43,7 → 43,7
implementation
 
uses
History, Constants, LevelFunctions;
History, Constants;
 
{$R *.dfm}
 
53,6 → 53,15
end;
 
function TFinishForm.Execute(LevelName: String; Score, StonesTotal, StonesRemoved, Seconds: Integer; GoalStatus: TGoalStatus; JumpHistory: TStringList): Integer;
resourcestring
LNG_SCORE = 'Score: %d';
LNG_REMAINING = 'Remaining stones: %d (%f%%)';
LNG_TIME_SECONDS = 'Time: %d seconds';
LNG_POINTS_PER_MINUTE = '%d points per minute';
LNG_GOAL_RED = 'Red stone in target field (%d points)';
LNG_GOAL_YELLOW = 'Yellow stone in target field (%d points)';
LNG_GOAL_GREEN = 'Green stone in target field (%d points)';
LNG_GOAL_MISSED = 'No stone in target field (%d points)';
var
ExtraPoints: Integer;
begin
160,6 → 169,8
end;
 
procedure TFinishForm.SaveBtnClick(Sender: TObject);
resourcestring
LNG_ENTER_NAME = 'Please enter your name to get added to the high score lists.';
begin
if NameEdit.Text = '' then
begin
/trunk/Functions.pas
6,18 → 6,14
SysUtils, Dialogs, Graphics, Classes, ExtCtrls;
 
function ExtractFileNameWithoutExt(filename: string): string;
function SecondsToTimeString(Seconds: Integer): string;
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
function Ganzzahlig(num: extended): boolean;
function Explode(Separator, Text: String): TStringList;
function Position(FullString, Search: String): Integer;
function ReadFile(InputFile: string): string;
function DotsAtBeginning(s: string): integer;
function DotsAtEnd(s: string): integer;
 
implementation
 
resourcestring
LNG_COULD_NOT_OPEN_FILE = 'Could not open file "%s".';
 
function ExtractFileNameWithoutExt(filename: string): string;
begin
result := ExtractFileName(filename);
24,32 → 20,6
result := copy(result, 1, Length(result)-Length(ExtractFileExt(result)));
end;
 
function SecondsToTimeString(Seconds: Integer): string;
var
h, m, s: integer;
tim: TDateTime;
begin
h := 0;
m := 0;
s := Seconds;
 
while s - 60*60 >= 0 do
begin
dec(s, 60*60);
inc(h);
end;
 
while s - 60 >= 0 do
begin
dec(s, 60);
inc(m);
end;
 
tim := EncodeTime(h, m, s, 0);
 
result := TimeToStr(tim);
end;
 
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
var
OldPenColor, OldBrushColor: TColor;
63,11 → 33,6
Image.Canvas.Brush.Color := OldBrushColor;
end;
 
function Ganzzahlig(num: extended): boolean;
begin
result := num = round(num);
end;
 
function Explode(Separator, Text: String): TStringList;
var
pos: integer;
105,27 → 70,32
result := Length(FullString) - x + 1;
end;
 
function ReadFile(InputFile: string): string;
function DotsAtBeginning(s: string): integer;
var
f: textfile;
tmp: string;
i: integer;
begin
result := '';
 
if not FileExists(InputFile) then
result := 0;
for i := 1 to Length(s) do
begin
MessageDlg(Format(LNG_COULD_NOT_OPEN_FILE, [InputFile]), mtError, [mbOk], 0);
if s[i] = '.' then
Inc(result)
else
Exit;
end;
end;
 
AssignFile(f, InputFile);
Reset(f);
while not Eof(f) do
function DotsAtEnd(s: string): integer;
var
i: integer;
begin
ReadLn(f, tmp);
result := result + tmp + #13#10;
result := 0;
for i := Length(s) downto 1 do
begin
if s[i] = '.' then
Inc(result)
else
Exit;
end;
CloseFile(f);
end;
 
end.
/trunk/History.pas
32,6 → 32,8
end;
 
procedure THistoryForm.SaveBtnClick(Sender: TObject);
resourcestring
LNG_SAVED = 'History successfully saved!';
begin
if JumpSaveDialog.Execute then
begin
/trunk/LevelFunctions.pas
3,7 → 3,7
interface
 
uses
SysUtils, Dialogs, Functions, ExtCtrls, Graphics, Classes, Math;
SysUtils, Dialogs, Functions, ExtCtrls, Classes, Math;
 
type
TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen);
37,63 → 37,149
function GetGameMode: TGameMode;
end;
 
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
TField = record
FieldType: TFieldType;
Goal: Boolean;
Panel: TPanel;
Stone: TImage;
end;
 
TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
 
TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone);
 
TPlayGroundMatrix = record
Fields: array of array of TField;
public
function MatrixHasGoal: boolean;
function GoalFieldType: TFieldType;
function MatrixWorth: integer;
procedure ClearMatrix(FreeVCL: boolean);
function CloneMatrix: TPlayGroundMatrix;
function FieldState(t: TFieldType): TFieldState; overload;
function FieldState(f: TField): TFieldState; overload;
function FieldState(x, y: integer): TFieldState; overload;
end;
 
function FieldTypeWorth(t: TFieldType): integer;
 
implementation
 
procedure DrawLevelPreview(Level: TLevel; Image: TImage; BackgroundColor: TColor);
var
LevelArray: TLevelArray;
y, x: integer;
t: TFieldType;
indent: Integer;
const
PREVIEW_BLOCK_SIZE = 10; // Enthält Field und Abstand
PREVIEW_TAB_SIZE = PREVIEW_BLOCK_SIZE div 2; // 5
function FieldTypeWorth(t: TFieldType): integer;
begin
LevelArray := nil;
if t = ftGreen then result := 10
else if t = ftYellow then result := 20
else if t = ftRed then result := 30
else result := 0;
end;
 
ClearImage(Image, BackgroundColor);
{ TPlayGroundMatrix }
 
LevelArray := Level.LevelStringToLevelArray(false);
function TPlayGroundMatrix.MatrixHasGoal: boolean;
var
i, j: integer;
begin
result := false;
for i := Low(Fields) to High(Fields) do
begin
for j := Low(Fields[i]) to High(Fields[i]) do
begin
result := result or Fields[i][j].Goal;
end;
end;
end;
 
for y := Low(LevelArray) to High(LevelArray) do
function TPlayGroundMatrix.GoalFieldType: TFieldType;
var
i, j: integer;
begin
for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
result := ftEmpty; // Damit der Compiler nicht meckert
for i := Low(Fields) to High(Fields) do
begin
t := LevelArray[y].Fields[x].Typ;
indent := LevelArray[y].Indent;
for j := Low(Fields[i]) to High(Fields[i]) do
begin
if Fields[i][j].Goal then result := Fields[i][j].FieldType
end;
end;
end;
 
case t of
ftFullSpace: Image.Canvas.Brush.Color := BackgroundColor;
ftEmpty: Image.Canvas.Brush.Color := clWhite;
ftGreen: Image.Canvas.Brush.Color := clLime;
ftYellow: Image.Canvas.Brush.Color := clYellow;
ftRed: Image.Canvas.Brush.Color := clRed;
function TPlayGroundMatrix.MatrixWorth: integer;
var
i, j: integer;
begin
result := 0;
for i := Low(Fields) to High(Fields) do
begin
for j := Low(Fields[i]) to High(Fields[i]) do
begin
Inc(result, FieldTypeWorth(Fields[i][j].FieldType));
end;
end;
end;
 
if LevelArray[y].Fields[x].Goal then
Image.Canvas.Pen.Color := clBlack
else
Image.Canvas.Pen.Color := BackgroundColor;
procedure TPlayGroundMatrix.ClearMatrix(FreeVCL: boolean);
var
i, j: integer;
begin
for i := Low(Fields) to High(Fields) do
begin
for j := Low(Fields[i]) to High(Fields[i]) do
begin
if FreeVCL then
begin
if Assigned(Fields[i][j].Stone) then Fields[i][j].Stone.Free;
if Assigned(Fields[i][j].Panel) then Fields[i][j].Panel.Free;
end;
end;
SetLength(Fields[i], 0);
end;
SetLength(Fields, 0);
end;
 
Image.Canvas.Rectangle(x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE,
y*PREVIEW_BLOCK_SIZE,
x*PREVIEW_BLOCK_SIZE + indent*PREVIEW_TAB_SIZE + PREVIEW_BLOCK_SIZE,
y*PREVIEW_BLOCK_SIZE + PREVIEW_BLOCK_SIZE);
function TPlayGroundMatrix.CloneMatrix: TPlayGroundMatrix;
var
i, j: integer;
begin
SetLength(result.Fields, Length(Fields));
for i := Low(Fields) to High(Fields) do
begin
SetLength(result.Fields[i], Length(Fields[i]));
for j := Low(Fields[i]) to High(Fields[i]) do
begin
result.Fields[i][j].FieldType := Fields[i][j].FieldType;
result.Fields[i][j].Goal := Fields[i][j].Goal;
result.Fields[i][j].Panel := Fields[i][j].Panel;
result.Fields[i][j].Stone := Fields[i][j].Stone;
end;
end;
end;
 
function FieldTypeWorth(t: TFieldType): integer;
function TPlayGroundMatrix.FieldState(t: TFieldType): TFieldState;
begin
if t = ftGreen then result := 10
else if t = ftYellow then result := 20
else if t = ftRed then result := 30
else result := 0;
result := fsError;
case t of
ftFullSpace: result := fsLocked;
ftEmpty: result := fsAvailable;
ftGreen: result := fsStone;
ftYellow: result := fsStone;
ftRed: result := fsStone;
end;
end;
 
function TPlayGroundMatrix.FieldState(f: TField): TFieldState;
begin
result := FieldState(f.FieldType);
end;
 
function TPlayGroundMatrix.FieldState(x, y: integer): TFieldState;
begin
result := fsError;
if (x < Low(Fields)) or (x > High(Fields)) then exit;
if (y < Low(Fields[x])) or (y > High(Fields[x])) then exit;
 
result := FieldState(Fields[x][y]);
end;
 
{ TLevel }
 
const NUM_HEADERS = 2;
137,34 → 223,6
end;
end;
 
function DotsAtBeginning(s: string): integer;
var
i: integer;
begin
result := 0;
for i := 1 to Length(s) do
begin
if s[i] = '.' then
Inc(result)
else
Exit;
end;
end;
 
function DotsAtEnd(s: string): integer;
var
i: integer;
begin
result := 0;
for i := Length(s) downto 1 do
begin
if s[i] = '.' then
Inc(result)
else
Exit;
end;
end;
 
function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray;
var
i: integer;
/trunk/Main.dfm
69,9 → 69,9
OnClick = MRestartGameClick
end
object MPauseTime: TMenuItem
AutoCheck = True
Caption = 'Pause timer'
ShortCut = 16464
OnClick = MPauseTimeClick
end
object N2: TMenuItem
Caption = '-'
107,10 → 107,10
object MSettings: TMenuItem
Caption = 'Settings'
object MEnableSound: TMenuItem
AutoCheck = True
Caption = 'Enable sound'
Checked = True
ShortCut = 32851
OnClick = MEnableSoundClick
end
end
object Help2: TMenuItem
/trunk/Main.pas
7,19 → 7,6
ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
 
type
TField = record
FieldType: TFieldType;
Goal: Boolean;
Panel: TPanel;
Stone: TImage;
end;
 
TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
 
TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone);
 
TPlayGroundMatrix = array of array of TField;
 
TMainForm = class(TForm)
Playground: TPanel;
MainMenu: TMainMenu;
54,10 → 41,8
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 MEnableSoundClick(Sender: TObject);
procedure MUndoClick(Sender: TObject);
procedure Aboutthislevel1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
99,16 → 84,8
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;
function MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
function MatrixWorth(Matrix: TPlayGroundMatrix): integer;
function GoalStatus: TGoalStatus;
function GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
end;
 
var
121,79 → 98,20
 
{$R *.dfm}
 
function TMainForm.MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
var
i, j: integer;
begin
result := false;
for i := Low(Matrix) to High(Matrix) do
begin
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
result := result or Matrix[i][j].Goal;
end;
end;
end;
{ TMainForm }
 
function TMainForm.GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
var
i, j: integer;
begin
result := ftEmpty; // Damit der Compiler nicht meckert
for i := Low(Matrix) to High(Matrix) do
begin
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
if Matrix[i][j].Goal then result := Matrix[i][j].FieldType
end;
end;
end;
 
function TMainForm.MatrixWorth(Matrix: TPlayGroundMatrix): integer;
var
i, j: integer;
begin
result := 0;
for i := Low(Matrix) to High(Matrix) do
begin
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
Inc(result, FieldTypeWorth(Matrix[i][j].FieldType));
end;
end;
end;
 
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;
 
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
var
i, j: integer;
begin
for i := Low(Matrix) to High(Matrix) do
for i := Low(Matrix.Fields) to High(Matrix.Fields) do
begin
for j := Low(Matrix[i]) to High(Matrix[i]) do
for j := Low(Matrix.Fields[i]) to High(Matrix.Fields[i]) do
begin
if Assigned(Matrix[i][j].Stone) then
if Assigned(Matrix.Fields[i][j].Stone) then
begin
LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture);
StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable);
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;
203,6 → 121,7
var
i: Integer;
begin
MPauseTime.Checked := false;
MPauseTime.Enabled := false;
Timer.Enabled := false;
 
222,9 → 141,9
 
JumpHistory.Clear;
 
ClearMatrix(PlayGroundMatrix, true);
PlayGroundMatrix.ClearMatrix(true);
for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
ClearMatrix(PrevPlaygroundMatrixes[i], false);
PrevPlaygroundMatrixes[i].ClearMatrix(false);
SetLength(PrevPlaygroundMatrixes, 0);
MUndo.Enabled := false;
 
259,7 → 178,7
result.OnDragOver := panel.OnDragOver;
result.OnDragDrop := panel.OnDragDrop;
 
StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable);
StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
end;
 
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
301,32 → 220,6
Close;
end;
 
function TMainForm.FieldState(t: TFieldType): TFieldState;
begin
result := fsError;
case t of
ftFullSpace: 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]);
333,6 → 226,8
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;
352,18 → 247,18
begin
if count_points then
begin
CountPoints(PlayGroundMatrix[x, y].FieldType);
CountPoints(PlayGroundMatrix.Fields[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);
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;
 
function TMainForm.CanJump(x, y: integer): boolean;
begin
if FieldState(x, y) <> fsStone then
if PlayGroundMatrix.FieldState(x, y) <> fsStone then
begin
result := false;
exit;
422,9 → 317,9
i, j: integer;
begin
result := false;
for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do
for i := Low(PlayGroundMatrix.Fields) to High(PlayGroundMatrix.Fields) do
begin
for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do
for j := Low(PlayGroundMatrix.Fields[i]) to High(PlayGroundMatrix.Fields[i]) do
begin
if CanJump(i, j) then
begin
437,6 → 332,8
end;
 
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
resourcestring
LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
var
d, s: TPoint;
old_fieldtype: TFieldType;
452,42 → 349,39
{$REGION 'Stein entfernen und Punkte vergeben'}
if Level.GetGameMode = gmDiagonal then
begin
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);
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 (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);
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
if not Timer.Enabled then
begin
MPauseTime.Checked := false;
MPauseTime.Enabled := true;
Timer.Enabled := true;
end;
 
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[s.X, s.Y].FieldType; // Steinfarbe merken
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[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
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 AreJumpsPossible then
begin
MPauseTime.Checked := false;
MPauseTime.Enabled := false;
Timer.Enabled := false;
RefreshTime;
509,7 → 403,7
{$ENDREGION}
 
SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := CloneMatrix(PlaygroundMatrix);
PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
MUndo.Enabled := true;
end;
 
518,21 → 412,21
result := false;
 
// Check 1: Ist das Zielfeld überhaupt leer?
if FieldState(DestX, DestY) <> fsAvailable then exit;
if PlayGroundMatrix.FieldState(DestX, DestY) <> fsAvailable then exit;
 
// Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
if Level.GetGameMode = gmDiagonal then
begin
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;
if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (PlayGroundMatrix.FieldState(SourceX-1, SourceY-1) = fsStone) then result := true;
if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (PlayGroundMatrix.FieldState(SourceX-1, SourceY+1) = fsStone) then result := true;
if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (PlayGroundMatrix.FieldState(SourceX+1, SourceY-1) = fsStone) then result := true;
if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (PlayGroundMatrix.FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
end;
 
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;
if (SourceX+2 = DestX) and (SourceY = DestY) and (PlayGroundMatrix.FieldState(SourceX+1, SourceY ) = fsStone) then result := true;
if (SourceX-2 = DestX) and (SourceY = DestY) and (PlayGroundMatrix.FieldState(SourceX-1, SourceY ) = fsStone) then result := true;
if (SourceX = DestX) and (SourceY+2 = DestY) and (PlayGroundMatrix.FieldState(SourceX , SourceY+1) = fsStone) then result := true;
if (SourceX = DestX) and (SourceY-2 = DestY) and (PlayGroundMatrix.FieldState(SourceX , SourceY-1) = fsStone) then result := true;
end;
 
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
570,37 → 464,19
newField.Goal := t.Goal;
newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
newField.Stone := DrawStone(t.Typ, newField.Panel);
if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
if PlayGroundMatrix.FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
 
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;
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;
 
function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
var
i, j: integer;
begin
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.BuildPlayground(LevelArray: TLevelArray);
var
y, x: integer;
644,12 → 520,13
Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
 
SetLength(PrevPlaygroundMatrixes,1);
PrevPlaygroundMatrixes[0] := CloneMatrix(PlayGroundMatrix);
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;
656,14 → 533,22
 
function TMainForm.LevelTime: String;
begin
result := SecondsToTimeString(CountedSeconds);
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);
723,13 → 608,13
var
ft: TFieldType;
begin
if not MatrixHasGoal(PlaygroundMatrix) then
if not PlaygroundMatrix.MatrixHasGoal then
result := gsNoGoal
else if LevelRemovedStones < LevelTotalStones-1 then
Result := gsMultipleStonesRemaining
else
begin
ft := GoalFieldType(PlaygroundMatrix);
ft := PlaygroundMatrix.GoalFieldType;
if ft = ftRed then
result := gsLastStoneInGoalRed
else if ft = ftYellow then
763,11 → 648,10
var
i: Integer;
begin
MPauseTime.Enabled := false;
Timer.Enabled := false;
MPauseTime.Checked := true;
MPauseTime.Enabled := true;
Timer.Enabled := true;
 
MRestartGame.Enabled := false;
 
CountedSeconds := 0;
RefreshTime;
 
782,7 → 666,7
RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
ClearMatrix(PrevPlaygroundMatrixes[i], false);
PrevPlaygroundMatrixes[i].ClearMatrix(false);
SetLength(PrevPlaygroundMatrixes, 1);
 
MUndo.Enabled := false;
790,8 → 674,8
 
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
begin
ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
PlayGroundMatrix := CloneMatrix(Matrix);
PlayGroundMatrix.ClearMatrix(false); // Memory Leak verhindern
PlayGroundMatrix := Matrix.CloneMatrix;
end;
 
procedure TMainForm.MRestartGameClick(Sender: TObject);
806,12 → 690,12
begin
if Length(PrevPlaygroundMatrixes) > 1 then
begin
PrevWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
PrevWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
 
ClearMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1], false);
PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].ClearMatrix(false);
SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
 
NewWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
NewWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
 
835,12 → 719,6
HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
end;
 
procedure TMainForm.MPauseTimeClick(Sender: TObject);
begin
MPauseTime.Enabled := false;
Timer.Enabled := false;
end;
 
procedure TMainForm.LoadSettings;
var
reg: TRegistry;
876,7 → 754,6
end;
end;
 
 
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SaveSettings;
898,9 → 775,4
HelpForm.ShowModal;
end;
 
procedure TMainForm.MEnableSoundClick(Sender: TObject);
begin
MEnableSound.Checked := not MEnableSound.Checked;
end;
 
end.