Subversion Repositories jumper

Rev

Rev 14 | Rev 19 | 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
 
8 daniel-mar 17
  TGoalStatus = (gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal);
18
 
1 daniel-mar 19
  TFieldState = (fsError, fsLocked, fsAvailable, fsStone);
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;
96
    procedure StoneDragOver(Sender, Source: TObject; X,
97
      Y: Integer; State: TDragState; var Accept: Boolean);
98
    procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
99
    procedure DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
100
    function DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
101
    function DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
102
    procedure BuildPlayground(LevelArray: TLevelArray);
103
    function FieldState(t: TFieldType): TFieldState; overload;
104
    function FieldState(f: TField): TFieldState; overload;
105
    function FieldState(x, y: integer): TFieldState; overload;
106
    procedure ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
107
    function CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
8 daniel-mar 108
    function MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
1 daniel-mar 109
    procedure LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
6 daniel-mar 110
    function MatrixWorth(Matrix: TPlayGroundMatrix): integer;
8 daniel-mar 111
    function GoalStatus: TGoalStatus;
112
    function GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
1 daniel-mar 113
  end;
114
 
115
var
116
  MainForm: TMainForm;
117
 
118
implementation
119
 
120
uses
121
  About, Finish, Choice, Functions, History, HighScore, Help, Constants;
122
 
123
{$R *.dfm}
124
 
8 daniel-mar 125
function TMainForm.MatrixHasGoal(Matrix: TPlayGroundMatrix): boolean;
126
var
127
  i, j: integer;
128
begin
129
  result := false;
130
  for i := Low(Matrix) to High(Matrix) do
131
  begin
132
    for j := Low(Matrix[i]) to High(Matrix[i]) do
133
    begin
134
      result := result or Matrix[i][j].Goal;
135
    end;
136
  end;
137
end;
138
 
139
function TMainForm.GoalFieldType(Matrix: TPlayGroundMatrix): TFieldType;
140
var
141
  i, j: integer;
142
begin
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;
291
  result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE - (halftabs*MET_HALFTAB_SIZE);
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
11 daniel-mar 308
    ftFullSpace:        result := fsLocked;
309
    ftHalfSpace: result := fsLocked;
1 daniel-mar 310
    ftEmpty:         result := fsAvailable;
311
    ftGreen:         result := fsStone;
312
    ftYellow:        result := fsStone;
313
    ftRed:           result := fsStone;
314
  end;
315
end;
316
 
317
function TMainForm.FieldState(f: TField): TFieldState;
318
begin
319
  result := FieldState(f.FieldType);
320
end;
321
 
322
function TMainForm.FieldState(x, y: integer): TFieldState;
323
begin
324
  result := fsError;
325
  if (x < Low(PlayGroundMatrix)) or (x > High(PlayGroundMatrix)) then exit;
326
  if (y < Low(PlayGroundMatrix[x])) or (y > High(PlayGroundMatrix[x])) then exit;
327
 
328
  result := FieldState(PlayGroundMatrix[x][y]);
329
end;
330
 
331
procedure TMainForm.RefreshTime;
332
begin
333
  Statistics.Panels.Items[0].Text := Format(LNG_TIME, [LevelTime]);
334
end;
335
 
336
procedure TMainForm.RefreshStonesRemoved;
337
begin
12 daniel-mar 338
  Statistics.Panels.Items[1].Text := Format(LNG_STONES_REMOVED, [LevelRemovedStones, LevelTotalStones-1]);
1 daniel-mar 339
end;
340
 
341
procedure TMainForm.RefreshPoints;
342
begin
343
  Statistics.Panels.Items[2].Text := Format(LNG_POINTS, [Points]);
344
end;
345
 
346
procedure TMainForm.CountPoints(t: TFieldType);
347
begin
6 daniel-mar 348
  inc(Points, FieldTypeWorth(t));
1 daniel-mar 349
  RefreshPoints;
350
end;
351
 
352
procedure TMainForm.RemoveStone(x, y: integer; count_points: boolean);
353
begin
354
  if count_points then
355
  begin
356
    CountPoints(PlayGroundMatrix[x, y].FieldType);
357
    Inc(LevelRemovedStones);
358
    RefreshStonesRemoved;
359
  end;
360
  PlayGroundMatrix[x, y].FieldType := ftEmpty;
361
  LoadPictureForType(PlayGroundMatrix[x, y].FieldType, PlayGroundMatrix[x, y].Stone.Picture);
362
  StoneDraggingAllow(PlayGroundMatrix[x, y].Stone, false);
363
end;
364
 
365
function TMainForm.CanJump(x, y: integer): boolean;
366
begin
367
  if FieldState(x, y) <> fsStone then
368
  begin
369
    result := false;
370
    exit;
371
  end;
372
 
373
  result := true;
374
 
375
  if MayJump(x, y, x+2, y) then exit;
376
  if MayJump(x, y, x-2, y) then exit;
377
  if MayJump(x, y, x, y+2) then exit;
378
  if MayJump(x, y, x, y-2) then exit;
379
 
11 daniel-mar 380
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 381
  begin
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
    if MayJump(x, y, x+2, y+2) then exit;
386
  end;
387
 
388
  result := false;
389
end;
390
 
14 daniel-mar 391
procedure TMainForm.Aboutthislevel1Click(Sender: TObject);
392
var
393
  mode: string;
394
  goalYeSNo: string;
395
resourcestring
396
  LNG_BOARD = 'Board: %s';
397
  LNG_MODE = 'Mode: %s';
398
  LNG_STONES_TOTAL = 'Stones: %d';
399
  LNG_GOAL_AVAILABLE = 'Target field defined';
400
  LNG_NO_GOAL = 'No target field';
401
begin
402
  if Level.GetGameMode = gmDiagonal then
403
    mode := 'Diagonal'
404
  else if Level.GetGameMode = gmNormal then
405
    mode := 'Normal'
406
  else
407
    mode := '?';
408
 
409
  if GoalStatus = gsNoGoal then
410
    goalYeSNo := LNG_NO_GOAL
411
  else
412
    goalYeSNo := LNG_GOAL_AVAILABLE;
413
 
414
  ShowMessage(Format(LNG_BOARD, [ExtractFileNameWithoutExt(LevelFile)]) + #13#10 +
415
              #13#10 +
416
              Format(LNG_MODE, [mode]) + #13#10 +
417
              Format(LNG_STONES_TOTAL, [LevelTotalStones]) + #13#10 +
418
              goalYesNo);
419
end;
420
 
1 daniel-mar 421
function TMainForm.AreJumpsPossible: boolean;
422
var
423
  i, j: integer;
424
begin
425
  result := false;
426
  for i := Low(PlayGroundMatrix) to High(PlayGroundMatrix) do
427
  begin
428
    for j := Low(PlayGroundMatrix[i]) to High(PlayGroundMatrix[i]) do
429
    begin
430
      if CanJump(i, j) then
431
      begin
432
        result := true;
433
        break;
434
      end;
435
      if result then break;
436
    end;
437
  end;
438
end;
439
 
440
procedure TMainForm.DoJump(SourceTag, DestTag: integer);
441
var
442
  d, s: TPoint;
443
  old_fieldtype: TFieldType;
444
  res: Integer;
445
begin
446
  if not MayJump(SourceTag, DestTag) then exit;
447
 
448
  d := LookupFieldCoordinateArray[DestTag];
449
  s := LookupFieldCoordinateArray[SourceTag];
450
 
451
  JumpHistory.Add(Format(LNG_JUMP_LOG, [SourceTag+1, s.x+1, s.y+1, DestTag+1, d.x+1, d.y+1]));
452
 
6 daniel-mar 453
  {$REGION 'Stein entfernen und Punkte vergeben'}
11 daniel-mar 454
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 455
  begin
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
    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);
460
  end;
461
 
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-2 = d.X) and (s.Y = d.Y) and (FieldState(s.X-1, s.Y  ) = fsStone) then RemoveStone(s.X-1, s.Y, 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);
465
  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 466
  {$ENDREGION}
1 daniel-mar 467
 
468
  // Den Timer erst nach dem ersten Zug starten
469
  // oder nach einer Pause neustarten
470
  if not Timer.Enabled then
471
  begin
472
    MPauseTime.Enabled := true;
473
    Timer.Enabled := true;
474
  end;
475
 
6 daniel-mar 476
  MRestartGame.Enabled := true;
1 daniel-mar 477
 
478
  // Sound abspielen
479
  if MEnableSound.Checked then PlaySound(RES_JUMP, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
480
 
6 daniel-mar 481
  {$REGION 'Nun den Stein springen lassen'}
1 daniel-mar 482
  old_fieldtype := PlayGroundMatrix[s.X, s.Y].FieldType; // Steinfarbe merken
6 daniel-mar 483
  RemoveStone(s.X, s.Y, false); // Eigenen Stein entfernen. Keine Punkte zählen, da das unser eigener Stein ist, der springt
1 daniel-mar 484
  PlayGroundMatrix[d.X, d.Y].FieldType := old_fieldtype; // Farbe wiederherstellen
485
  LoadPictureForType(PlayGroundMatrix[d.X, d.Y].FieldType, PlayGroundMatrix[d.X, d.Y].Stone.Picture); // Stein an neue Position malen
486
  StoneDraggingAllow(PlayGroundMatrix[d.X, d.Y].Stone, true); // Und die Drag-Eigenschaft erneuern
6 daniel-mar 487
  {$ENDREGION}
1 daniel-mar 488
 
6 daniel-mar 489
  {$REGION 'Sind weitere Sprünge möglich oder ist das Spiel vorbei?'}
1 daniel-mar 490
  if not AreJumpsPossible then
491
  begin
492
    MPauseTime.Enabled := false;
493
    Timer.Enabled := false;
494
    RefreshTime;
4 daniel-mar 495
    if MEnableSound.Checked then
496
    begin
8 daniel-mar 497
      if LevelRemovedStones = LevelTotalStones-1 then
498
      begin
499
        if GoalStatus in [gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen] then
500
          PlaySound(RES_WIN2, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
501
        else
502
          PlaySound(RES_WIN1, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE)
503
      end
4 daniel-mar 504
      else
505
        PlaySound(RES_LOSE, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
506
    end;
8 daniel-mar 507
    res := FinishForm.Execute(ExtractFileNameWithoutExt(LevelFile), Points, LevelTotalStones, LevelRemovedStones, CountedSeconds, GoalStatus, JumpHistory);
1 daniel-mar 508
    if (res = mrOK) and FinishForm.ReplayCheckbox.Checked then RestartLevel;
509
  end;
6 daniel-mar 510
  {$ENDREGION}
511
 
512
  SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)+1);
513
  PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1] := CloneMatrix(PlaygroundMatrix);
514
  MUndo.Enabled := true;
1 daniel-mar 515
end;
516
 
517
function TMainForm.MayJump(SourceX, SourceY, DestX, DestY: integer): boolean;
518
begin
519
  result := false;
520
 
521
  // Check 1: Ist das Zielfeld überhaupt leer?
522
  if FieldState(DestX, DestY) <> fsAvailable then exit;
523
 
524
  // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2?
11 daniel-mar 525
  if Level.GetGameMode = gmDiagonal then
1 daniel-mar 526
  begin
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
    if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true;
531
  end;
532
 
533
  if (SourceX+2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX+1, SourceY  ) = fsStone) then result := true;
534
  if (SourceX-2 = DestX) and (SourceY   = DestY) and (FieldState(SourceX-1, SourceY  ) = fsStone) then result := true;
535
  if (SourceX   = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX  , SourceY+1) = fsStone) then result := true;
536
  if (SourceX   = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX  , SourceY-1) = fsStone) then result := true;
537
end;
538
 
539
function TMainForm.MayJump(SourceTag, DestTag: integer): boolean;
540
var
541
  s, d: TPoint;
542
begin
543
  d := LookupFieldCoordinateArray[DestTag];
544
  s := LookupFieldCoordinateArray[SourceTag];
545
 
546
  result := MayJump(s.X, s.Y, d.X, d.Y);
547
end;
548
 
549
procedure TMainForm.StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
550
begin
551
  DoJump(TComponent(Source).Tag, TComponent(Sender).Tag);
552
end;
553
 
554
procedure TMainForm.StoneDragOver(Sender, Source: TObject; X,
555
  Y: Integer; State: TDragState; var Accept: Boolean);
556
begin
557
  Accept := MayJump(TComponent(Source).Tag, TComponent(Sender).Tag);
558
end;
559
 
560
procedure TMainForm.DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
561
var
562
  newField: TField;
563
  index: integer;
564
begin
11 daniel-mar 565
  if (t.Typ = ftFullSpace) or (t.Typ = ftHalfSpace) then exit;
1 daniel-mar 566
 
567
  index := Length(LookupFieldCoordinateArray);
568
 
569
  newField.FieldType := t.Typ;
570
  newField.Goal := t.Goal;
571
  newField.Panel := DrawStoneBox(x, y, index, halftabs, t.Goal);
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;
582
end;
583
 
584
function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
585
var
586
  i, j: integer;
587
begin
588
  SetLength(result, Length(Source));
589
  for i := Low(Source) to High(Source) do
590
  begin
591
    SetLength(result[i], Length(Source[i]));
592
    for j := Low(Source[i]) to High(Source[i]) do
593
    begin
594
      result[i][j].FieldType := Source[i][j].FieldType;
595
      result[i][j].Goal      := Source[i][j].Goal;
596
      result[i][j].Panel     := Source[i][j].Panel;
597
      result[i][j].Stone     := Source[i][j].Stone;
598
    end;
599
  end;
600
end;
601
 
602
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
603
var
604
  i, j, halftabs, cur_x: integer;
605
  max_x, max_y, old_cw, old_ch: integer;
606
begin
607
  PlayGround.Visible := false;
608
 
609
  // Die Dimensionen ermitteln
610
  max_x := 0;
611
  for i := Low(LevelArray) to High(LevelArray) do
612
  begin
613
    halftabs := 0;
614
    for j := Low(LevelArray[i]) to High(LevelArray[i]) do
615
    begin
11 daniel-mar 616
      if LevelArray[i][j].Typ = ftHalfSpace then inc(halftabs);
1 daniel-mar 617
      DrawField(j, i, LevelArray[i][j], halftabs);
618
    end;
619
    cur_x := High(LevelArray[i]) + 1;
620
    if cur_x > max_x then max_x := cur_x;
621
  end;
622
  max_y := High(LevelArray) + 1;
623
 
624
  PlayGround.Visible := true;
625
 
626
  // Die aktuellen Dimensionen merken
627
  old_cw := ClientWidth;
628
  old_ch := ClientHeight;
629
 
630
  // Das Form an das Level anpassen
631
  PlayGround.Width := MET_FIELD_SPACE + max_x * (MET_FIELD_SPACE + MET_FIELD_SIZE);
632
  PlayGround.Height := MET_FIELD_SPACE + max_y * (MET_FIELD_SPACE + MET_FIELD_SIZE);
633
  ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width;
634
  ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
635
 
636
  Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
637
  Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
638
 
639
  // Wenn sich das Form vergrößert oder verkleinert hat, neu justieren
640
  if (old_cw <> ClientWidth) or (old_ch <> ClientHeight) then
641
  begin
642
    Left := Screen.Width div 2 - Width div 2;
643
    Top := Screen.Height div 2 - Height div 2;
644
 
645
    // Playground mittig setzen, falls die Mindestgröße für die
646
    // Punkteanzeige unterschritten wurde,
647
    PlayGround.Left := ClientWidth div 2 - PlayGround.Width div 2;
648
    PlayGround.Top := ClientHeight div 2 - PlayGround.Height div 2;
649
  end;
650
 
6 daniel-mar 651
  SetLength(PrevPlaygroundMatrixes,1);
652
  PrevPlaygroundMatrixes[0] := CloneMatrix(PlayGroundMatrix);
653
  MUndo.Enabled := false;
1 daniel-mar 654
end;
655
 
656
procedure TMainForm.TimerTimer(Sender: TObject);
657
begin
658
  if mainform.Focused then Inc(CountedSeconds);
659
  RefreshTime;
660
end;
661
 
662
function TMainForm.LevelTime: String;
663
begin
664
  result := SecondsToTimeString(CountedSeconds);
665
end;
666
 
667
procedure TMainForm.NewGame(Filename: string);
668
var
669
  LevelArray: TLevelArray;
11 daniel-mar 670
begin
1 daniel-mar 671
  DestroyLevel;
672
  LevelFile := Filename;
11 daniel-mar 673
  Level := TLevel.Create(LevelFile);
674
  LevelArray := Level.LevelStringToLevelArray(true);
1 daniel-mar 675
  if Length(LevelArray) = 0 then Exit;
676
  BuildPlayground(LevelArray);
677
  if not AreJumpsPossible then
678
  begin
9 daniel-mar 679
    MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
1 daniel-mar 680
  end;
681
  RefreshTime;
682
  RefreshStonesRemoved;
683
  RefreshPoints;
684
end;
685
 
686
procedure TMainForm.MNewGameClick(Sender: TObject);
687
begin
688
  LevelFile := AskForLevel;
689
  if LevelFile <> '' then
690
  begin
691
    NewGame(LevelFile);
692
  end;
693
end;
694
 
695
procedure TMainForm.MAboutClick(Sender: TObject);
696
begin
697
  AboutBox.ShowModal;
698
end;
699
 
700
function TMainForm.AskForLevel: String;
701
begin
702
  LevelChoice.ShowModal;
703
 
704
  if LevelChoice.ModalResult <> mrOK then
705
  begin
706
    result := '';
707
    exit;
708
  end;
709
 
710
  result := LevelChoice.SelectedLevel;
711
end;
712
 
713
procedure TMainForm.FormShow(Sender: TObject);
714
begin
715
  LevelFile := AskForLevel;
716
  if LevelFile <> '' then
717
  begin
718
    NewGame(LevelFile);
719
  end
18 daniel-mar 720
  else
721
  begin
722
    NoCloseQuery := true;
723
    Close;
724
  end;
1 daniel-mar 725
end;
726
 
8 daniel-mar 727
function TMainForm.GoalStatus: TGoalStatus;
728
var
729
  ft: TFieldType;
730
begin
731
  if not MatrixHasGoal(PlaygroundMatrix) then
732
    result := gsNoGoal
733
  else if LevelRemovedStones < LevelTotalStones-1 then
734
    Result := gsMultipleStonesRemaining
735
  else
736
  begin
737
    ft := GoalFieldType(PlaygroundMatrix);
738
    if ft = ftRed then
739
      result := gsLastStoneInGoalRed
740
    else if ft = ftYellow then
741
      result := gsLastStoneInGoalYellow
742
    else if ft = ftGreen then
743
      result := gsLastStoneInGoalGreen;
744
  end;
745
end;
746
 
1 daniel-mar 747
procedure TMainForm.FormCreate(Sender: TObject);
748
begin
749
  JumpHistory := TStringList.Create;
750
  LoadSettings;
751
end;
752
 
753
procedure TMainForm.FormDestroy(Sender: TObject);
754
begin
11 daniel-mar 755
  DestroyLevel;
1 daniel-mar 756
  JumpHistory.Free;
757
end;
758
 
759
procedure TMainForm.MJumpHistoryClick(Sender: TObject);
760
begin
761
  HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
762
  HistoryForm.ShowModal;
763
end;
764
 
765
procedure TMainForm.RestartLevel;
10 daniel-mar 766
var
767
  i: Integer;
1 daniel-mar 768
begin
769
  MPauseTime.Enabled := false;
770
  Timer.Enabled := false;
771
 
772
  MRestartGame.Enabled := false;
773
 
774
  CountedSeconds := 0;
775
  RefreshTime;
776
 
777
  Points := 0;
778
  RefreshPoints;
779
 
780
  LevelRemovedStones := 0;
781
  RefreshStonesRemoved;
782
 
783
  JumpHistory.Clear;
784
 
10 daniel-mar 785
  RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
786
  SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
787
  for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
788
    ClearMatrix(PrevPlaygroundMatrixes[i], false);
789
  SetLength(PrevPlaygroundMatrixes, 1);
790
 
6 daniel-mar 791
  MUndo.Enabled := false;
1 daniel-mar 792
end;
793
 
794
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
795
begin
796
  ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
797
  PlayGroundMatrix := CloneMatrix(Matrix);
798
end;
799
 
800
procedure TMainForm.MRestartGameClick(Sender: TObject);
801
begin
802
  RestartLevel;
803
end;
804
 
6 daniel-mar 805
procedure TMainForm.MUndoClick(Sender: TObject);
806
var
807
  PrevWorth: integer;
808
  NewWorth: integer;
809
begin
810
  if Length(PrevPlaygroundMatrixes) > 1 then
811
  begin
812
    PrevWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
813
 
814
    ClearMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1], false);
815
    SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
816
 
817
    NewWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
818
    RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
819
    SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
820
 
821
    JumpHistory.Delete(JumpHistory.Count-1);
822
 
823
    Dec(LevelRemovedStones);
824
    RefreshStonesRemoved;
825
 
826
    Dec(Points, NewWorth-PrevWorth);
827
    RefreshPoints;
7 daniel-mar 828
 
829
    // Sound abspielen
830
    if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
6 daniel-mar 831
  end;
832
 
833
  MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
834
end;
835
 
1 daniel-mar 836
procedure TMainForm.MHighScoresClick(Sender: TObject);
837
begin
838
  HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
839
end;
840
 
841
procedure TMainForm.MPauseTimeClick(Sender: TObject);
842
begin
843
  MPauseTime.Enabled := false;
844
  Timer.Enabled := false;
845
end;
846
 
847
procedure TMainForm.LoadSettings;
848
var
849
  reg: TRegistry;
850
begin
851
  reg := TRegistry.Create;
852
  try
853
    reg.RootKey := HKEY_CURRENT_USER;
854
    if reg.OpenKeyReadOnly(REG_KEY) then
855
    begin
856
      if reg.ValueExists(REG_SOUND) then
857
        MEnableSound.Checked := reg.ReadBool(REG_SOUND);
858
      reg.CloseKey;
859
    end;
860
  finally
861
    reg.Free;
862
  end;
863
end;
864
 
865
procedure TMainForm.SaveSettings;
866
var
867
  reg: TRegistry;
868
begin
869
  reg := TRegistry.Create;
870
  try
871
    reg.RootKey := HKEY_CURRENT_USER;
872
    if reg.OpenKey(REG_KEY, true) then
873
    begin
874
      reg.WriteBool(REG_SOUND, MEnableSound.Checked);
875
      reg.CloseKey;
876
    end;
877
  finally
878
    reg.Free;
879
  end;
880
end;
881
 
882
 
883
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
884
begin
885
  SaveSettings;
886
  if FinishForm.NameEdit.Text <> '' then
887
  begin
888
    FinishForm.SaveSettings;
889
  end;
890
end;
891
 
14 daniel-mar 892
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
893
resourcestring
894
  LNG_REALLY_QUIT = 'Do you really want to quit?';
895
begin
18 daniel-mar 896
  CanClose := NoCloseQuery or (MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes);
14 daniel-mar 897
end;
898
 
1 daniel-mar 899
procedure TMainForm.MHelpClick(Sender: TObject);
900
begin
901
  HelpForm.ShowModal;
902
end;
903
 
904
procedure TMainForm.MEnableSoundClick(Sender: TObject);
905
begin
906
  MEnableSound.Checked := not MEnableSound.Checked;
907
end;
908
 
909
end.