Subversion Repositories jumper

Rev

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