Subversion Repositories jumper

Rev

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