source: trunk/Game.pas

Last change on this file was 115, checked in by chronos, 11 months ago
  • Modified: Automatically detect and use dark mode on Windows.
  • Modified: Use dark mode title bar on Windows 10.
File size: 37.9 KB
Line 
1unit Game;
2
3interface
4
5uses
6 Classes, SysUtils, Dialogs, Generics.Collections, Graphics, Types, Forms, Math, DateUtils,
7 Controls, RegistryEx, Tile, Board, History;
8
9type
10 TGame = class;
11 TColorPalette = (cpOrangeYellow, cpGreenYellow, cpPinkBlue, cpBlueCyan,
12 cpGreenCyan, cpPinkRed);
13
14 { TArea }
15
16 TArea = record
17 P1, P2: TPoint;
18 function Increment: TPoint;
19 class function Create(P1, P2: TPoint): TArea; static; overload;
20 class function Create(X1, Y1, X2, Y2: Integer): TArea; static; overload;
21 end;
22
23 TTileSkin = (tsLinear, tsPowerOfTwo, tsAlpha, tsRoman, tsBinary);
24
25 { TGame }
26
27 TGame = class
28 private
29 FMoves: Integer;
30 FMoving: Boolean;
31 FUnmergeableTilesCount: Integer;
32 FOnChange: TNotifyEvent;
33 FOnGameOver: TNotifyEvent;
34 FOnPaint: TNotifyEvent;
35 FOnWin: TNotifyEvent;
36 FRecordHistory: Boolean;
37 FRunning: Boolean;
38 FScore: Integer;
39 FCanUndo: Boolean;
40 FBoardUndo: TBoard;
41 FColorPalette: TColorPalette;
42 FSkin: TTileSkin;
43 FDisabledTilesCount: Integer;
44 FUsedUndos: Integer;
45 function GetTileColor(Value: Integer): TColor;
46 procedure SetRecordHistory(AValue: Boolean);
47 procedure SetScore(AValue: Integer);
48 procedure DoChange;
49 procedure DoPaint;
50 procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
51 procedure RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
52 function RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string): TSize;
53 procedure GameOver;
54 procedure SetColorPalette(AValue: TColorPalette);
55 procedure SetSkin(AValue: TTileSkin);
56 procedure Win;
57 function FillRandomTile: TTile;
58 function FillUnmergeableRandomTile: TTile;
59 function DisableRandomTile: TTile;
60 function GetMoveArea(Direction: TMoveDirection): TArea;
61 procedure MoveAllAnimate(Direction: TMoveDirection);
62 function CanMergeTile(Value1, Value2: Integer): Boolean;
63 function MergeTile(Value1, Value2: Integer): Integer;
64 procedure AnimateTiles;
65 public
66 Board: TBoard;
67 InitialBoard: TBoard;
68 TopScore: Integer;
69 AnimationDuration: Integer;
70 AnimationTick: Integer;
71 WinTileValue: Integer;
72 UndoEnabled: Boolean;
73 History: THistory;
74 BackgroundColor: TColor;
75 Value2Chance: Double;
76 StartTime: TDateTime;
77 procedure Replay(History: THistory; Step: Integer);
78 function CanUndo: Boolean;
79 procedure Undo;
80 function CanMergeDirection(Direction: TMoveDirection): Boolean;
81 function CanMoveDirection(Direction: TMoveDirection): Boolean;
82 function CanMove: Boolean;
83 procedure Assign(Source: TGame);
84 procedure Reset;
85 procedure New;
86 procedure Restart;
87 procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
88 procedure MoveAll(Direction: TMoveDirection; Animation: Boolean);
89 procedure MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
90 procedure MoveTile(SourceTile, TargetTile: TTile);
91 function IsValidPos(Pos: TPoint): Boolean;
92 procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
93 procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
94 function GetTileSkinValue(Value: Integer): string;
95 function GetTileSkinScore(Value: Integer): Integer;
96 constructor Create;
97 destructor Destroy; override;
98 property Score: Integer read FScore write SetScore;
99 property Moves: Integer read FMoves;
100 property UsedUndos: Integer read FUsedUndos;
101 property Running: Boolean read FRunning write FRunning;
102 property Moving: Boolean read FMoving;
103 property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
104 property Skin: TTileSkin read FSkin write SetSkin;
105 property ColorPalette: TColorPalette read FColorPalette write SetColorPalette;
106 property DisabledTilesCount: Integer read FDisabledTilesCount write FDisabledTilesCount;
107 property UnmergeableTilesCount: Integer read FUnmergeableTilesCount write FUnmergeableTilesCount;
108 property OnChange: TNotifyEvent read FOnChange write FOnChange;
109 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
110 property OnWin: TNotifyEvent read FOnWin write FOnWin;
111 property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
112 end;
113
114 TGames = class(TObjectList<TGame>)
115 end;
116
117var
118 SkinText: array[TTileSkin] of string;
119 ColorPaletteText: array[TColorPalette] of string;
120
121const
122 DirectionDiff: array[TMoveDirection] of TPoint = (
123 (X: 0; Y: 0), (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
124 );
125 DirectionText: array[TMoveDirection] of string = ('None', 'Left', 'Up', 'Right', 'Down');
126 InitialTileCount = 2;
127 BoxFontSize = 10;
128
129resourcestring
130 SScore = 'Score';
131 STopScore = 'Best';
132 SSkinLinear = 'Linear';
133 SSkinPowerOfTwo = 'Power of two';
134 SSkinAlpha = 'Alpha';
135 SSkinRoman = 'Roman';
136 SSkinBinary = 'Binary';
137 STileShouldBeEmpty = 'Tile should be empty';
138
139 // Color palette
140 SOrangeYellow = 'Orange - yellow';
141 SGreenYellow = 'Green - yellow';
142 SPinkBlue = 'Pink - blue';
143 SBlueCyan = 'Blue - cyan';
144 SGreenCyan = 'Green - cyan';
145 SPinkRed = 'Pink - red';
146
147procedure Translate;
148
149
150implementation
151
152uses
153 Core, MetaCanvas, PixelPointer, Theme;
154
155procedure Translate;
156begin
157 SkinText[tsLinear] := SSkinLinear;
158 SkinText[tsPowerOfTwo] := SSkinPowerOfTwo;
159 SkinText[tsAlpha] := SSkinAlpha;
160 SkinText[tsRoman] := SSkinRoman;
161 SkinText[tsBinary] := SSkinBinary;
162
163 ColorPaletteText[cpOrangeYellow] := SOrangeYellow;
164 ColorPaletteText[cpGreenYellow] := SGreenYellow;
165 ColorPaletteText[cpPinkBlue] := SPinkBlue;
166 ColorPaletteText[cpBlueCyan] := SBlueCyan;
167 ColorPaletteText[cpGreenCyan] := SGreenCyan;
168 ColorPaletteText[cpPinkRed] := SPinkRed;
169end;
170
171{ TArea }
172
173function TArea.Increment: TPoint;
174begin
175 Result := Point(Sign(P2.X - P1.X), Sign(P2.Y - P1.Y));
176 if Result.X = 0 then Result.X := 1;
177 if Result.Y = 0 then Result.Y := 1;
178end;
179
180class function TArea.Create(P1, P2: TPoint): TArea;
181begin
182 Result.P1 := P1;
183 Result.P2 := P2;
184end;
185
186class function TArea.Create(X1, Y1, X2, Y2: Integer): TArea;
187begin
188 Result.P1 := Point(X1, Y1);
189 Result.P2 := Point(X2, Y2);
190end;
191
192{ TGame }
193
194procedure TGame.DoChange;
195begin
196 if Assigned(FOnChange) then FOnChange(Self);
197end;
198
199procedure TGame.DoPaint;
200begin
201 if Assigned(FOnPaint) then FOnPaint(Self);
202end;
203
204procedure TGame.GameOver;
205begin
206 if Running and Assigned(FOnGameOver) then FOnGameOver(Self);
207 Running := False;
208end;
209
210procedure TGame.SetColorPalette(AValue: TColorPalette);
211begin
212 if FColorPalette = AValue then Exit;
213 FColorPalette := AValue;
214 DoPaint;
215end;
216
217procedure TGame.SetSkin(AValue: TTileSkin);
218begin
219 if FSkin = AValue then Exit;
220 FSkin := AValue;
221 DoPaint;
222end;
223
224procedure TGame.Win;
225begin
226 if Assigned(FOnWin) then FOnWin(Self);
227end;
228
229function TGame.FillRandomTile: TTile;
230var
231 EmptyTiles: TTiles;
232 NewValue: Integer;
233begin
234 Result := nil;
235 EmptyTiles := TTiles.Create(False);
236 try
237 Board.GetEmptyTiles(EmptyTiles);
238 if EmptyTiles.Count > 0 then begin
239 if Random < Value2Chance then NewValue := 2 else NewValue := 1;
240 Result := EmptyTiles[Random(EmptyTiles.Count)];
241 Result.Value := NewValue;
242 Result.Action := taAppear;
243 end;
244 finally
245 EmptyTiles.Free;
246 end;
247end;
248
249function TGame.FillUnmergeableRandomTile: TTile;
250var
251 EmptyTiles: TTiles;
252begin
253 Result := nil;
254 EmptyTiles := TTiles.Create(False);
255 try
256 Board.GetEmptyTiles(EmptyTiles);
257 if EmptyTiles.Count > 0 then begin
258 Result := EmptyTiles[Random(EmptyTiles.Count)];
259 Result.Value := 1;
260 Result.Action := taNone;
261 Result.Unmergeable := True;
262 end;
263 finally
264 EmptyTiles.Free;
265 end;
266end;
267
268function TGame.DisableRandomTile: TTile;
269var
270 EmptyTiles: TTiles;
271begin
272 Result := nil;
273 EmptyTiles := TTiles.Create(False);
274 try
275 Board.GetEmptyTiles(EmptyTiles);
276 if EmptyTiles.Count > 0 then begin
277 Result := EmptyTiles[Random(EmptyTiles.Count)];
278 Result.Disabled := True;
279 end;
280 finally
281 EmptyTiles.Free;
282 end;
283end;
284
285function TGame.GetMoveArea(Direction: TMoveDirection): TArea;
286begin
287 case Direction of
288 drNone: Result := TArea.Create(0, 0, 0, 0);
289 drLeft: Result := TArea.Create(1, 0, Board.Size.X - 1, Board.Size.Y - 1);
290 drUp: Result := TArea.Create(0, 1, Board.Size.X - 1, Board.Size.Y - 1);
291 drRight: Result := TArea.Create(Board.Size.X - 2, 0, 0, Board.Size.Y - 1);
292 drDown: Result := TArea.Create(0, Board.Size.Y - 2, Board.Size.X - 1, 0);
293 end;
294end;
295
296function TGame.CanMove: Boolean;
297begin
298 Result := CanMoveDirection(drLeft) or CanMoveDirection(drRight) or
299 CanMoveDirection(drUp) or CanMoveDirection(drDown);
300end;
301
302procedure TGame.Assign(Source: TGame);
303begin
304 Board.Assign(Source.Board);
305 FBoardUndo.Assign(Source.FBoardUndo);
306 FCanUndo := Source.FCanUndo;
307 TopScore := Source.TopScore;
308 AnimationDuration := Source.AnimationDuration;
309 WinTileValue := Source.WinTileValue;
310 UndoEnabled := Source.UndoEnabled;
311 FScore := Source.FScore;
312 FRunning := Source.FRunning;
313 Skin := Source.Skin;
314 ColorPalette := Source.ColorPalette;
315 RecordHistory := Source.RecordHistory;
316 DisabledTilesCount := Source.DisabledTilesCount;
317 UnmergeableTilesCount := Source.UnmergeableTilesCount;
318 //History.Assign(Source.History);
319end;
320
321procedure TGame.Reset;
322const
323 Difficulty = 0.7;
324begin
325 FUsedUndos := 0;
326 FMoves := 0;
327 FCanUndo := False;
328 Board.Clear;
329 WinTileValue := Round((Board.Size.X * Board.Size.Y) * Difficulty);
330 Score := 0;
331 Running := True;
332 History.Clear;
333end;
334
335procedure TGame.New;
336var
337 I: Integer;
338 Tile: TTile;
339begin
340 Reset;
341
342 if RecordHistory then begin
343 for I := 0 to DisabledTilesCount - 1 do begin
344 SetLength(History.DisabledTiles, Length(History.DisabledTiles) + 1);
345 History.DisabledTiles[Length(History.DisabledTiles) - 1] := DisableRandomTile.Index;
346 end;
347 for I := 0 to InitialTileCount - 1 do begin
348 SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
349 Tile := FillRandomTile;
350 History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
351 History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
352 end;
353 for I := 0 to UnmergeableTilesCount - 1 do begin
354 SetLength(History.InitialTiles, Length(History.InitialTiles) + 1);
355 Tile := FillUnmergeableRandomTile;
356 History.InitialTiles[Length(History.InitialTiles) - 1].Pos := Tile.Index;
357 History.InitialTiles[Length(History.InitialTiles) - 1].Value := Tile.Value;
358 History.InitialTiles[Length(History.InitialTiles) - 1].Unmergable := Tile.Unmergeable;
359 end;
360 end else begin
361 for I := 0 to DisabledTilesCount - 1 do
362 DisableRandomTile;
363 for I := 0 to InitialTileCount - 1 do
364 FillRandomTile;
365 for I := 0 to UnmergeableTilesCount - 1 do
366 FillUnmergeableRandomTile;
367 end;
368 InitialBoard.Assign(Board);
369 StartTime := Now;
370 AnimateTiles;
371 DoChange;
372 DoPaint;
373end;
374
375procedure TGame.Restart;
376begin
377 Reset;
378 Board.Assign(InitialBoard);
379 StartTime := Now;
380 AnimateTiles;
381 DoChange;
382 DoPaint;
383end;
384
385procedure TGame.Render(Canvas: TCanvas; CanvasSize: TPoint);
386var
387 X, Y: Integer;
388 TileSize: TPoint;
389 Frame: TRect;
390 TileRect: TRect;
391 TopBarHeight: Integer;
392 LeftBarWidth: Integer;
393 TileMargin: Integer;
394 TileCenter: TPoint;
395 S: TPoint;
396 MetaCanvas: TMetaCanvas;
397 BorderSize: Integer;
398 ControlsRect: TRect;
399 BoardRect: TRect;
400 Horizontal: Boolean;
401 Tile: TTile;
402begin
403 // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
404 // So dimensions are provided by CanvasSize parameter.
405
406 MetaCanvas := TMetaCanvas.Create;
407 MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
408
409 // Clear background
410 MetaCanvas.Brush.Style := bsSolid;
411 MetaCanvas.Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorControl;
412 MetaCanvas.FillRect(0, 0, MetaCanvas.Width, MetaCanvas.Height);
413
414 TopBarHeight := ScaleY(65, 96);
415 LeftBarWidth := ScaleY(100, 96);
416 if CanvasSize.X - LeftBarWidth < Canvas.Height then begin
417 ControlsRect := Rect(0, 0, CanvasSize.X, TopBarHeight);
418 BoardRect := Rect(0, TopBarHeight, CanvasSize.X, CanvasSize.Y);
419 Horizontal := True;
420 end else begin
421 ControlsRect := Rect(0, 0, LeftBarWidth, CanvasSize.Y);
422 BoardRect := Rect(LeftBarWidth, 0, CanvasSize.X, CanvasSize.Y);
423 Horizontal := False;
424 end;
425
426 RenderControls(MetaCanvas, ControlsRect, Horizontal);
427
428 BorderSize := ScaleY(2, 96);
429 Frame := Rect(BoardRect.Left + BorderSize, BoardRect.Top + BorderSize,
430 BoardRect.Right - BorderSize, BoardRect.Bottom - BorderSize);
431
432 TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
433 if TileSize.X < TileSize.Y then TileSize.Y := TileSize.X;
434 if TileSize.Y < TileSize.X then TileSize.X := TileSize.Y;
435 Frame := Rect(Frame.Left + Frame.Width div 2 - (Board.Size.X * TileSize.X) div 2,
436 Frame.Top + Frame.Height div 2 - (Board.Size.Y * TileSize.Y) div 2,
437 Frame.Left + Frame.Width div 2 + (Board.Size.X * TileSize.X) div 2,
438 Frame.Top + Frame.Height div 2 + (Board.Size.Y * TileSize.Y) div 2);
439
440 TileMargin := Round(Frame.Width / Board.Size.X * 0.03);
441
442 MetaCanvas.Brush.Style := bsSolid;
443 MetaCanvas.Brush.Color := clGray;
444 MetaCanvas.Pen.Style := psClear;
445 MetaCanvas.RoundRect(Frame, ScaleX(Frame.Width div (20 * Board.Size.X), 96),
446 ScaleY(Frame.Height div (20 * Board.Size.Y), 96));
447
448 Frame := Rect(Frame.Left + TileMargin, Frame.Top + TileMargin,
449 Frame.Right - TileMargin, Frame.Bottom - TileMargin);
450 TileSize := Point(Frame.Width div Board.Size.X, Frame.Height div Board.Size.Y);
451
452 MetaCanvas.Font.Color := clBlack;
453
454 // Draw static tiles
455 for Y := 0 to Board.Size.Y - 1 do
456 for X := 0 to Board.Size.X - 1 do begin
457 Tile := Board.Tiles[Y, X];
458 if (Tile.Action <> taNone) then MetaCanvas.Brush.Color := GetTileColor(0)
459 else MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
460 if Tile.Disabled then MetaCanvas.Brush.Style := bsClear
461 else MetaCanvas.Brush.Style := bsSolid;
462 TileRect := Bounds(
463 Frame.Left + X * TileSize.X + TileMargin,
464 Frame.Top + Y * TileSize.Y + TileMargin,
465 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
466 RenderTile(MetaCanvas, Tile, TileRect, Tile.Action = taNone);
467 end;
468
469 // Draw moving tiles
470 for Y := 0 to Board.Size.Y - 1 do
471 for X := 0 to Board.Size.X - 1 do begin
472 Tile := Board.Tiles[Y, X];
473 if Tile.Action = taMove then begin
474 MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
475 MetaCanvas.Brush.Style := bsSolid;
476 TileRect := Bounds(
477 Frame.Left + X * TileSize.X + Trunc(Tile.Shift.X / 100 * TileSize.X + TileMargin),
478 Frame.Top + Y * TileSize.Y + Trunc(Tile.Shift.Y / 100 * TileSize.Y + TileMargin),
479 TileSize.X - 2 * TileMargin, TileSize.Y - 2 * TileMargin);
480 RenderTile(MetaCanvas, Tile, TileRect, True);
481 end;
482 end;
483
484 // Draw appearing tiles
485 for Y := 0 to Board.Size.Y - 1 do
486 for X := 0 to Board.Size.X - 1 do begin
487 Tile := Board.Tiles[Y, X];
488 if Tile.Action = taAppear then begin
489 MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
490 MetaCanvas.Brush.Style := bsSolid;
491 TileRect := Bounds(
492 Frame.Left + X * TileSize.X + TileMargin,
493 Frame.Top + Y * TileSize.Y + TileMargin,
494 TileSize.X - 2 * TileMargin,
495 TileSize.Y - 2 * TileMargin);
496 TileCenter := TileRect.CenterPoint;
497 S := Point(
498 Trunc(Tile.Shift.X / 100 * (TileSize.X - TileMargin)),
499 Trunc(Tile.Shift.Y / 100 * (TileSize.Y - TileMargin))
500 );
501 TileRect := Rect(TileCenter.X - S.X div 2, TileCenter.Y - S.Y div 2,
502 TileCenter.X + S.X div 2, TileCenter.Y + S.Y div 2);
503 RenderTile(MetaCanvas, Tile, TileRect, True);
504 end;
505 end;
506
507 // Draw merging tiles
508 for Y := 0 to Board.Size.Y - 1 do
509 for X := 0 to Board.Size.X - 1 do begin
510 Tile := Board.Tiles[Y, X];
511 if Tile.Action = taMerge then begin
512 MetaCanvas.Brush.Color := GetTileColor(Tile.Value);
513 MetaCanvas.Brush.Style := bsSolid;
514 TileRect := Bounds(
515 Frame.Left + X * TileSize.X + TileMargin,
516 Frame.Top + Y * TileSize.Y + TileMargin,
517 TileSize.X - 2 * TileMargin,
518 TileSize.Y - 2 * TileMargin);
519 S := Point(
520 Trunc((50 - Abs(Tile.Shift.X - 50)) / 50 * TileMargin),
521 Trunc((50 - Abs(Tile.Shift.Y - 50)) / 50 * TileMargin)
522 );
523 TileRect := Rect(TileRect.Left - S.X, TileRect.Top - S.Y,
524 TileRect.Right + S.X, TileRect.Bottom + S.Y);
525 RenderTile(MetaCanvas, Tile, TileRect, True);
526 end;
527 end;
528
529 MetaCanvas.DrawTo(Canvas);
530 MetaCanvas.Free;
531end;
532
533procedure TGame.MoveAll(Direction: TMoveDirection; Animation: Boolean);
534var
535 P: TPoint;
536 PNew: TPoint;
537 I: Integer;
538 Area: TArea;
539 DstTile: TTile;
540 SrcTile: TTile;
541 TileMoved: Boolean;
542begin
543 Inc(FMoves);
544 if Animation then begin
545 MoveAllAnimate(Direction);
546 Exit;
547 end;
548 if Direction = drNone then Exit;
549 if not CanMoveDirection(Direction) then Exit;
550 FMoving := True;
551 FBoardUndo.Assign(Board);
552 FCanUndo := True;
553 Area := GetMoveArea(Direction);
554 Board.ClearMerged;
555 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
556 TileMoved := False;
557 P := Area.P1;
558 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
559 P.X := Area.P1.X;
560 while P.X <> Area.P2.X + Area.Increment.X do begin
561 PNew := P + DirectionDiff[Direction];
562 if IsValidPos(PNew) and not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
563 SrcTile := Board.Tiles[P.Y, P.X];
564 DstTile := Board.Tiles[PNew.Y, PNew.X];
565 if SrcTile.Value <> 0 then begin
566 if DstTile.Value = 0 then begin
567 DstTile.Value := SrcTile.Value;
568 DstTile.Merged := SrcTile.Merged;
569 DstTile.Unmergeable := SrcTile.Unmergeable;
570 SrcTile.Value := 0;
571 SrcTile.Merged := False;
572 SrcTile.Unmergeable := False;
573 TileMoved := True;
574 end else
575 if (not SrcTile.Merged) and (not DstTile.Merged) and
576 CanMergeTile(DstTile.Value, SrcTile.Value) and
577 not SrcTile.Unmergeable and not DstTile.Unmergeable then begin
578 DstTile.Value := MergeTile(DstTile.Value, SrcTile.Value);
579 DstTile.Merged := True;
580 SrcTile.Value := 0;
581 SrcTile.Merged := False;
582 Score := Score + GetTileSkinScore(SrcTile.Value);
583 TileMoved := True;
584 end;
585 end;
586 end;
587 Inc(P.X, Area.Increment.X);
588 end;
589 Inc(P.Y, Area.Increment.Y);
590 end;
591 if not TileMoved then Break;
592 end;
593 DoPaint;
594 FMoving := False;
595end;
596
597procedure TGame.RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
598var
599 ValueStr: string;
600 TextSize: TSize;
601 CrossBorder: Integer;
602 FontHeightMultiplicator: Double;
603begin
604 // TODO: Why the fonts set with Height have different size across platforms?
605 {$IFDEF UNIX}
606 FontHeightMultiplicator := 72 / 96;
607 {$ELSE}
608 FontHeightMultiplicator := 1;
609 {$ENDIF}
610
611 if Canvas.Brush.Style = bsClear then Exit;
612
613 Canvas.Pen.Style := psClear;
614 Canvas.RoundRect(TileRect, ScaleX(TileRect.Width div 20, 96), ScaleY(TileRect.Height div 20, 96));
615
616{ if Tile.Unmergeable then begin
617 CrossBorder := ScaleX(Trunc(TileRect.Width / 50), 96);
618 Canvas.Pen.Width := ScaleX(Trunc(TileRect.Width / 30), 96);
619 Canvas.Pen.Style := psSolid;
620 Canvas.Pen.Color := Canvas.Font.Color;
621 Canvas.Line(TileRect.Left + CrossBorder, TileRect.Top + CrossBorder,
622 TileRect.Right - CrossBorder, TileRect.Bottom - CrossBorder);
623 Canvas.Line(TileRect.Right - CrossBorder, TileRect.Top + CrossBorder,
624 TileRect.Left + CrossBorder, TileRect.Bottom - CrossBorder);
625 end;
626 }
627
628 if WithText and (Tile.Value <> 0) then begin
629 if Tile.Disabled then ValueStr := '@'
630 else if Tile.Unmergeable then ValueStr := ''
631 else ValueStr := GetTileSkinValue(Tile.Value);
632 Canvas.Brush.Style := bsClear;
633 Canvas.Font.Height := Trunc(TileRect.Height * FontHeightMultiplicator);
634 TextSize := Canvas.TextExtent(ValueStr);
635 if TextSize.Width > TileRect.Width then
636 Canvas.Font.Height := Trunc(Canvas.Font.Height / TextSize.Width * TileRect.Width);
637 TextSize := Canvas.TextExtent(ValueStr);
638 Canvas.TextOut(TileRect.Left + TileRect.Width div 2 - TextSize.Width div 2,
639 TileRect.Top + TileRect.Height div 2 - TextSize.Height div 2, ValueStr);
640 end;
641end;
642
643procedure TGame.RenderControls(Canvas: TCanvas; Rect: TRect; Horizontal: Boolean);
644var
645 Pos: TPoint;
646 Size: TSize;
647begin
648 if Horizontal then Pos := Point(ScaleY(16, 96), ScaleY(4, 96))
649 else Pos := Point(ScaleY(4, 96), ScaleY(16, 96));
650
651 Size := RenderTextBox(Canvas, Pos, SScore, IntToStr(Score));
652
653 if Horizontal then Pos := Point(ScaleY(16 + 16, 96) + Size.Width, ScaleY(4, 96))
654 else Pos := Point(ScaleY(4, 96), ScaleY(16 + 16, 96) + Size.Height);
655
656 Size := RenderTextBox(Canvas, Pos, STopScore, IntToStr(TopScore));
657end;
658
659function TGame.RenderTextBox(Canvas: TCanvas; Pos: TPoint; Title, Value: string
660 ): TSize;
661var
662 BoxSize: TSize;
663begin
664 with Canvas do begin
665 Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
666 Font.Size := Trunc(ScaleX(BoxFontSize, 96));
667
668 BoxSize := Size(TextWidth(Title), TextHeight(Title) + TextHeight(Value));
669 if BoxSize.Width < TextWidth(Value) then BoxSize.Width := TextWidth(Value);
670 BoxSize := Size(Round(BoxSize.Width * 1.2), Round(BoxSize.Height * 1));
671
672 Brush.Style := bsSolid;
673 Brush.Color := Core.Core.ThemeManager1.ActualTheme.ColorWindow;
674 FillRect(Pos.X, Pos.Y, Pos.X + BoxSize.Width, Pos.Y + BoxSize.Height);
675
676 Brush.Style := bsClear;
677 TextOut(Pos.X + (BoxSize.Width - TextWidth(Title)) div 2, Pos.Y, Title);
678
679 Brush.Style := bsClear;
680 Font.Color := Core.Core.ThemeManager1.ActualTheme.ColorControlText;
681 Font.Size := Trunc(ScaleX(BoxFontSize, 96));
682 TextOut(Pos.X + (BoxSize.Width - TextWidth(Value)) div 2,
683 Pos.Y + TextHeight(Title), Value);
684 end;
685
686 Result := BoxSize;
687end;
688
689function TGame.CanUndo: Boolean;
690begin
691 Result := UndoEnabled and FCanUndo;
692end;
693
694procedure TGame.Undo;
695begin
696 if UndoEnabled and CanUndo then begin
697 Board.Assign(FBoardUndo);
698 FCanUndo := False;
699 Inc(FUsedUndos);
700 FRunning := CanMove;
701 if RecordHistory then History.Moves.Delete(History.Moves.Count - 1);
702 DoChange;
703 DoPaint;
704 end;
705end;
706
707function TGame.CanMergeDirection(Direction: TMoveDirection): Boolean;
708var
709 P: TPoint;
710 PNew: TPoint;
711 I: Integer;
712 Area: TArea;
713begin
714 Result := False;
715 if Direction = drNone then Exit;
716 Area := GetMoveArea(Direction);
717 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
718 P := Area.P1;
719 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
720 P.X := Area.P1.X;
721 while P.X <> Area.P2.X + Area.Increment.X do begin
722 PNew := P + DirectionDiff[Direction];
723 if IsValidPos(PNew) then begin
724 if (Board.Tiles[PNew.Y, PNew.X].Value = 0) then begin
725 Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
726 Board.Tiles[P.Y, P.X].Value := 0;
727 end else
728 if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
729 if CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value) then begin
730 Result := True;
731 Break;
732 end;
733 end;
734 end;
735 Inc(P.X, Area.Increment.Y);
736 end;
737 if Result then Break;
738 Inc(P.Y, Area.Increment.Y);
739 end;
740 end;
741end;
742
743function TGame.CanMoveDirection(Direction: TMoveDirection): Boolean;
744var
745 P: TPoint;
746 PNew: TPoint;
747 Area: TArea;
748begin
749 Result := False;
750 if Direction = drNone then Exit;
751 Area := GetMoveArea(Direction);
752 P := Area.P1;
753 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
754 P.X := Area.P1.X;
755 while P.X <> Area.P2.X + Area.Increment.X do begin
756 PNew := P + DirectionDiff[Direction];
757 if IsValidPos(PNew) then begin
758 if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
759 if ((Board.Tiles[PNew.Y, PNew.X].Value = 0) or
760 CanMergeTile(Board.Tiles[PNew.Y, PNew.X].Value, Board.Tiles[P.Y, P.X].Value)) and
761 not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
762 Result := True;
763 Break;
764 end;
765 end;
766 end;
767 Inc(P.X, Area.Increment.X);
768 end;
769 if Result then Break;
770 Inc(P.Y, Area.Increment.Y);
771 end;
772end;
773
774procedure TGame.MoveAllAnimate(Direction: TMoveDirection);
775var
776 P: TPoint;
777 PNew: TPoint;
778 X, Y: Integer;
779 I: Integer;
780 StartTime: TDateTime;
781 EndTime: TDateTime;
782 Time: TDateTime;
783 Part: Double;
784 Area: TArea;
785 TileMoved: Boolean;
786 SrcTile: TTile;
787 DstTile: TTile;
788 Tile: TTile;
789begin
790 if Direction = drNone then Exit;
791 if not CanMoveDirection(Direction) then Exit;
792 FMoving := True;
793 FBoardUndo.Assign(Board);
794 FCanUndo := True;
795 Area := GetMoveArea(Direction);
796 Board.ClearMerged;
797 for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
798 // Init new values
799 for Y := 0 to Board.Size.Y - 1 do
800 for X := 0 to Board.Size.X - 1 do begin
801 Tile := Board.Tiles[Y, X];
802 Tile.NewValue := Tile.Value;
803 Tile.NewUnmergeable := Tile.Unmergeable;
804 Tile.Action := taNone;
805 end;
806
807 TileMoved := False;
808 P := Area.P1;
809 while P.Y <> Area.P2.Y + Area.Increment.Y do begin
810 P.X := Area.P1.X;
811 while P.X <> Area.P2.X + Area.Increment.X do begin
812 PNew := P + DirectionDiff[Direction];
813 if IsValidPos(PNew) and not Board.Tiles[PNew.Y, PNew.X].Disabled then begin
814 SrcTile := Board.Tiles[P.Y, P.X];
815 DstTile := Board.Tiles[PNew.Y, PNew.X];
816 if (SrcTile.NewValue <> 0) then begin
817 if (DstTile.NewValue = 0) then begin
818 SrcTile.Action := taMove;
819 DstTile.NewValue := SrcTile.NewValue;
820 DstTile.Merged := SrcTile.Merged;
821 DstTile.NewUnmergeable := SrcTile.NewUnmergeable;
822 SrcTile.NewValue := 0;
823 SrcTile.Merged := False;
824 SrcTile.NewUnmergeable := False;
825 TileMoved := True;
826 end else
827 if (not SrcTile.Merged) and (not DstTile.Merged) and
828 CanMergeTile(DstTile.NewValue, SrcTile.NewValue) and
829 not SrcTile.NewUnmergeable and not DstTile.NewUnmergeable then begin
830 SrcTile.Action := taMove;
831 DstTile.NewValue := MergeTile(DstTile.NewValue, SrcTile.NewValue);
832 DstTile.Merged := True;
833 SrcTile.NewValue := 0;
834 SrcTile.Merged := False;
835 Score := Score + GetTileSkinScore(DstTile.NewValue);
836 TileMoved := True;
837 end;
838 end;
839 end;
840 Inc(P.X, Area.Increment.X);
841 end;
842 Inc(P.Y, Area.Increment.Y);
843 end;
844 if not TileMoved then Break;
845
846 // Animate tiles move
847 StartTime := Now;
848 EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
849 if AnimationDuration > 0 then
850 repeat
851 Time := Now;
852 Part := (Time - StartTime) / (EndTime - StartTime);
853 if Part > 1 then Part := 1;
854 for Y := 0 to Board.Size.Y - 1 do
855 for X := 0 to Board.Size.X - 1 do begin
856 if Board.Tiles[Y, X].Action = taMove then
857 Board.Tiles[Y, X].Shift := Point(Trunc(Part * DirectionDiff[Direction].X * 100),
858 Trunc(Part * DirectionDiff[Direction].Y * 100));
859 end;
860 DoPaint;
861 //Application.ProcessMessages;
862 Sleep(AnimationTick);
863 until Time > EndTime;
864
865 // Set final tiles values
866 for Y := 0 to Board.Size.Y - 1 do
867 for X := 0 to Board.Size.X - 1 do begin
868 Tile := Board.Tiles[Y, X];
869 Tile.Value := Tile.NewValue;
870 Tile.Unmergeable := Tile.NewUnmergeable;
871 end;
872 end;
873
874 // Set final tiles values
875 for Y := 0 to Board.Size.Y - 1 do
876 for X := 0 to Board.Size.X - 1 do begin
877 Tile := Board.Tiles[Y, X];
878 if Tile.Merged then
879 Tile.Action := taMerge;
880 Tile.Shift := Point(0, 0);
881 if Tile.Action = taMove then begin
882 Tile.Action := taNone;
883 end;
884 Tile.Value := Tile.NewValue;
885 end;
886 DoPaint;
887 FMoving := False;
888end;
889
890function TGame.CanMergeTile(Value1, Value2: Integer): Boolean;
891begin
892 Result := MergeTile(Value1, Value2) <> -1;
893end;
894
895function TGame.MergeTile(Value1, Value2: Integer): Integer;
896begin
897 if Value1 = Value2 then Result := Value1 + 1
898 else Result := -1;
899end;
900
901procedure TGame.AnimateTiles;
902var
903 StartTime: TDateTime;
904 EndTime: TDateTime;
905 Time: TDateTime;
906 Part: Double;
907 X, Y: Integer;
908begin
909 FMoving := True;
910
911 // Animate tiles move
912 StartTime := Now;
913 EndTime := StartTime + AnimationDuration / 300 * OneSecond / Max(Board.Size.X, Board.Size.Y);
914 if AnimationDuration > 0 then
915 repeat
916 Time := Now;
917 Part := (Time - StartTime) / (EndTime - StartTime);
918 if Part > 1 then Part := 1;
919 for Y := 0 to Board.Size.Y - 1 do
920 for X := 0 to Board.Size.X - 1 do begin
921 if Board.Tiles[Y, X].Action = taAppear then
922 Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
923 if Board.Tiles[Y, X].Action = taMerge then
924 Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
925 end;
926 DoPaint;
927 //Application.ProcessMessages;
928 Sleep(AnimationTick);
929 until Time > EndTime;
930
931 for Y := 0 to Board.Size.Y - 1 do
932 for X := 0 to Board.Size.X - 1 do
933 if Board.Tiles[Y, X].Action <> taNone then begin
934 Board.Tiles[Y, X].Action := taNone;
935 Board.Tiles[Y, X].Shift := Point(0, 0);
936 end;
937 DoPaint;
938 FMoving := False;
939end;
940
941procedure TGame.Replay(History: THistory; Step: Integer);
942var
943 I: Integer;
944begin
945 Board.Clear;
946 Score := 0;
947 for I := 0 to Length(History.InitialTiles) - 1 do begin
948 Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Value := History.InitialTiles[I].Value;
949 Board.Tiles[History.InitialTiles[I].Pos.Y, History.InitialTiles[I].Pos.X].Unmergeable := History.InitialTiles[I].Unmergable;
950 end;
951 for I := 0 to Length(History.DisabledTiles) - 1 do begin
952 Board.Tiles[History.DisabledTiles[I].Y, History.DisabledTiles[I].X].Disabled := True;
953 end;
954 for I := 0 to Step - 1 do
955 with History.Moves[I] do begin
956 MoveAll(Direction, False);
957 if Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
958 Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
959 else raise Exception.Create(STileShouldBeEmpty);
960 end;
961end;
962
963function IntToStrRoman(Num: Integer): string;
964const
965 Nvals = 13;
966 Vals: array [1..Nvals] of Word =
967 (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
968 Roms: array [1..Nvals] of string[2] =
969 ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
970var
971 B: 1..Nvals;
972begin
973 Result := '';
974 B := Nvals;
975 while Num > 0 do
976 begin
977 while Vals[b] > Num do
978 Dec(B);
979 Dec(Num, Vals[B]);
980 Result := Result + Roms[B];
981 end;
982end;
983
984function IntToBin(Num: Integer): string;
985begin
986 Result := '';
987 while Num > 0 do begin
988 Result := IntToStr(Num mod 2) + Result;
989 Num := Num shr 1;
990 end;
991end;
992
993function TGame.GetTileSkinValue(Value: Integer): string;
994begin
995 case FSkin of
996 tsLinear: Result := IntToStr(Value);
997 tsPowerOfTwo: Result := IntToStr(1 shl Value);
998 tsAlpha: Result := Chr(Ord('A') + Value - 1);
999 tsRoman: Result := IntToStrRoman(Value);
1000 tsBinary: Result := IntToBin(Value);
1001 else Result := IntToStr(Value);
1002 end;
1003end;
1004
1005function TGame.GetTileSkinScore(Value: Integer): Integer;
1006begin
1007 case FSkin of
1008 tsLinear: Result := 1 shl Value;
1009 tsPowerOfTwo: Result := 1 shl Value;
1010 tsAlpha: Result := 1 shl Value;
1011 tsRoman: Result := 1 shl Value;
1012 tsBinary: Result := 1 shl Value;
1013 else Result := 1 shl Value;
1014 end;
1015end;
1016
1017procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection; Animation: Boolean);
1018var
1019 HighestValue: Integer;
1020 HistoryMove: THistoryMove;
1021 NewTile: TTile;
1022 X, Y: Integer;
1023begin
1024 if CanMoveDirection(Direction) then begin
1025 HighestValue := Board.GetHighestTileValue;
1026 MoveAll(Direction, Animation);
1027
1028 NewTile := FillRandomTile;
1029 if Animation then AnimateTiles else begin
1030 for Y := 0 to Board.Size.Y - 1 do
1031 for X := 0 to Board.Size.X - 1 do
1032 if Board.Tiles[Y, X].Action <> taNone then begin
1033 Board.Tiles[Y, X].Action := taNone;
1034 Board.Tiles[Y, X].Shift := Point(0, 0);
1035 end;
1036 DoPaint;
1037 end;
1038
1039 if RecordHistory and Assigned(NewTile) then begin
1040 HistoryMove := THistoryMove.Create;
1041 HistoryMove.Direction := Direction;
1042 HistoryMove.NewItemPos := NewTile.Index;
1043 HistoryMove.NewItemValue := NewTile.Value;
1044 History.Moves.Add(HistoryMove);
1045 end;
1046
1047 if not CanMove and (Board.GetEmptyTilesCount = 0) then
1048 GameOver;
1049 if (HighestValue < WinTileValue) and
1050 (Board.GetHighestTileValue >= WinTileValue) then Win;
1051 DoChange;
1052 end;
1053end;
1054
1055procedure TGame.MoveTile(SourceTile, TargetTile: TTile);
1056begin
1057 TargetTile.Value := SourceTile.Value;
1058 SourceTile.Value := 0;
1059 TargetTile.Merged := SourceTile.Merged;
1060 SourceTile.Merged := False;
1061end;
1062
1063function TGame.IsValidPos(Pos: TPoint): Boolean;
1064begin
1065 Result := (Pos.X >= 0) and (Pos.X < Board.Size.X) and
1066 (Pos.Y >= 0) and (Pos.Y < Board.Size.Y);
1067end;
1068
1069procedure TGame.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
1070begin
1071 with Reg do begin
1072 CurrentContext := RegContext;
1073
1074 WriteInteger('TopScore', TopScore);
1075 WriteInteger('AnimationDuration', AnimationDuration);
1076 WriteInteger('Score', Score);
1077 WriteBool('GameRunning', FRunning);
1078 WriteBool('CanUndo', FCanUndo);
1079 WriteBool('UndoEnabled', UndoEnabled);
1080 WriteBool('RecordHistory', RecordHistory);
1081 WriteInteger('Skin', Integer(Skin));
1082 WriteInteger('ColorPalette', Integer(ColorPalette));
1083 WriteInteger('DisabledTilesCount', DisabledTilesCount);
1084 WriteInteger('UnmergeableTilesCount', UnmergeableTilesCount);
1085 WriteInteger('Moves', FMoves);
1086 WriteInteger('UsedUndos', FUsedUndos);
1087 WriteDateTime('StartTime', StartTime);
1088 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
1089 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
1090 InitialBoard.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
1091 History.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
1092 end;
1093end;
1094
1095procedure TGame.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext
1096 );
1097begin
1098 with Reg do begin
1099 CurrentContext := RegContext;
1100 AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
1101 TopScore := ReadIntegerWithDefault('TopScore', 0);
1102 Score := ReadIntegerWithDefault('Score', 0);
1103 FRunning := ReadBoolWithDefault('GameRunning', False);
1104 FCanUndo := ReadBoolWithDefault('CanUndo', False);
1105 UndoEnabled := ReadBoolWithDefault('UndoEnabled', True);
1106 RecordHistory := ReadBoolWithDefault('RecordHistory', False);
1107 Skin := TTileSkin(ReadIntegerWithDefault('Skin', Integer(tsPowerOfTwo)));
1108 ColorPalette := TColorPalette(ReadIntegerWithDefault('ColorPalette', Integer(cpOrangeYellow)));
1109 DisabledTilesCount := ReadIntegerWithDefault('DisabledTilesCount', DisabledTilesCount);
1110 UnmergeableTilesCount := ReadIntegerWithDefault('UnmergeableTilesCount', UnmergeableTilesCount);
1111 FMoves := ReadIntegerWithDefault('Moves', FMoves);
1112 FUsedUndos := ReadIntegerWithDefault('UsedUndos', FUsedUndos);
1113 StartTime := ReadDateTimeWithDefault('StartTime', StartTime);
1114 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
1115 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
1116 InitialBoard.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
1117 History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
1118 end;
1119 DoChange;
1120 DoPaint;
1121end;
1122
1123constructor TGame.Create;
1124begin
1125 AnimationDuration := 30;
1126 AnimationTick := 10; // ms
1127 WinTileValue := 11; // 2^11 = 2048
1128 Board := TBoard.Create;
1129 InitialBoard := TBoard.Create;
1130 FBoardUndo := TBoard.Create;
1131 History := THistory.Create;
1132 Value2Chance := 0.1;
1133end;
1134
1135destructor TGame.Destroy;
1136begin
1137 FreeAndNil(History);
1138 FreeAndNil(FBoardUndo);
1139 FreeAndNil(Board);
1140 FreeAndNil(InitialBoard);
1141 inherited;
1142end;
1143
1144function TGame.GetTileColor(Value: Integer): TColor;
1145var
1146 Color: TPixel32;
1147begin
1148 if (Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameDark) or
1149 ((Core.Core.ThemeManager1.ActualTheme.Name = ThemeNameSystem) and
1150 Core.Core.ThemeManager1.IsDarkTheme)
1151 then begin
1152 case Value of
1153 0: Result := $222629;
1154 1: Result := $dae4ee;
1155 2: Result := $c8e0ed;
1156 3: Result := $79b1f2;
1157 4: Result := $6395f5;
1158 5: Result := $5f7cf6;
1159 6: Result := $3b5ef6;
1160 7: Result := $72cfed;
1161 8: Result := $61cced;
1162 9: Result := $50c8ed;
1163 10: Result := $3fc5ed;
1164 11: Result := $2ec2ed;
1165 else Result := $323a3c;
1166 end;
1167 end else begin
1168 case Value of
1169 0: Result := $f2f6f9;
1170 1: Result := $dae4ee;
1171 2: Result := $c8e0ed;
1172 3: Result := $79b1f2;
1173 4: Result := $6395f5;
1174 5: Result := $5f7cf6;
1175 6: Result := $3b5ef6;
1176 7: Result := $72cfed;
1177 8: Result := $61cced;
1178 9: Result := $50c8ed;
1179 10: Result := $3fc5ed;
1180 11: Result := $2ec2ed;
1181 else Result := $323a3c;
1182 end;
1183 end;
1184
1185 Color.RGB := Result;
1186 case ColorPalette of
1187 cpOrangeYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.G, Color.B));
1188 cpGreenYellow: Result := TColor(TPixel32.CreateRGB(Color.R, Color.B, Color.G));
1189 cpPinkBlue: Result := TColor(TPixel32.CreateRGB(Color.B, Color.R, Color.G));
1190 cpBlueCyan: Result := TColor(TPixel32.CreateRGB(Color.B, Color.G, Color.R));
1191 cpGreenCyan: Result := TColor(TPixel32.CreateRGB(Color.G, Color.B, Color.R));
1192 cpPinkRed: Result := TColor(TPixel32.CreateRGB(Color.G, Color.R, Color.B));
1193 end;
1194end;
1195
1196procedure TGame.SetRecordHistory(AValue: Boolean);
1197begin
1198 if FRecordHistory = AValue then Exit;
1199 FRecordHistory := AValue;
1200 if not FRecordHistory then History.Clear;
1201end;
1202
1203procedure TGame.SetScore(AValue: Integer);
1204begin
1205 if FScore = AValue then Exit;
1206 FScore := AValue;
1207 if FScore > TopScore then TopScore := FScore;
1208end;
1209
1210initialization
1211 Translate;
1212
1213end.
1214
Note: See TracBrowser for help on using the repository browser.