Subversion Repositories jumper

Rev

Rev 12 | Rev 18 | 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
65
    CountedSeconds: Integer;
66
    LevelFile: String;
67
    LookupFieldCoordinateArray: array of TPoint;
6 daniel-mar 68
    PrevPlaygroundMatrixes: array of TPlayGroundMatrix;
1 daniel-mar 69
    PlaygroundMatrix: TPlayGroundMatrix;
70
    Points: Integer;
71
    LevelTotalStones: Integer;
72
    LevelRemovedStones: Integer;
73
    JumpHistory: TStringList;
11 daniel-mar 74
    Level: TLevel;
1 daniel-mar 75
    procedure LoadSettings;
76
    procedure SaveSettings;
77
    procedure RestartLevel;
78
    procedure SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
79
    procedure RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
80
    function AskForLevel: String;
81
    function AreJumpsPossible: boolean;
82
    procedure StoneDraggingAllow(Stone: TImage; Allow: boolean);
83
    procedure NewGame(Filename: string);
84
    function LevelTime: String;
85
    procedure DestroyLevel;
86
    procedure RefreshTime;
87
    procedure RefreshPoints;
88
    procedure RefreshStonesRemoved;
89
    procedure CountPoints(t: TFieldType);
90
    procedure RemoveStone(x, y: integer; count_points: boolean);
91
    procedure DoJump(SourceTag, DestTag: integer);
92
    function CanJump(x, y: integer): boolean;
93
    function MayJump(SourceX, SourceY, DestX, DestY: integer): boolean; overload;
94
    function MayJump(SourceTag, DestTag: integer): boolean; overload;
95
    procedure StoneDragOver(Sender, Source: TObject; X,
96
      Y: Integer; State: TDragState; var Accept: Boolean);
97
    procedure StoneDragDrop(Sender, Source: TObject; X, Y: Integer);
98
    procedure DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
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
120
  About, Finish, Choice, Functions, History, HighScore, Help, Constants;
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
142
  for i := Low(Matrix) to High(Matrix) do
143
  begin
144
    for j := Low(Matrix[i]) to High(Matrix[i]) do
145
    begin
146
      if Matrix[i][j].Goal then result := Matrix[i][j].FieldType
147
    end;
148
  end;
149
end;
150
 
6 daniel-mar 151
function TMainForm.MatrixWorth(Matrix: TPlayGroundMatrix): integer;
152
var
153
  i, j: integer;
154
begin
155
  result := 0;
156
  for i := Low(Matrix) to High(Matrix) do
157
  begin
158
    for j := Low(Matrix[i]) to High(Matrix[i]) do
159
    begin
160
      Inc(result, FieldTypeWorth(Matrix[i][j].FieldType));
161
    end;
162
  end;
163
end;
164
 
1 daniel-mar 165
procedure TMainForm.ClearMatrix(Matrix: TPlayGroundMatrix; FreeVCL: boolean);
166
var
167
  i, j: integer;
168
begin
169
  for i := Low(Matrix) to High(Matrix) do
170
  begin
171
    for j := Low(Matrix[i]) to High(Matrix[i]) do
172
    begin
173
      if FreeVCL then
174
      begin
175
        if Assigned(Matrix[i][j].Stone) then Matrix[i][j].Stone.Free;
176
        if Assigned(Matrix[i][j].Panel) then Matrix[i][j].Panel.Free;
177
      end;
178
    end;
179
    SetLength(Matrix[i], 0);
180
  end;
181
  SetLength(Matrix, 0);
182
end;
183
 
184
procedure TMainForm.RedrawStonesFromMatrix(Matrix: TPlayGroundMatrix);
185
var
186
  i, j: integer;
187
begin
188
  for i := Low(Matrix) to High(Matrix) do
189
  begin
190
    for j := Low(Matrix[i]) to High(Matrix[i]) do
191
    begin
192
      if Assigned(Matrix[i][j].Stone) then
193
      begin
194
        LoadPictureForType(Matrix[i][j].FieldType, Matrix[i][j].Stone.Picture);
195
        StoneDraggingAllow(Matrix[i][j].Stone, FieldState(Matrix[i][j].FieldType) <> fsAvailable);
196
      end;
197
    end;
198
  end;
199
end;
200
 
201
procedure TMainForm.DestroyLevel;
6 daniel-mar 202
var
203
  i: Integer;
1 daniel-mar 204
begin
205
  MPauseTime.Enabled := false;
206
  Timer.Enabled := false;
207
 
208
  MRestartGame.Enabled := false;
209
 
210
  LevelFile := '';
211
 
212
  CountedSeconds := 0;
213
  RefreshTime;
214
 
215
  Points := 0;
216
  RefreshPoints;
217
 
218
  LevelRemovedStones := 0;
219
  LevelTotalStones := 0;
220
  RefreshStonesRemoved;
221
 
222
  JumpHistory.Clear;
223
 
224
  ClearMatrix(PlayGroundMatrix, true);
6 daniel-mar 225
  for i := 0 to Length(PrevPlaygroundMatrixes)-1 do
226
    ClearMatrix(PrevPlaygroundMatrixes[i], false);
227
  SetLength(PrevPlaygroundMatrixes, 0);
228
  MUndo.Enabled := false;
1 daniel-mar 229
 
230
  SetLength(LookupFieldCoordinateArray, 0);
11 daniel-mar 231
 
232
  if Assigned(Level) then FreeAndNil(Level);
1 daniel-mar 233
end;
234
 
235
procedure TMainForm.LoadPictureForType(FieldType: TFieldType; Picture: TPicture);
236
begin
237
  case FieldType of
238
    ftEmpty:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_EMPTY);
239
    ftGreen:  Picture.Bitmap.LoadFromResourceName(HInstance, RES_GREEN);
240
    ftYellow: Picture.Bitmap.LoadFromResourceName(HInstance, RES_YELLOW);
241
    ftRed:    Picture.Bitmap.LoadFromResourceName(HInstance, RES_RED);
242
  end;
243
end;
244
 
245
function TMainForm.DrawStone(fieldtype: TFieldType; panel: TPanel): TImage;
246
begin
247
  result := TImage.Create(panel);
248
  result.Parent := panel;
249
  LoadPictureForType(fieldtype, result.Picture);
250
  result.Width := panel.Width - 2*MET_SHAPE_MARGIN;
251
  result.Height := panel.Height - 2*MET_SHAPE_MARGIN;
252
  result.Left := MET_SHAPE_MARGIN;
253
  result.Top := MET_SHAPE_MARGIN;
254
  result.Center := true;
255
  result.Transparent := true;
256
 
257
  result.Tag := panel.Tag;
258
  result.OnDragOver := panel.OnDragOver;
259
  result.OnDragDrop := panel.OnDragDrop;
260
 
261
  StoneDraggingAllow(result, FieldState(fieldtype) <> fsAvailable);
262
end;
263
 
264
procedure TMainForm.StoneDraggingAllow(Stone: TImage; Allow: boolean);
265
begin
266
  if Allow then
267
  begin
268
    Stone.DragMode := dmAutomatic;
269
    (Stone.Parent as TPanel).DragMode := dmAutomatic;
270
  end
271
  else
272
  begin
273
    Stone.DragMode := dmManual;
274
    (Stone.Parent as TPanel).DragMode := dmManual;
275
  end;
276
end;
277
 
278
function TMainForm.DrawStoneBox(x, y, tag, halftabs: integer; isGoal: boolean): TPanel;
279
begin
280
  result := TPanel.Create(Playground);
281
  result.Parent := Playground;
282
  if isGoal then
283
  begin
284
    result.BevelInner := bvLowered;
285
  end;
286
  result.Color := Playground.Color;
287
  result.BevelOuter := bvLowered;
288
  result.Width := MET_FIELD_SIZE;
289
  result.Height := MET_FIELD_SIZE;
290
  result.Left := x * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE - (halftabs*MET_HALFTAB_SIZE);
291
  result.Top := y * (MET_FIELD_SIZE+MET_FIELD_SPACE) + MET_FIELD_SPACE;
292
 
293
  result.Tag := tag;
294
  result.OnDragOver := StoneDragOver;
295
  result.OnDragDrop := StoneDragDrop;
296
end;
297
 
298
procedure TMainForm.MExitClick(Sender: TObject);
299
begin
300
  Close;
301
end;
302
 
303
function TMainForm.FieldState(t: TFieldType): TFieldState;
304
begin
305
  result := fsError;
306
  case t of
11 daniel-mar 307
    ftFullSpace:        result := fsLocked;
308
    ftHalfSpace: 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
 
559
procedure TMainForm.DrawField(x, y: integer; t: TFieldProperties; halftabs: integer);
560
var
561
  newField: TField;
562
  index: integer;
563
begin
11 daniel-mar 564
  if (t.Typ = ftFullSpace) or (t.Typ = ftHalfSpace) then exit;
1 daniel-mar 565
 
566
  index := Length(LookupFieldCoordinateArray);
567
 
568
  newField.FieldType := t.Typ;
569
  newField.Goal := t.Goal;
570
  newField.Panel := DrawStoneBox(x, y, index, halftabs, t.Goal);
571
  newField.Stone := DrawStone(t.Typ, newField.Panel);
572
  if FieldState(t.Typ) = fsStone then Inc(LevelTotalStones);
573
 
574
  SetLength(LookupFieldCoordinateArray, index + 1);
575
  LookupFieldCoordinateArray[index].X := x;
576
  LookupFieldCoordinateArray[index].Y := y;
577
 
578
  if Length(PlayGroundMatrix) < x+1 then SetLength(PlayGroundMatrix, x+1);
579
  if Length(PlayGroundMatrix[x]) < y+1 then SetLength(PlayGroundMatrix[x], y+1);
580
  PlaygroundMatrix[x, y] := newField;
581
end;
582
 
583
function TMainForm.CloneMatrix(Source: TPlayGroundMatrix): TPlayGroundMatrix;
584
var
585
  i, j: integer;
586
begin
587
  SetLength(result, Length(Source));
588
  for i := Low(Source) to High(Source) do
589
  begin
590
    SetLength(result[i], Length(Source[i]));
591
    for j := Low(Source[i]) to High(Source[i]) do
592
    begin
593
      result[i][j].FieldType := Source[i][j].FieldType;
594
      result[i][j].Goal      := Source[i][j].Goal;
595
      result[i][j].Panel     := Source[i][j].Panel;
596
      result[i][j].Stone     := Source[i][j].Stone;
597
    end;
598
  end;
599
end;
600
 
601
procedure TMainForm.BuildPlayground(LevelArray: TLevelArray);
602
var
603
  i, j, halftabs, cur_x: integer;
604
  max_x, max_y, old_cw, old_ch: integer;
605
begin
606
  PlayGround.Visible := false;
607
 
608
  // Die Dimensionen ermitteln
609
  max_x := 0;
610
  for i := Low(LevelArray) to High(LevelArray) do
611
  begin
612
    halftabs := 0;
613
    for j := Low(LevelArray[i]) to High(LevelArray[i]) do
614
    begin
11 daniel-mar 615
      if LevelArray[i][j].Typ = ftHalfSpace then inc(halftabs);
1 daniel-mar 616
      DrawField(j, i, LevelArray[i][j], halftabs);
617
    end;
618
    cur_x := High(LevelArray[i]) + 1;
619
    if cur_x > max_x then max_x := cur_x;
620
  end;
621
  max_y := High(LevelArray) + 1;
622
 
623
  PlayGround.Visible := true;
624
 
625
  // Die aktuellen Dimensionen merken
626
  old_cw := ClientWidth;
627
  old_ch := ClientHeight;
628
 
629
  // Das Form an das Level anpassen
630
  PlayGround.Width := MET_FIELD_SPACE + max_x * (MET_FIELD_SPACE + MET_FIELD_SIZE);
631
  PlayGround.Height := MET_FIELD_SPACE + max_y * (MET_FIELD_SPACE + MET_FIELD_SIZE);
632
  ClientWidth := 2 * MET_OUTER_MARGIN + PlayGround.Width;
633
  ClientHeight := 2 * MET_OUTER_MARGIN + PlayGround.Height + Statistics.Height;
634
 
635
  Statistics.Panels.Items[0].Width := Round(ClientWidth*MET_PERCENT_PNL_TIME);
636
  Statistics.Panels.Items[1].Width := Round(ClientWidth*MET_PERCENT_PNL_STONES);
637
 
638
  // Wenn sich das Form vergrößert oder verkleinert hat, neu justieren
639
  if (old_cw <> ClientWidth) or (old_ch <> ClientHeight) then
640
  begin
641
    Left := Screen.Width div 2 - Width div 2;
642
    Top := Screen.Height div 2 - Height div 2;
643
 
644
    // Playground mittig setzen, falls die Mindestgröße für die
645
    // Punkteanzeige unterschritten wurde,
646
    PlayGround.Left := ClientWidth div 2 - PlayGround.Width div 2;
647
    PlayGround.Top := ClientHeight div 2 - PlayGround.Height div 2;
648
  end;
649
 
6 daniel-mar 650
  SetLength(PrevPlaygroundMatrixes,1);
651
  PrevPlaygroundMatrixes[0] := CloneMatrix(PlayGroundMatrix);
652
  MUndo.Enabled := false;
1 daniel-mar 653
end;
654
 
655
procedure TMainForm.TimerTimer(Sender: TObject);
656
begin
657
  if mainform.Focused then Inc(CountedSeconds);
658
  RefreshTime;
659
end;
660
 
661
function TMainForm.LevelTime: String;
662
begin
663
  result := SecondsToTimeString(CountedSeconds);
664
end;
665
 
666
procedure TMainForm.NewGame(Filename: string);
667
var
668
  LevelArray: TLevelArray;
11 daniel-mar 669
begin
1 daniel-mar 670
  DestroyLevel;
671
  LevelFile := Filename;
11 daniel-mar 672
  Level := TLevel.Create(LevelFile);
673
  LevelArray := Level.LevelStringToLevelArray(true);
1 daniel-mar 674
  if Length(LevelArray) = 0 then Exit;
675
  BuildPlayground(LevelArray);
676
  if not AreJumpsPossible then
677
  begin
9 daniel-mar 678
    MessageDlg(LNG_LVL_INVALID_NO_JUMP, mtError, [mbOk], 0);
1 daniel-mar 679
  end;
680
  RefreshTime;
681
  RefreshStonesRemoved;
682
  RefreshPoints;
683
end;
684
 
685
procedure TMainForm.MNewGameClick(Sender: TObject);
686
begin
687
  LevelFile := AskForLevel;
688
  if LevelFile <> '' then
689
  begin
690
    NewGame(LevelFile);
691
  end;
692
end;
693
 
694
procedure TMainForm.MAboutClick(Sender: TObject);
695
begin
696
  AboutBox.ShowModal;
697
end;
698
 
699
function TMainForm.AskForLevel: String;
700
begin
701
  LevelChoice.ShowModal;
702
 
703
  if LevelChoice.ModalResult <> mrOK then
704
  begin
705
    result := '';
706
    exit;
707
  end;
708
 
709
  result := LevelChoice.SelectedLevel;
710
end;
711
 
712
procedure TMainForm.FormShow(Sender: TObject);
713
begin
714
  LevelFile := AskForLevel;
715
  if LevelFile <> '' then
716
  begin
717
    NewGame(LevelFile);
718
  end
719
  else Close();
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
738
      result := gsLastStoneInGoalGreen;
739
  end;
740
end;
741
 
1 daniel-mar 742
procedure TMainForm.FormCreate(Sender: TObject);
743
begin
744
  JumpHistory := TStringList.Create;
745
  LoadSettings;
746
end;
747
 
748
procedure TMainForm.FormDestroy(Sender: TObject);
749
begin
11 daniel-mar 750
  DestroyLevel;
1 daniel-mar 751
  JumpHistory.Free;
752
end;
753
 
754
procedure TMainForm.MJumpHistoryClick(Sender: TObject);
755
begin
756
  HistoryForm.JumpMemo.Lines.Assign(JumpHistory);
757
  HistoryForm.ShowModal;
758
end;
759
 
760
procedure TMainForm.RestartLevel;
10 daniel-mar 761
var
762
  i: Integer;
1 daniel-mar 763
begin
764
  MPauseTime.Enabled := false;
765
  Timer.Enabled := false;
766
 
767
  MRestartGame.Enabled := false;
768
 
769
  CountedSeconds := 0;
770
  RefreshTime;
771
 
772
  Points := 0;
773
  RefreshPoints;
774
 
775
  LevelRemovedStones := 0;
776
  RefreshStonesRemoved;
777
 
778
  JumpHistory.Clear;
779
 
10 daniel-mar 780
  RedrawStonesFromMatrix(PrevPlaygroundMatrixes[0]);
781
  SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[0]);
782
  for i := 1 to Length(PrevPlaygroundMatrixes)-1 do
783
    ClearMatrix(PrevPlaygroundMatrixes[i], false);
784
  SetLength(PrevPlaygroundMatrixes, 1);
785
 
6 daniel-mar 786
  MUndo.Enabled := false;
1 daniel-mar 787
end;
788
 
789
procedure TMainForm.SetNewPlayGroundMatrix(Matrix: TPlayGroundMatrix);
790
begin
791
  ClearMatrix(PlayGroundMatrix, false); // Memory Leak verhindern
792
  PlayGroundMatrix := CloneMatrix(Matrix);
793
end;
794
 
795
procedure TMainForm.MRestartGameClick(Sender: TObject);
796
begin
797
  RestartLevel;
798
end;
799
 
6 daniel-mar 800
procedure TMainForm.MUndoClick(Sender: TObject);
801
var
802
  PrevWorth: integer;
803
  NewWorth: integer;
804
begin
805
  if Length(PrevPlaygroundMatrixes) > 1 then
806
  begin
807
    PrevWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
808
 
809
    ClearMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1], false);
810
    SetLength(PrevPlaygroundMatrixes, Length(PrevPlaygroundMatrixes)-1);
811
 
812
    NewWorth := MatrixWorth(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
813
    RedrawStonesFromMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
814
    SetNewPlayGroundMatrix(PrevPlaygroundMatrixes[Length(PrevPlaygroundMatrixes)-1]);
815
 
816
    JumpHistory.Delete(JumpHistory.Count-1);
817
 
818
    Dec(LevelRemovedStones);
819
    RefreshStonesRemoved;
820
 
821
    Dec(Points, NewWorth-PrevWorth);
822
    RefreshPoints;
7 daniel-mar 823
 
824
    // Sound abspielen
825
    if MEnableSound.Checked then PlaySound(RES_UNDO, HInstance, SND_ASYNC or SND_NOWAIT or SND_RESOURCE);
6 daniel-mar 826
  end;
827
 
828
  MUndo.Enabled := Length(PrevPlaygroundMatrixes) > 1;
829
end;
830
 
1 daniel-mar 831
procedure TMainForm.MHighScoresClick(Sender: TObject);
832
begin
833
  HighScoreForm.Execute(ExtractFileNameWithoutExt(LevelFile));
834
end;
835
 
836
procedure TMainForm.MPauseTimeClick(Sender: TObject);
837
begin
838
  MPauseTime.Enabled := false;
839
  Timer.Enabled := false;
840
end;
841
 
842
procedure TMainForm.LoadSettings;
843
var
844
  reg: TRegistry;
845
begin
846
  reg := TRegistry.Create;
847
  try
848
    reg.RootKey := HKEY_CURRENT_USER;
849
    if reg.OpenKeyReadOnly(REG_KEY) then
850
    begin
851
      if reg.ValueExists(REG_SOUND) then
852
        MEnableSound.Checked := reg.ReadBool(REG_SOUND);
853
      reg.CloseKey;
854
    end;
855
  finally
856
    reg.Free;
857
  end;
858
end;
859
 
860
procedure TMainForm.SaveSettings;
861
var
862
  reg: TRegistry;
863
begin
864
  reg := TRegistry.Create;
865
  try
866
    reg.RootKey := HKEY_CURRENT_USER;
867
    if reg.OpenKey(REG_KEY, true) then
868
    begin
869
      reg.WriteBool(REG_SOUND, MEnableSound.Checked);
870
      reg.CloseKey;
871
    end;
872
  finally
873
    reg.Free;
874
  end;
875
end;
876
 
877
 
878
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
879
begin
880
  SaveSettings;
881
  if FinishForm.NameEdit.Text <> '' then
882
  begin
883
    FinishForm.SaveSettings;
884
  end;
885
end;
886
 
14 daniel-mar 887
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
888
resourcestring
889
  LNG_REALLY_QUIT = 'Do you really want to quit?';
890
begin
891
  CanClose := MessageDlg(LNG_REALLY_QUIT, mtConfirmation, mbYesNoCancel, 0) = mrYes;
892
end;
893
 
1 daniel-mar 894
procedure TMainForm.MHelpClick(Sender: TObject);
895
begin
896
  HelpForm.ShowModal;
897
end;
898
 
899
procedure TMainForm.MEnableSoundClick(Sender: TObject);
900
begin
901
  MEnableSound.Checked := not MEnableSound.Checked;
902
end;
903
 
904
end.