Subversion Repositories jumper

Rev

Rev 18 | Rev 21 | 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
  TField = record
11
    FieldType: TFieldType;
12
    Goal: Boolean;
13
    Panel: TPanel;
14
    Stone: TImage;
15
  end;
16
 
19 daniel-mar 17
  TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
8 daniel-mar 18
 
19 daniel-mar 19
  TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone);
1 daniel-mar 20
 
21
  TPlayGroundMatrix = array of array of TField;
22
 
23
  TMainForm = class(TForm)
24
    Playground: TPanel;
25
    MainMenu: TMainMenu;
26
    Help1: TMenuItem;
27
    MExit: TMenuItem;
28
    Statistics: TStatusBar;
29
    Timer: TTimer;
30
    MNewGame: TMenuItem;
31
    Help2: TMenuItem;
32
    MAbout: TMenuItem;
33
    MHelp: TMenuItem;
34
    N5: TMenuItem;
35
    MJumpHistory: TMenuItem;
36
    N2: TMenuItem;
37
    N4: TMenuItem;
38
    MHighScores: TMenuItem;
39
    MRestartGame: TMenuItem;
40
    MSettings: TMenuItem;
41
    MEnableSound: TMenuItem;
42
    MPauseTime: TMenuItem;
43
    N1: TMenuItem;
44
    MUndo: TMenuItem;
45
    N3: TMenuItem;
14 daniel-mar 46
    Aboutthislevel1: TMenuItem;
1 daniel-mar 47
    procedure MExitClick(Sender: TObject);
48
    procedure TimerTimer(Sender: TObject);
49
    procedure MNewGameClick(Sender: TObject);
50
    procedure MAboutClick(Sender: TObject);
51
    procedure FormShow(Sender: TObject);
52
    procedure FormCreate(Sender: TObject);
53
    procedure FormDestroy(Sender: TObject);
54
    procedure MJumpHistoryClick(Sender: TObject);
55
    procedure MRestartGameClick(Sender: TObject);
56
    procedure MHighScoresClick(Sender: TObject);
57
    procedure MPauseTimeClick(Sender: TObject);
58
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
59
    procedure MHelpClick(Sender: TObject);
60
    procedure MEnableSoundClick(Sender: TObject);
6 daniel-mar 61
    procedure MUndoClick(Sender: TObject);
14 daniel-mar 62
    procedure Aboutthislevel1Click(Sender: TObject);
63
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1 daniel-mar 64
  private
18 daniel-mar 65
    NoCloseQuery: boolean;
1 daniel-mar 66
    CountedSeconds: Integer;
67
    LevelFile: String;
68
    LookupFieldCoordinateArray: array of TPoint;
6 daniel-mar 69
    PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
1 daniel-mar 70
    PlaygroundMatrix: TPlayGroundMatrix;
71
    Points: Integer;
72
    LevelTotalStones: Integer;
73
    LevelRemovedStones: Integer;
74
    JumpHistory: TStringList;
11 daniel-mar 75
    Level: TLevel;
1 daniel-mar 76
    procedure LoadSettings;
77
    procedure SaveSettings;
78
    procedure RestartLevel;
79
    procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
80
    procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
81
    function AskForLevel: String;
82
    function AreJumpsPossible: boolean;
83
    procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
84
    procedure NewGame(Filename: string);
85
    function LevelTime: String;
86
    procedure DestroyLevel;
87
    procedure RefreshTime;
88
    procedure RefreshPoints;
89
    procedure RefreshStonesRemoved;
90
    procedure CountPoints(t: TFieldType);
91
    procedure RemoveStone(x, y: integer; count_points: boolean);
92
    procedure DoJump(SourceTag, DestTag: integer);
93
    function CanJump(x, y: integer): boolean;
94
    function MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; overload;
95
    function MayJump(SourceTag, DestTag: integer): boolean; overload;
19 daniel-mar 96
    procedure StoneDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
1 daniel-mar 97
    procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
19 daniel-mar 98
    function DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
1 daniel-mar 99
    function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
100
    function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
101
    procedure BuildPlayground(LevelArray: TLevelArray);
102
    function FieldState(t: TFieldType): TFieldState; overload;
103
    function FieldState(f: TField): TFieldState; overload;
104
    function FieldState(x, y: integer): TFieldState; overload;
105
    procedure ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
106
    function CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
8 daniel-mar 107
    function MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
1 daniel-mar 108
    procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
6 daniel-mar 109
    function MatrixWorth(Matrix: TPlayGroundMatrix): integer;
8 daniel-mar 110
    function GoalStatus: TGoalStatus;
111
    function GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
1 daniel-mar 112
  end;
113
 
114
var
115
  MainForm: TMainForm;
116
 
117
implementation
118
 
119
uses
19 daniel-mar 120
  About, Finish, Choice, Functions, History, HighScore, Help, Constants, Math;
1 daniel-mar 121
 
122
{$R *.dfm}
123
 
8 daniel-mar 124
function TMainForm.MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
125
var
126
  i, j: integer;
127
begin
128
  result := false;
129
  for i := Low(Matrix) to High(Matrix) do
130
  begin
131
    for j := Low(Matrix[i]) to High(Matrix[i]) do
132
    begin
133
      result := result or Matrix[i][j].Goal;
134
    end;
135
  end;
136
end;
137
 
138
function TMainForm.GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
139
var
140
  i, j: integer;
141
begin
19 daniel-mar 142
  result := ftEmpty; // Damit der Compiler nicht meckert
8 daniel-mar 143
  for i := Low(Matrix) to High(Matrix) do
144
  begin
145
    for j := Low(Matrix[i]) to High(Matrix[i]) do
146
    begin
147
      if Matrix[i][j].Goal then result := Matrix[i][j].FieldType
148
    end;
149
  end;
150
end;
151
 
6 daniel-mar 152
function TMainForm.MatrixWorth(Matrix: TPlayGroundMatrix): integer;
153
var
154
  i, j: integer;
155
begin
156
  result := 0;
157
  for i := Low(Matrix) to High(Matrix) do
158
  begin
159
    for j := Low(Matrix[i]) to High(Matrix[i]) do
160
    begin
161
      Inc(result, FieldTypeWorth(Matrix[i][j].FieldType));
162
    end;
163
  end;
164
end;
165
 
1 daniel-mar 166
procedure TMainForm.ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
167
var
168
  i, j: integer;
169
begin
170
  for i := Low(Matrix) to High(Matrix) do
171
  begin
172
    for j := Low(Matrix[i]) to High(Matrix[i]) do
173
    begin
174
      if FreeVCL then
175
      begin
176
        if Assigned(Matrix[i][j].Stone) then Matrix[i][j].Stone.Free;
177
        if Assigned(Matrix[i][j].Panel) then Matrix[i][j].Panel.Free;
178
      end;
179
    end;
180
    SetLength(Matrix[i], 0);
181
  end;
182
  SetLength(Matrix, 0);
183
end;
184
 
185
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
186
var
187
  i, j: integer;
188
begin
189
  for i := Low(Matrix) to High(Matrix) do
190
  begin
191
    for j := Low(Matrix[i]) to High(Matrix[i]) do
192
    begin
193
      if Assigned(Matrix[i][j].Stone) then
194
      begin
195
        LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture);
196
        StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable);
197
      end;
198
    end;
199
  end;
200
end;
201
 
202
procedure TMainForm.DestroyLevel;
6 daniel-mar 203
var
204
  i: Integer;
1 daniel-mar 205
begin
206
  MPauseTime.Enabled := false;
207
  Timer.Enabled := false;
208
 
209
  MRestartGame.Enabled := false;
210
 
211
  LevelFile := '';
212
 
213
  CountedSeconds := 0;
214
  RefreshTime;
215
 
216
  Points := 0;
217
  RefreshPoints;
218
 
219
  LevelRemovedStones := 0;
220
  LevelTotalStones := 0;
221
  RefreshStonesRemoved;
222
 
223
  JumpHistory.Clear;
224
 
225
  ClearMatrix(PlayGroundMatrix, true);
6 daniel-mar 226
  for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
227
    ClearMatrix(PrevPlaygroundMatrixes[i], false);
228
  SetLength(PrevPlaygroundMatrixes, 0);
229
  MUndo.Enabled := false;
1 daniel-mar 230
 
231
  SetLength(LookupFieldCoordinateArray, 0);
11 daniel-mar 232
 
233
  if Assigned(Level) then FreeAndNil(Level);
1 daniel-mar 234
end;
235
 
236
procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
237
begin
238
  case FieldType of
239
    ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
240
    ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
241
    ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
242
    ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
243
  end;
244
end;
245
 
246
function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
247
begin
248
  result := TImage.Create(panel);
249
  result.Parent := panel;
250
  LoadPictureForType(fieldtype, result.Picture);
251
  result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
252
  result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
253
  result.Left := MET_SHAPE_MARGIN;
254
  result.Top := MET_SHAPE_MARGIN;
255
  result.Center := true;
256
  result.Transparent := true;
257
 
258
  result.Tag := panel.Tag;
259
  result.OnDragOver := panel.OnDragOver;
260
  result.OnDragDrop := panel.OnDragDrop;
261
 
262
  StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable);
263
end;
264
 
265
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
266
begin
267
  if Allow then
268
  begin
269
    Stone.DragMode := dmAutomatic;
270
    (Stone.Parent as TPanel).DragMode := dmAutomatic;
271
  end
272
  else
273
  begin
274
    Stone.DragMode := dmManual;
275
    (Stone.Parent as TPanel).DragMode := dmManual;
276
  end;
277
end;
278
 
279
function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
280
begin
281
  result := TPanel.Create(Playground);
282
  result.Parent := Playground;
283
  if isGoal then
284
  begin
285
    result.BevelInner := bvLowered;
286
  end;
287
  result.Color := Playground.Color;
288
  result.BevelOuter := bvLowered;
289
  result.Width := MET_FIELD_SIZE;
290
  result.Height := MET_FIELD_SIZE;
19 daniel-mar 291
  result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE + (halftabs*MET_HALFTAB_SIZE);
1 daniel-mar 292
  result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
293
 
294
  result.Tag := tag;
295
  result.OnDragOver := StoneDragOver;
296
  result.OnDragDrop := StoneDragDrop;
297
end;
298
 
299
procedure TMainForm.MExitClick(Sender: TObject);
300
begin
301
  Close;
302
end;
303
 
304
function TMainForm.FieldState(t: TFieldType): TFieldState;
305
begin
306
  result := fsError;
307
  case t of
19 daniel-mar 308
    ftFullSpace:     result := fsLocked;
1 daniel-mar 309
    ftEmpty:         result := fsAvailable;
310
    ftGreen:         result := fsStone;
311
    ftYellow:        result := fsStone;
312
    ftRed:           result := fsStone;
313
  end;
314
end;
315
 
316
function TMainForm.FieldState(f: TField): TFieldState;
317
begin
318
  result := FieldState(f.FieldType);
319
end;
320
 
321
function TMainForm.FieldState(x, y: integer): TFieldState;
322
begin
323
  result := fsError;
324
  if (x < Low(PlayGroundMatrix)) or (x > High(PlayGroundMatrix)) then exit;
325
  if (y < Low(PlayGroundMatrix[x])) or (y > High(PlayGroundMatrix[x])) then exit;
326
 
327
  result := FieldState(PlayGroundMatrix[x][y]);
328
end;
329
 
330
procedure TMainForm.RefreshTime;
331
begin
332
  Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
333
end;
334
 
335
procedure TMainForm.RefreshStonesRemoved;
336
begin
12 daniel-mar 337
  Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
1 daniel-mar 338
end;
339
 
340
procedure TMainForm.RefreshPoints;
341
begin
342
  Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
343
end;
344
 
345
procedure TMainForm.CountPoints(t: TFieldType);
346
begin
6 daniel-mar 347
  inc(Points, FieldTypeWorth(t));
1 daniel-mar 348
  RefreshPoints;
349
end;
350
 
351
procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
352
begin
353
  if count_points then
354
  begin
355
    CountPoints(PlayGroundMatrix[x, y].FieldType);
356
    Inc(LevelRemovedStones);
357
    RefreshStonesRemoved;
358
  end;
359
  PlayGroundMatrix[x, y].FieldType := ftEmpty;
360
  LoadPictureForType(PlayGroundMatrix[x, y].FieldType, PlayGroundMatrix[x, y].Stone.Picture);
361
  StoneDraggingAllow(PlayGroundMatrix[x, y].Stone, false);
362
end;
363
 
364
function TMainForm.CanJump(x, y: integer): boolean;
365
begin
366
  if FieldState(x, y) <> fsStone then
367
  begin
368
    result := false;
369
    exit;
370
  end;
371
 
372
  result := true;
373
 
374
  if MayJump(x, y, x+2, y) then exit;
375
  if MayJump(x, y, x-2, y) then exit;
376
  if MayJump(x, y, x, y+2) then exit;
377
  if MayJump(x, y, x, y-2) then exit;
378
 
11 daniel-mar 379
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 380
  begin
381
    if MayJump(x, y, x-2, y-2) then exit;
382
    if MayJump(x, y, x+2, y-2) then exit;
383
    if MayJump(x, y, x-2, y+2) then exit;
384
    if MayJump(x, y, x+2, y+2) then exit;
385
  end;
386
 
387
  result := false;
388
end;
389
 
14 daniel-mar 390
procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
391
var
392
  mode: string;
393
  goalYeSNo: string;
394
resourcestring
395
  LNG_BOARD = 'Board: %s';
396
  LNG_MODE = 'Mode: %s';
397
  LNG_STONES_TOTAL = 'Stones: %d';
398
  LNG_GOAL_AVAILABLE = 'Target field defined';
399
  LNG_NO_GOAL = 'No target field';
400
begin
401
  if Level.GetGameMode = gmDiagonal then
402
    mode := 'Diagonal'
403
  else if Level.GetGameMode = gmNormal then
404
    mode := 'Normal'
405
  else
406
    mode := '?';
407
 
408
  if GoalStatus = gsNoGoal then
409
    goalYeSNo := LNG_NO_GOAL
410
  else
411
    goalYeSNo := LNG_GOAL_AVAILABLE;
412
 
413
  ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
414
              #13#10 +
415
              Format(LNG_MODE, [mode]) + #13#10 +
416
              Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
417
              goalYesNo);
418
end;
419
 
1 daniel-mar 420
function TMainForm.AreJumpsPossible: boolean;
421
var
422
  i, j: integer;
423
begin
424
  result := false;
425
  for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do
426
  begin
427
    for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do
428
    begin
429
      if CanJump(i, j) then
430
      begin
431
        result := true;
432
        break;
433
      end;
434
      if result then break;
435
    end;
436
  end;
437
end;
438
 
439
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
440
var
441
  d, s: TPoint;
442
  old_fieldtype: TFieldType;
443
  res: Integer;
444
begin
445
  if not MayJump(SourceTag, DestTag) then exit;
446
 
447
  d := LookupFieldCoordinateArray[DestTag];
448
  s := LookupFieldCoordinateArray[SourceTag];
449
 
450
  JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
451
 
6 daniel-mar 452
  {$REGION 'Stein entfernen und Punkte vergeben'}
11 daniel-mar 453
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 454
  begin
455
    if (s.X-2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X-1, s.Y-1) = fsStone) then RemoveStone(s.X-1, s.Y-1, true);
456
    if (s.X-2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X-1, s.Y+1) = fsStone) then RemoveStone(s.X-1, s.Y+1, true);
457
    if (s.X+2 = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X+1, s.Y-1) = fsStone) then RemoveStone(s.X+1, s.Y-1, true);
458
    if (s.X+2 = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X+1, s.Y+1) = fsStone) then RemoveStone(s.X+1, s.Y+1, true);
459
  end;
460
 
461
  if (s.X+2 = d.X) and (s.Y = d.Y) and (FieldState(s.X+1, s.Y  ) = fsStone) then RemoveStone(s.X+1, s.Y, true);
462
  if (s.X-2 = d.X) and (s.Y = d.Y) and (FieldState(s.X-1, s.Y  ) = fsStone) then RemoveStone(s.X-1, s.Y, true);
463
  if (s.X = d.X) and (s.Y+2 = d.Y) and (FieldState(s.X  , s.Y+1) = fsStone) then RemoveStone(s.X, s.Y+1, true);
464
  if (s.X = d.X) and (s.Y-2 = d.Y) and (FieldState(s.X  , s.Y-1) = fsStone) then RemoveStone(s.X, s.Y-1, true);
6 daniel-mar 465
  {$ENDREGION}
1 daniel-mar 466
 
467
  // Den Timer erst nach dem ersten Zug starten
468
  // oder nach einer Pause neustarten
469
  if not Timer.Enabled then
470
  begin
471
    MPauseTime.Enabled := true;
472
    Timer.Enabled := true;
473
  end;
474
 
6 daniel-mar 475
  MRestartGame.Enabled := true;
1 daniel-mar 476
 
477
  // Sound abspielen
478
  if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
479
 
6 daniel-mar 480
  {$REGION 'Nun den Stein springen lassen'}
1 daniel-mar 481
  old_fieldtype := PlayGroundMatrix[s.X, s.Y].FieldType; // Steinfarbe merken
6 daniel-mar 482
  RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
1 daniel-mar 483
  PlayGroundMatrix[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
484
  LoadPictureForType(PlayGroundMatrix[d.X, d.Y].FieldType, PlayGroundMatrix[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
485
  StoneDraggingAllow(PlayGroundMatrix[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
6 daniel-mar 486
  {$ENDREGION}
1 daniel-mar 487
 
6 daniel-mar 488
  {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
1 daniel-mar 489
  if not AreJumpsPossible then
490
  begin
491
    MPauseTime.Enabled := false;
492
    Timer.Enabled := false;
493
    RefreshTime;
4 daniel-mar 494
    if MEnableSound.Checked then
495
    begin
8 daniel-mar 496
      if LevelRemovedStones = LevelTotalStones-1 then
497
      begin
498
        if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
499
          PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
500
        else
501
          PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
502
      end
4 daniel-mar 503
      else
504
        PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
505
    end;
8 daniel-mar 506
    res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
1 daniel-mar 507
    if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
508
  end;
6 daniel-mar 509
  {$ENDREGION}
510
 
511
  SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
512
  PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := CloneMatrix(PlaygroundMatrix);
513
  MUndo.Enabled := true;
1 daniel-mar 514
end;
515
 
516
function TMainForm.MayJump(SourceX, SourceY, DestX, DestY: integer): boolean;
517
begin
518
  result := false;
519
 
520
  // Check 1: Ist das Zielfeld überhaupt leer?
521
  if FieldState(DestX, DestY) <> fsAvailable then exit;
522
 
523
  // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
11 daniel-mar 524
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 525
  begin
526
    if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true;
527
    if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true;
528
    if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true;
529
    if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
530
  end;
531
 
532
  if (SourceX+2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX+1, SourceY  ) = fsStone) then result := true;
533
  if (SourceX-2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX-1, SourceY  ) = fsStone) then result := true;
534
  if (SourceX   = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX  , SourceY+1) = fsStone) then result := true;
535
  if (SourceX   = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX  , SourceY-1) = fsStone) then result := true;
536
end;
537
 
538
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
539
var
540
  s, d: TPoint;
541
begin
542
  d := LookupFieldCoordinateArray[DestTag];
543
  s := LookupFieldCoordinateArray[SourceTag];
544
 
545
  result := MayJump(s.X, s.Y, d.X, d.Y);
546
end;
547
 
548
procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
549
begin
550
  DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
551
end;
552
 
553
procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
554
  Y: Integer; State: TDragState; var Accept: Boolean);
555
begin
556
  Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
557
end;
558
 
19 daniel-mar 559
function TMainForm.DrawField(x, y: integer; t: TFieldProperties; indent: integer): TField;
1 daniel-mar 560
var
561
  newField: TField;
562
  index: integer;
563
begin
19 daniel-mar 564
  ZeroMemory(@result, SizeOf(result));
565
  if t.Typ = ftFullSpace then exit;
1 daniel-mar 566
 
567
  index := Length(LookupFieldCoordinateArray);
568
 
569
  newField.FieldType := t.Typ;
570
  newField.Goal := t.Goal;
19 daniel-mar 571
  newField.Panel := DrawStoneBox(x, y, index, indent, t.Goal);
1 daniel-mar 572
  newField.Stone := DrawStone(t.Typ, newField.Panel);
573
  if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
574
 
575
  SetLength(LookupFieldCoordinateArray, index + 1);
576
  LookupFieldCoordinateArray[index].X := x;
577
  LookupFieldCoordinateArray[index].Y := y;
578
 
579
  if Length(PlayGroundMatrix) < x+1 then SetLength(PlayGroundMatrix, x+1);
580
  if Length(PlayGroundMatrix[x]) < y+1 then SetLength(PlayGroundMatrix[x], y+1);
581
  PlaygroundMatrix[x, y] := newField;
19 daniel-mar 582
 
583
  result := newField;
1 daniel-mar 584
end;
585
 
586
function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
587
var
588
  i, j: integer;
589
begin
590
  SetLength(result, Length(Source));
591
  for i := Low(Source) to High(Source) do
592
  begin
593
    SetLength(result[i], Length(Source[i]));
594
    for j := Low(Source[i]) to High(Source[i]) do
595
    begin
596
      result[i][j].FieldType := Source[i][j].FieldType;
597
      result[i][j].Goal      := Source[i][j].Goal;
598
      result[i][j].Panel     := Source[i][j].Panel;
599
      result[i][j].Stone     := Source[i][j].Stone;
600
    end;
601
  end;
602
end;
603
 
604
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
605
var
19 daniel-mar 606
  y, x: integer;
607
  max_x, max_y: integer;
608
  p: TPanel;
1 daniel-mar 609
begin
610
  PlayGround.Visible := false;
611
 
612
  // Die Dimensionen ermitteln
613
  max_x := 0;
19 daniel-mar 614
  max_y := 0;
615
  for y := Low(LevelArray) to High(LevelArray) do
1 daniel-mar 616
  begin
19 daniel-mar 617
    for x := Low(LevelArray[y].Fields) to High(LevelArray[y].Fields) do
1 daniel-mar 618
    begin
19 daniel-mar 619
      p := DrawField(x, y, LevelArray[y].Fields[x], LevelArray[y].Indent).Panel;
620
      if Assigned(p) then
621
      begin
622
        max_x := Max(max_x, p.Left + p.Width);
623
        max_y := Max(max_y, p.Top  + p.Height);
624
      end;
1 daniel-mar 625
    end;
626
  end;
627
 
628
  PlayGround.Visible := true;
629
 
630
  // Das Form an das Level anpassen
19 daniel-mar 631
  PlayGround.Top    := MET_OUTER_MARGIN;
632
  PlayGround.Left   := MET_OUTER_MARGIN;
633
  PlayGround.Width  := max_x;
634
  PlayGround.Height := max_y;
635
  ClientWidth       := 2 * MET_OUTER_MARGIN + PlayGround.Width;
636
  ClientHeight      := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
1 daniel-mar 637
 
19 daniel-mar 638
  // If the board is too small, ClientWidth/ClientHeight will stop at a minimum value
639
  // in this case, we make sure that the Playground is centered
640
  PlayGround.Left := ClientWidth div 2 - Playground.Width div 2;
641
  PlayGround.Top := (ClientHeight - Statistics.Height) div 2 - Playground.Height div 2;
642
 
1 daniel-mar 643
  Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
644
  Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
645
 
6 daniel-mar 646
  SetLength(PrevPlaygroundMatrixes,1);
647
  PrevPlaygroundMatrixes[0] := CloneMatrix(PlayGroundMatrix);
648
  MUndo.Enabled := false;
1 daniel-mar 649
end;
650
 
651
procedure TMainForm.TimerTimer(Sender: TObject);
652
begin
653
  if mainform.Focused then Inc(CountedSeconds);
654
  RefreshTime;
655
end;
656
 
657
function TMainForm.LevelTime: String;
658
begin
659
  result := SecondsToTimeString(CountedSeconds);
660
end;
661
 
662
procedure TMainForm.NewGame(Filename: string);
663
var
664
  LevelArray: TLevelArray;
11 daniel-mar 665
begin
1 daniel-mar 666
  DestroyLevel;
667
  LevelFile := Filename;
11 daniel-mar 668
  Level := TLevel.Create(LevelFile);
669
  LevelArray := Level.LevelStringToLevelArray(true);
1 daniel-mar 670
  if Length(LevelArray) = 0 then Exit;
671
  BuildPlayground(LevelArray);
672
  if not AreJumpsPossible then
673
  begin
9 daniel-mar 674
    MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
1 daniel-mar 675
  end;
676
  RefreshTime;
677
  RefreshStonesRemoved;
678
  RefreshPoints;
679
end;
680
 
681
procedure TMainForm.MNewGameClick(Sender: TObject);
682
begin
683
  LevelFile := AskForLevel;
684
  if LevelFile <> '' then
685
  begin
686
    NewGame(LevelFile);
687
  end;
688
end;
689
 
690
procedure TMainForm.MAboutClick(Sender: TObject);
691
begin
692
  AboutBox.ShowModal;
693
end;
694
 
695
function TMainForm.AskForLevel: String;
696
begin
697
  LevelChoice.ShowModal;
698
 
699
  if LevelChoice.ModalResult <> mrOK then
700
  begin
701
    result := '';
702
    exit;
703
  end;
704
 
705
  result := LevelChoice.SelectedLevel;
706
end;
707
 
708
procedure TMainForm.FormShow(Sender: TObject);
709
begin
710
  LevelFile := AskForLevel;
711
  if LevelFile <> '' then
712
  begin
713
    NewGame(LevelFile);
714
  end
18 daniel-mar 715
  else
716
  begin
717
    NoCloseQuery := true;
718
    Close;
719
  end;
1 daniel-mar 720
end;
721
 
8 daniel-mar 722
function TMainForm.GoalStatus: TGoalStatus;
723
var
724
  ft: TFieldType;
725
begin
726
  if not MatrixHasGoal(PlaygroundMatrix) then
727
    result := gsNoGoal
728
  else if LevelRemovedStones < LevelTotalStones-1 then
729
    Result := gsMultipleStonesRemaining
730
  else
731
  begin
732
    ft := GoalFieldType(PlaygroundMatrix);
733
    if ft = ftRed then
734
      result := gsLastStoneInGoalRed
735
    else if ft = ftYellow then
736
      result := gsLastStoneInGoalYellow
737
    else if ft = ftGreen then
19 daniel-mar 738
      result := gsLastStoneInGoalGreen
739
    else
740
      result := gsUndefined;
8 daniel-mar 741
  end;
742
end;
743
 
1 daniel-mar 744
procedure TMainForm.FormCreate(Sender: TObject);
745
begin
746
  JumpHistory := TStringList.Create;
747
  LoadSettings;
748
end;
749
 
750
procedure TMainForm.FormDestroy(Sender: TObject);
751
begin
11 daniel-mar 752
  DestroyLevel;
1 daniel-mar 753
  JumpHistory.Free;
754
end;
755
 
756
procedure TMainForm.MJumpHistoryClick(Sender: TObject);
757
begin
758
  HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
759
  HistoryForm.ShowModal;
760
end;
761
 
762
procedure TMainForm.RestartLevel;
10 daniel-mar 763
var
764
  i: Integer;
1 daniel-mar 765
begin
766
  MPauseTime.Enabled := false;
767
  Timer.Enabled := false;
768
 
769
  MRestartGame.Enabled := false;
770
 
771
  CountedSeconds := 0;
772
  RefreshTime;
773
 
774
  Points := 0;
775
  RefreshPoints;
776
 
777
  LevelRemovedStones := 0;
778
  RefreshStonesRemoved;
779
 
780
  JumpHistory.Clear;
781
 
10 daniel-mar 782
  RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
783
  SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
784
  for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
785
    ClearMatrix(PrevPlaygroundMatrixes[i], false);
786
  SetLength(PrevPlaygroundMatrixes, 1);
787
 
6 daniel-mar 788
  MUndo.Enabled := false;
1 daniel-mar 789
end;
790
 
791
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
792
begin
793
  ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
794
  PlayGroundMatrix := CloneMatrix(Matrix);
795
end;
796
 
797
procedure TMainForm.MRestartGameClick(Sender: TObject);
798
begin
799
  RestartLevel;
800
end;
801
 
6 daniel-mar 802
procedure TMainForm.MUndoClick(Sender: TObject);
803
var
804
  PrevWorth: integer;
805
  NewWorth: integer;
806
begin
807
  if Length(PrevPlaygroundMatrixes) > 1 then
808
  begin
809
    PrevWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
810
 
811
    ClearMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1], false);
812
    SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
813
 
814
    NewWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
815
    RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
816
    SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
817
 
818
    JumpHistory.Delete(JumpHistory.Count-1);
819
 
820
    Dec(LevelRemovedStones);
821
    RefreshStonesRemoved;
822
 
823
    Dec(Points, NewWorth-PrevWorth);
824
    RefreshPoints;
7 daniel-mar 825
 
826
    // Sound abspielen
827
    if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
6 daniel-mar 828
  end;
829
 
830
  MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
831
end;
832
 
1 daniel-mar 833
procedure TMainForm.MHighScoresClick(Sender: TObject);
834
begin
835
  HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
836
end;
837
 
838
procedure TMainForm.MPauseTimeClick(Sender: TObject);
839
begin
840
  MPauseTime.Enabled := false;
841
  Timer.Enabled := false;
842
end;
843
 
844
procedure TMainForm.LoadSettings;
845
var
846
  reg: TRegistry;
847
begin
848
  reg := TRegistry.Create;
849
  try
850
    reg.RootKey := HKEY_CURRENT_USER;
851
    if reg.OpenKeyReadOnly(REG_KEY) then
852
    begin
853
      if reg.ValueExists(REG_SOUND) then
854
        MEnableSound.Checked := reg.ReadBool(REG_SOUND);
855
      reg.CloseKey;
856
    end;
857
  finally
858
    reg.Free;
859
  end;
860
end;
861
 
862
procedure TMainForm.SaveSettings;
863
var
864
  reg: TRegistry;
865
begin
866
  reg := TRegistry.Create;
867
  try
868
    reg.RootKey := HKEY_CURRENT_USER;
869
    if reg.OpenKey(REG_KEY, true) then
870
    begin
871
      reg.WriteBool(REG_SOUND, MEnableSound.Checked);
872
      reg.CloseKey;
873
    end;
874
  finally
875
    reg.Free;
876
  end;
877
end;
878
 
879
 
880
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
881
begin
882
  SaveSettings;
883
  if FinishForm.NameEdit.Text <> '' then
884
  begin
885
    FinishForm.SaveSettings;
886
  end;
887
end;
888
 
14 daniel-mar 889
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
890
resourcestring
891
  LNG_REALLY_QUIT = 'Do you really want to quit?';
892
begin
18 daniel-mar 893
  CanClose := NoCloseQuery or (MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes);
14 daniel-mar 894
end;
895
 
1 daniel-mar 896
procedure TMainForm.MHelpClick(Sender: TObject);
897
begin
898
  HelpForm.ShowModal;
899
end;
900
 
901
procedure TMainForm.MEnableSoundClick(Sender: TObject);
902
begin
903
  MEnableSound.Checked := not MEnableSound.Checked;
904
end;
905
 
906
end.