Subversion Repositories jumper

Rev

Rev 22 | Rev 24 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1
unit Main;
2
 
3
interface
4
 
5
uses
6
  Windows, SysUtils, Classes, Graphics, Dialogs, StdCtrls, Menus, Controls,
7
  ComCtrls, ExtCtrls, Forms, MMSystem, LevelFunctions, Registry;
8
 
9
type
10
  TMainForm = class(TForm)
11
    Playground: TPanel;
12
    MainMenu: TMainMenu;
13
    Help1: TMenuItem;
14
    MExit: TMenuItem;
15
    Statistics: TStatusBar;
16
    Timer: TTimer;
17
    MNewGame: TMenuItem;
18
    Help2: TMenuItem;
19
    MAbout: TMenuItem;
20
    MHelp: TMenuItem;
21
    N5: TMenuItem;
22
    MJumpHistory: TMenuItem;
23
    N2: TMenuItem;
24
    N4: TMenuItem;
25
    MHighScores: TMenuItem;
26
    MRestartGame: TMenuItem;
27
    MSettings: TMenuItem;
28
    MEnableSound: TMenuItem;
29
    MPauseTime: TMenuItem;
30
    N1: TMenuItem;
31
    MUndo: TMenuItem;
32
    N3: TMenuItem;
14 daniel-mar 33
    Aboutthislevel1: TMenuItem;
1 daniel-mar 34
    procedure MExitClick(Sender: TObject);
35
    procedure TimerTimer(Sender: TObject);
36
    procedure MNewGameClick(Sender: TObject);
37
    procedure MAboutClick(Sender: TObject);
38
    procedure FormShow(Sender: TObject);
39
    procedure FormCreate(Sender: TObject);
40
    procedure FormDestroy(Sender: TObject);
41
    procedure MJumpHistoryClick(Sender: TObject);
42
    procedure MRestartGameClick(Sender: TObject);
43
    procedure MHighScoresClick(Sender: TObject);
44
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
45
    procedure MHelpClick(Sender: TObject);
6 daniel-mar 46
    procedure MUndoClick(Sender: TObject);
14 daniel-mar 47
    procedure Aboutthislevel1Click(Sender: TObject);
48
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1 daniel-mar 49
  private
18 daniel-mar 50
    NoCloseQuery: boolean;
1 daniel-mar 51
    CountedSeconds: Integer;
52
    LevelFile: String;
6 daniel-mar 53
    PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
1 daniel-mar 54
    PlaygroundMatrix: TPlayGroundMatrix;
55
    Points: Integer;
56
    LevelTotalStones: Integer;
57
    LevelRemovedStones: Integer;
58
    JumpHistory: TStringList;
11 daniel-mar 59
    Level: TLevel;
1 daniel-mar 60
    procedure LoadSettings;
61
    procedure SaveSettings;
62
    procedure RestartLevel;
63
    procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
64
    procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
65
    function AskForLevel: String;
66
    procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
67
    procedure NewGame(Filename: string);
68
    function LevelTime: String;
69
    procedure DestroyLevel;
70
    procedure RefreshTime;
71
    procedure RefreshPoints;
72
    procedure RefreshStonesRemoved;
73
    procedure RemoveStone(x, y: integer; count_points: boolean);
74
    procedure DoJump(SourceTag, DestTag: integer);
75
    function MayJump(SourceTag, DestTag: integer): boolean; overload;
19 daniel-mar 76
    procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
1 daniel-mar 77
    procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
19 daniel-mar 78
    function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
1 daniel-mar 79
    function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
80
    function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
81
    procedure BuildPlayground(LevelArray: TLevelArray);
82
    procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
8 daniel-mar 83
    function GoalStatus: TGoalStatus;
1 daniel-mar 84
  end;
85
 
86
var
87
  MainForm: TMainForm;
88
 
89
implementation
90
 
91
uses
19 daniel-mar 92
  About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
1 daniel-mar 93
 
94
{$R *.dfm}
95
 
21 daniel-mar 96
{ TMainForm }
8 daniel-mar 97
 
1 daniel-mar 98
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
99
var
23 daniel-mar 100
  x, y: integer;
1 daniel-mar 101
begin
23 daniel-mar 102
  for x := Low(Matrix.Fields) to High(Matrix.Fields) do
1 daniel-mar 103
  begin
23 daniel-mar 104
    for y := Low(Matrix.Fields[x]) to High(Matrix.Fields[x]) do
1 daniel-mar 105
    begin
23 daniel-mar 106
      if Assigned(Matrix.Fields[x][y].Stone) then
1 daniel-mar 107
      begin
23 daniel-mar 108
        LoadPictureForType(Matrix.Fields[x][y].FieldType, Matrix.Fields[x][y].Stone.Picture);
109
        StoneDraggingAllow(Matrix.Fields[x][y].Stone, Matrix.FieldState(Matrix.Fields[x][y].FieldType) <> fsAvailable);
1 daniel-mar 110
      end;
111
    end;
112
  end;
113
end;
114
 
115
procedure TMainForm.DestroyLevel;
6 daniel-mar 116
var
117
  i: Integer;
1 daniel-mar 118
begin
21 daniel-mar 119
  MPauseTime.Checked := false;
1 daniel-mar 120
  MPauseTime.Enabled := false;
121
  Timer.Enabled := false;
122
 
123
  MRestartGame.Enabled := false;
124
 
125
  LevelFile := '';
126
 
127
  CountedSeconds := 0;
128
  RefreshTime;
129
 
130
  Points := 0;
131
  RefreshPoints;
132
 
133
  LevelRemovedStones := 0;
134
  LevelTotalStones := 0;
135
  RefreshStonesRemoved;
136
 
137
  JumpHistory.Clear;
138
 
21 daniel-mar 139
  PlayGroundMatrix.ClearMatrix(true);
6 daniel-mar 140
  for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
21 daniel-mar 141
    PrevPlaygroundMatrixes[i].ClearMatrix(false);
6 daniel-mar 142
  SetLength(PrevPlaygroundMatrixes, 0);
143
  MUndo.Enabled := false;
1 daniel-mar 144
 
11 daniel-mar 145
  if Assigned(Level) then FreeAndNil(Level);
1 daniel-mar 146
end;
147
 
148
procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
149
begin
150
  case FieldType of
151
    ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
152
    ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
153
    ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
154
    ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
155
  end;
156
end;
157
 
158
function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
159
begin
160
  result := TImage.Create(panel);
161
  result.Parent := panel;
162
  LoadPictureForType(fieldtype, result.Picture);
163
  result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
164
  result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
165
  result.Left := MET_SHAPE_MARGIN;
166
  result.Top := MET_SHAPE_MARGIN;
167
  result.Center := true;
168
  result.Transparent := true;
169
 
170
  result.Tag := panel.Tag;
171
  result.OnDragOver := panel.OnDragOver;
172
  result.OnDragDrop := panel.OnDragDrop;
173
 
21 daniel-mar 174
  StoneDraggingAllow(result, PlayGroundMatrix.FieldState(fieldtype) <> fsAvailable);
1 daniel-mar 175
end;
176
 
177
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
178
begin
179
  if Allow then
180
  begin
181
    Stone.DragMode := dmAutomatic;
182
    (Stone.Parent as TPanel).DragMode := dmAutomatic;
183
  end
184
  else
185
  begin
186
    Stone.DragMode := dmManual;
187
    (Stone.Parent as TPanel).DragMode := dmManual;
188
  end;
189
end;
190
 
191
function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
192
begin
193
  result := TPanel.Create(Playground);
194
  result.Parent := Playground;
195
  if isGoal then
196
  begin
197
    result.BevelInner := bvLowered;
198
  end;
199
  result.Color := Playground.Color;
200
  result.BevelOuter := bvLowered;
201
  result.Width := MET_FIELD_SIZE;
202
  result.Height := MET_FIELD_SIZE;
19 daniel-mar 203
  result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);
1 daniel-mar 204
  result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
205
 
206
  result.Tag := tag;
207
  result.OnDragOver := StoneDragOver;
208
  result.OnDragDrop := StoneDragDrop;
209
end;
210
 
211
procedure TMainForm.MExitClick(Sender: TObject);
212
begin
213
  Close;
214
end;
215
 
216
procedure TMainForm.RefreshTime;
217
begin
218
  Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
219
end;
220
 
221
procedure TMainForm.RefreshStonesRemoved;
21 daniel-mar 222
resourcestring
223
  LNG_STONES_REMOVED = '%d of %d stones removed';
1 daniel-mar 224
begin
12 daniel-mar 225
  Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
1 daniel-mar 226
end;
227
 
228
procedure TMainForm.RefreshPoints;
229
begin
230
  Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
231
end;
232
 
233
procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
234
begin
235
  if count_points then
236
  begin
22 daniel-mar 237
    Inc(Points, FieldTypeWorth(PlayGroundMatrix.Fields[x, y].FieldType));
238
    RefreshPoints;
239
 
1 daniel-mar 240
    Inc(LevelRemovedStones);
241
    RefreshStonesRemoved;
242
  end;
23 daniel-mar 243
 
21 daniel-mar 244
  PlayGroundMatrix.Fields[x, y].FieldType := ftEmpty;
245
  LoadPictureForType(PlayGroundMatrix.Fields[x, y].FieldType, PlayGroundMatrix.Fields[x, y].Stone.Picture);
246
  StoneDraggingAllow(PlayGroundMatrix.Fields[x, y].Stone, false);
1 daniel-mar 247
end;
248
 
14 daniel-mar 249
procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
250
var
251
  mode: string;
252
  goalYeSNo: string;
253
resourcestring
254
  LNG_BOARD = 'Board: %s';
255
  LNG_MODE = 'Mode: %s';
256
  LNG_STONES_TOTAL = 'Stones: %d';
257
  LNG_GOAL_AVAILABLE = 'Target field defined';
258
  LNG_NO_GOAL = 'No target field';
259
begin
22 daniel-mar 260
  case Level.GameMode of
261
    gmNormal:    mode := 'Diagonal';
262
    gmDiagonal:  mode := 'Normal';
263
    gmUndefined: mode := '?';
264
  end;
14 daniel-mar 265
 
266
  if GoalStatus = gsNoGoal then
267
    goalYeSNo := LNG_NO_GOAL
268
  else
269
    goalYeSNo := LNG_GOAL_AVAILABLE;
270
 
271
  ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
272
              #13#10 +
273
              Format(LNG_MODE, [mode]) + #13#10 +
274
              Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
275
              goalYesNo);
276
end;
277
 
1 daniel-mar 278
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
21 daniel-mar 279
resourcestring
280
  LNG_JUMP_LOG = '%d [%d, %d] -> %d [%d, %d];';
1 daniel-mar 281
var
23 daniel-mar 282
  d, s: TCoord;
1 daniel-mar 283
  old_fieldtype: TFieldType;
284
  res: Integer;
285
begin
286
  if not MayJump(SourceTag, DestTag) then exit;
287
 
23 daniel-mar 288
  s := PlaygroundMatrix.IndexToCoord(SourceTag);
289
  d := PlaygroundMatrix.IndexToCoord(DestTag);
1 daniel-mar 290
 
291
  JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
292
 
6 daniel-mar 293
  {$REGION 'Stein entfernen und Punkte vergeben'}
22 daniel-mar 294
  if Level.GameMode = gmDiagonal then
1 daniel-mar 295
  begin
21 daniel-mar 296
    if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y-1) = fsStone) then RemoveStone(s.X-1, s.Y-1, true);
297
    if (s.X-2 = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y+1) = fsStone) then RemoveStone(s.X-1, s.Y+1, true);
298
    if (s.X+2 = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y-1) = fsStone) then RemoveStone(s.X+1, s.Y-1, true);
299
    if (s.X+2 = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y+1) = fsStone) then RemoveStone(s.X+1, s.Y+1, true);
1 daniel-mar 300
  end;
301
 
21 daniel-mar 302
  if (s.X+2 = d.X) and (s.Y = d.Y) and (PlayGroundMatrix.FieldState(s.X+1, s.Y  ) = fsStone) then RemoveStone(s.X+1, s.Y, true);
303
  if (s.X-2 = d.X) and (s.Y = d.Y) and (PlayGroundMatrix.FieldState(s.X-1, s.Y  ) = fsStone) then RemoveStone(s.X-1, s.Y, true);
304
  if (s.X = d.X) and (s.Y+2 = d.Y) and (PlayGroundMatrix.FieldState(s.X  , s.Y+1) = fsStone) then RemoveStone(s.X, s.Y+1, true);
305
  if (s.X = d.X) and (s.Y-2 = d.Y) and (PlayGroundMatrix.FieldState(s.X  , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true);
6 daniel-mar 306
  {$ENDREGION}
1 daniel-mar 307
 
308
  // Den Timer erst nach dem ersten Zug starten
309
  // oder nach einer Pause neustarten
21 daniel-mar 310
  MPauseTime.Checked := false;
311
  MPauseTime.Enabled := true;
312
  Timer.Enabled := true;
1 daniel-mar 313
 
314
  // Sound abspielen
315
  if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
316
 
6 daniel-mar 317
  {$REGION 'Nun den Stein springen lassen'}
21 daniel-mar 318
  old_fieldtype := PlayGroundMatrix.Fields[s.X, s.Y].FieldType; // Steinfarbe merken
6 daniel-mar 319
  RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
21 daniel-mar 320
  PlayGroundMatrix.Fields[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
321
  LoadPictureForType(PlayGroundMatrix.Fields[d.X, d.Y].FieldType, PlayGroundMatrix.Fields[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
322
  StoneDraggingAllow(PlayGroundMatrix.Fields[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
6 daniel-mar 323
  {$ENDREGION}
1 daniel-mar 324
 
6 daniel-mar 325
  {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
22 daniel-mar 326
  if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
1 daniel-mar 327
  begin
21 daniel-mar 328
    MPauseTime.Checked := false;
1 daniel-mar 329
    MPauseTime.Enabled := false;
330
    Timer.Enabled := false;
331
    RefreshTime;
4 daniel-mar 332
    if MEnableSound.Checked then
333
    begin
8 daniel-mar 334
      if LevelRemovedStones = LevelTotalStones-1 then
335
      begin
336
        if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
337
          PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
338
        else
339
          PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
340
      end
4 daniel-mar 341
      else
342
        PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
343
    end;
8 daniel-mar 344
    res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
1 daniel-mar 345
    if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
346
  end;
6 daniel-mar 347
  {$ENDREGION}
348
 
349
  SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
21 daniel-mar 350
  PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := PlaygroundMatrix.CloneMatrix;
6 daniel-mar 351
  MUndo.Enabled := true;
1 daniel-mar 352
end;
353
 
354
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
355
var
23 daniel-mar 356
  s, d: TCoord;
1 daniel-mar 357
begin
23 daniel-mar 358
  s := PlayGroundMatrix.IndexToCoord(SourceTag);
359
  d := PlayGroundMatrix.IndexToCoord(DestTag);
1 daniel-mar 360
 
22 daniel-mar 361
  result := PlaygroundMatrix.CanJump(s.X, s.Y, d.X, d.Y, Level.GameMode = gmDiagonal);
1 daniel-mar 362
end;
363
 
364
procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
365
begin
366
  DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
367
end;
368
 
369
procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
370
  Y: Integer; State: TDragState; var Accept: Boolean);
371
begin
372
  Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
373
end;
374
 
19 daniel-mar 375
function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
1 daniel-mar 376
var
377
  newField: TField;
378
  index: integer;
379
begin
19 daniel-mar 380
  ZeroMemory(@result, SizeOf(result));
381
  if t.Typ = ftFullSpace then exit;
1 daniel-mar 382
 
23 daniel-mar 383
  index := PlaygroundMatrix.CoordToIndex(x, y);
1 daniel-mar 384
 
385
  newField.FieldType := t.Typ;
386
  newField.Goal := t.Goal;
19 daniel-mar 387
  newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
1 daniel-mar 388
  newField.Stone := DrawStone(t.Typ, newField.Panel);
389
 
19 daniel-mar 390
  result := newField;
1 daniel-mar 391
end;
392
 
393
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
394
var
19 daniel-mar 395
  y, x: integer;
396
  max_x, max_y: integer;
397
  p: TPanel;
23 daniel-mar 398
  newField: TField;
1 daniel-mar 399
begin
400
  PlayGround.Visible := false;
401
 
23 daniel-mar 402
  // Attention: PlaygroundMatrix is indexed [x,y] while LevelArray is indexed [y,x]
403
  // TODO: PlaygroundMatrix and LevelArray are redundant. Can't we just replace one with the other?
404
  PlaygroundMatrix.InitFieldArray(Length(LevelArray[0].Fields), Length(LevelArray));
405
 
1 daniel-mar 406
  max_x := 0;
19 daniel-mar 407
  max_y := 0;
408
  for y := Low(LevelArray) to High(LevelArray) do
1 daniel-mar 409
  begin
19 daniel-mar 410
    for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
1 daniel-mar 411
    begin
23 daniel-mar 412
      if TPlayGroundMatrix.FieldState(LevelArray[y].Fields[x].Typ) = fsStone then
413
        Inc(LevelTotalStones);
414
      newField := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent);
415
      PlaygroundMatrix.Fields[x, y] := newField;
416
      p := newField.Panel;
19 daniel-mar 417
      if Assigned(p) then
418
      begin
419
        max_x := Max(max_x, p.Left + p.Width);
420
        max_y := Max(max_y, p.Top  + p.Height);
421
      end;
1 daniel-mar 422
    end;
423
  end;
424
 
425
  PlayGround.Visible := true;
426
 
427
  // Das Form an das Level anpassen
19 daniel-mar 428
  PlayGround.Top    := MET_OUTER_MARGIN;
429
  PlayGround.Left   := MET_OUTER_MARGIN;
430
  PlayGround.Width  := max_x;
431
  PlayGround.Height := max_y;
432
  ClientWidth       := 2 * MET_OUTER_MARGIN + PlayGround.Width;
433
  ClientHeight      := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
1 daniel-mar 434
 
19 daniel-mar 435
  // If the board is too small, ClientWidth/ClientHeight will stop at a minimum value
436
  // in this case, we make sure that the Playground is centered
437
  PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;
438
  PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;
439
 
1 daniel-mar 440
  Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
441
  Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
442
 
6 daniel-mar 443
  SetLength(PrevPlaygroundMatrixes,1);
21 daniel-mar 444
  PrevPlaygroundMatrixes[0] := PlayGroundMatrix.CloneMatrix;
6 daniel-mar 445
  MUndo.Enabled := false;
1 daniel-mar 446
end;
447
 
448
procedure TMainForm.TimerTimer(Sender: TObject);
449
begin
21 daniel-mar 450
  if MPauseTime.Checked then exit;
1 daniel-mar 451
  if mainform.Focused then Inc(CountedSeconds);
452
  RefreshTime;
453
end;
454
 
455
function TMainForm.LevelTime: String;
456
begin
21 daniel-mar 457
  result := FormatDateTime('hh:nn:ss', CountedSeconds / SecsPerDay)
1 daniel-mar 458
end;
459
 
460
procedure TMainForm.NewGame(Filename: string);
21 daniel-mar 461
resourcestring
462
  LNG_LVL_INVALID_NO_JUMP = 'Warning! The level is not playable. There are no jumps possible.';
1 daniel-mar 463
var
464
  LevelArray: TLevelArray;
11 daniel-mar 465
begin
1 daniel-mar 466
  DestroyLevel;
21 daniel-mar 467
 
468
  MPauseTime.Checked := true;
469
  MPauseTime.Enabled := true;
470
  Timer.Enabled := true;
471
  MRestartGame.Enabled := true;
472
 
1 daniel-mar 473
  LevelFile := Filename;
11 daniel-mar 474
  Level := TLevel.Create(LevelFile);
475
  LevelArray := Level.LevelStringToLevelArray(true);
1 daniel-mar 476
  if Length(LevelArray) = 0 then Exit;
477
  BuildPlayground(LevelArray);
22 daniel-mar 478
  if not PlayGroundMatrix.CanJump(Level.GameMode = gmDiagonal) then
1 daniel-mar 479
  begin
9 daniel-mar 480
    MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
1 daniel-mar 481
  end;
482
  RefreshTime;
483
  RefreshStonesRemoved;
484
  RefreshPoints;
485
end;
486
 
487
procedure TMainForm.MNewGameClick(Sender: TObject);
488
begin
489
  LevelFile := AskForLevel;
490
  if LevelFile <> '' then
491
  begin
492
    NewGame(LevelFile);
493
  end;
494
end;
495
 
496
procedure TMainForm.MAboutClick(Sender: TObject);
497
begin
498
  AboutBox.ShowModal;
499
end;
500
 
501
function TMainForm.AskForLevel: String;
502
begin
503
  LevelChoice.ShowModal;
504
 
505
  if LevelChoice.ModalResult <> mrOK then
506
  begin
507
    result := '';
508
    exit;
509
  end;
510
 
511
  result := LevelChoice.SelectedLevel;
512
end;
513
 
514
procedure TMainForm.FormShow(Sender: TObject);
515
begin
516
  LevelFile := AskForLevel;
517
  if LevelFile <> '' then
518
  begin
519
    NewGame(LevelFile);
520
  end
18 daniel-mar 521
  else
522
  begin
523
    NoCloseQuery := true;
524
    Close;
525
  end;
1 daniel-mar 526
end;
527
 
8 daniel-mar 528
function TMainForm.GoalStatus: TGoalStatus;
529
var
530
  ft: TFieldType;
531
begin
21 daniel-mar 532
  if not PlaygroundMatrix.MatrixHasGoal then
8 daniel-mar 533
    result := gsNoGoal
534
  else if LevelRemovedStones < LevelTotalStones-1 then
535
    Result := gsMultipleStonesRemaining
536
  else
537
  begin
21 daniel-mar 538
    ft := PlaygroundMatrix.GoalFieldType;
8 daniel-mar 539
    if ft = ftRed then
540
      result := gsLastStoneInGoalRed
541
    else if ft = ftYellow then
542
      result := gsLastStoneInGoalYellow
543
    else if ft = ftGreen then
19 daniel-mar 544
      result := gsLastStoneInGoalGreen
545
    else
546
      result := gsUndefined;
8 daniel-mar 547
  end;
548
end;
549
 
1 daniel-mar 550
procedure TMainForm.FormCreate(Sender: TObject);
551
begin
552
  JumpHistory := TStringList.Create;
553
  LoadSettings;
554
end;
555
 
556
procedure TMainForm.FormDestroy(Sender: TObject);
557
begin
11 daniel-mar 558
  DestroyLevel;
1 daniel-mar 559
  JumpHistory.Free;
560
end;
561
 
562
procedure TMainForm.MJumpHistoryClick(Sender: TObject);
563
begin
564
  HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
565
  HistoryForm.ShowModal;
566
end;
567
 
568
procedure TMainForm.RestartLevel;
10 daniel-mar 569
var
570
  i: Integer;
1 daniel-mar 571
begin
21 daniel-mar 572
  MPauseTime.Checked := true;
573
  MPauseTime.Enabled := true;
574
  Timer.Enabled := true;
1 daniel-mar 575
 
576
  CountedSeconds := 0;
577
  RefreshTime;
578
 
579
  Points := 0;
580
  RefreshPoints;
581
 
582
  LevelRemovedStones := 0;
583
  RefreshStonesRemoved;
584
 
585
  JumpHistory.Clear;
586
 
10 daniel-mar 587
  RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
588
  SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
589
  for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
21 daniel-mar 590
    PrevPlaygroundMatrixes[i].ClearMatrix(false);
10 daniel-mar 591
  SetLength(PrevPlaygroundMatrixes, 1);
592
 
6 daniel-mar 593
  MUndo.Enabled := false;
1 daniel-mar 594
end;
595
 
596
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
597
begin
21 daniel-mar 598
  PlayGroundMatrix.ClearMatrix(false); // Memory Leak verhindern
599
  PlayGroundMatrix := Matrix.CloneMatrix;
1 daniel-mar 600
end;
601
 
602
procedure TMainForm.MRestartGameClick(Sender: TObject);
603
begin
604
  RestartLevel;
605
end;
606
 
6 daniel-mar 607
procedure TMainForm.MUndoClick(Sender: TObject);
608
var
609
  PrevWorth: integer;
610
  NewWorth: integer;
611
begin
612
  if Length(PrevPlaygroundMatrixes) > 1 then
613
  begin
21 daniel-mar 614
    PrevWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
6 daniel-mar 615
 
21 daniel-mar 616
    PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].ClearMatrix(false);
6 daniel-mar 617
    SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
618
 
21 daniel-mar 619
    NewWorth := PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1].MatrixWorth;
6 daniel-mar 620
    RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
621
    SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
622
 
623
    JumpHistory.Delete(JumpHistory.Count-1);
624
 
625
    Dec(LevelRemovedStones);
626
    RefreshStonesRemoved;
627
 
628
    Dec(Points, NewWorth-PrevWorth);
629
    RefreshPoints;
7 daniel-mar 630
 
631
    // Sound abspielen
632
    if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
6 daniel-mar 633
  end;
634
 
635
  MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
636
end;
637
 
1 daniel-mar 638
procedure TMainForm.MHighScoresClick(Sender: TObject);
639
begin
640
  HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
641
end;
642
 
643
procedure TMainForm.LoadSettings;
644
var
645
  reg: TRegistry;
646
begin
647
  reg := TRegistry.Create;
648
  try
649
    reg.RootKey := HKEY_CURRENT_USER;
650
    if reg.OpenKeyReadOnly(REG_KEY) then
651
    begin
652
      if reg.ValueExists(REG_SOUND) then
653
        MEnableSound.Checked := reg.ReadBool(REG_SOUND);
654
      reg.CloseKey;
655
    end;
656
  finally
657
    reg.Free;
658
  end;
659
end;
660
 
661
procedure TMainForm.SaveSettings;
662
var
663
  reg: TRegistry;
664
begin
665
  reg := TRegistry.Create;
666
  try
667
    reg.RootKey := HKEY_CURRENT_USER;
668
    if reg.OpenKey(REG_KEY, true) then
669
    begin
670
      reg.WriteBool(REG_SOUND, MEnableSound.Checked);
671
      reg.CloseKey;
672
    end;
673
  finally
674
    reg.Free;
675
  end;
676
end;
677
 
678
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
679
begin
680
  SaveSettings;
681
  if FinishForm.NameEdit.Text <> '' then
682
  begin
683
    FinishForm.SaveSettings;
684
  end;
685
end;
686
 
14 daniel-mar 687
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
688
resourcestring
689
  LNG_REALLY_QUIT = 'Do you really want to quit?';
690
begin
18 daniel-mar 691
  CanClose := NoCloseQuery or (MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes);
14 daniel-mar 692
end;
693
 
1 daniel-mar 694
procedure TMainForm.MHelpClick(Sender: TObject);
695
begin
696
  HelpForm.ShowModal;
697
end;
698
 
699
end.