Subversion Repositories jumper

Rev

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