Subversion Repositories jumper

Rev

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