Закончил Columns из 7-й главы, седьмого упражнения
This commit is contained in:
@@ -0,0 +1,84 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="columns"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="columns.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Unit2"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="columns"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,28 @@
|
||||
program columns;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
{$IFDEF HASAMIGA}
|
||||
athreads,
|
||||
{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, Unit2
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Scaled:=True;
|
||||
{$PUSH}{$WARN 5044 OFF}
|
||||
Application.MainFormOnTaskbar:=True;
|
||||
{$POP}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,182 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectSession>
|
||||
<Version Value="12"/>
|
||||
<BuildModes Active="Default"/>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="columns.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<EditorIndex Value="-1"/>
|
||||
<WindowIndex Value="-1"/>
|
||||
<TopLine Value="-1"/>
|
||||
<CursorPos X="-1" Y="-1"/>
|
||||
<UsageCount Value="61"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<TopLine Value="271"/>
|
||||
<CursorPos Y="299"/>
|
||||
<UsageCount Value="61"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Unit2"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<CursorPos X="14" Y="8"/>
|
||||
<UsageCount Value="61"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="/usr/share/lazarus/lcl/interfaces/qt5/qtobject.inc"/>
|
||||
<EditorIndex Value="-1"/>
|
||||
<TopLine Value="920"/>
|
||||
<CursorPos X="26" Y="950"/>
|
||||
<UsageCount Value="7"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="/usr/src/fpc-3.2.2/packages/fcl-image/src/fpcanvas.pp"/>
|
||||
<UnitName Value="FPCanvas"/>
|
||||
<EditorIndex Value="-1"/>
|
||||
<TopLine Value="328"/>
|
||||
<CursorPos X="20" Y="377"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
<JumpHistory HistoryIndex="29">
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="177" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="177" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="177" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="177" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="177" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="179" TopLine="169"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="221" TopLine="170"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="233" Column="7" TopLine="179"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="164" Column="41" TopLine="148"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="242" Column="23" TopLine="195"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="220" Column="27" TopLine="212"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="51" Column="28" TopLine="49"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="301" Column="30" TopLine="297"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="310" Column="14" TopLine="276"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="301" Column="37" TopLine="264"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="283" Column="19" TopLine="272"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="301" Column="13" TopLine="271"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="23" Column="15"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="24" Column="15"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="301" Column="9" TopLine="258"/>
|
||||
</Position>
|
||||
</JumpHistory>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes ActiveMode=""/>
|
||||
</RunParams>
|
||||
</ProjectSession>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,65 @@
|
||||
object Form1: TForm1
|
||||
Left = 548
|
||||
Height = 1018
|
||||
Top = 198
|
||||
Width = 669
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 1018
|
||||
ClientWidth = 669
|
||||
DesignTimePPI = 144
|
||||
LCLVersion = '4.6.0.0'
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnKeyUp = FormKeyUp
|
||||
object Screen: TImage
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrCenter
|
||||
Left = 34
|
||||
Height = 800
|
||||
Top = 0
|
||||
Width = 600
|
||||
end
|
||||
object BackBuffer: TImage
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrCenter
|
||||
Left = 34
|
||||
Height = 800
|
||||
Top = 0
|
||||
Width = 600
|
||||
end
|
||||
object ScoreLabel1: TLabel
|
||||
AnchorSideLeft.Control = Screen
|
||||
AnchorSideTop.Control = Screen
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 34
|
||||
Height = 39
|
||||
Top = 825
|
||||
Width = 69
|
||||
BorderSpacing.Top = 25
|
||||
Caption = 'Счет:'
|
||||
Font.Height = -28
|
||||
Font.Name = 'Noto Sans'
|
||||
ParentFont = False
|
||||
end
|
||||
object ScoreLabel: TLabel
|
||||
AnchorSideLeft.Control = ScoreLabel1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = ScoreLabel1
|
||||
Left = 123
|
||||
Height = 39
|
||||
Top = 825
|
||||
Width = 16
|
||||
BorderSpacing.Left = 20
|
||||
Caption = '0'
|
||||
Font.Height = -28
|
||||
Font.Name = 'Noto Sans'
|
||||
ParentFont = False
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,429 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
|
||||
Unit2, LCLType;
|
||||
|
||||
const
|
||||
{ Ширина и высота игрового поля. }
|
||||
FieldWidth = 10;
|
||||
FieldHeight = 20;
|
||||
CellSize = 30;
|
||||
Delay = 3; { Задержка падения фигуры в кадрах. }
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
ScoreLabel1: TLabel;
|
||||
ScoreLabel: TLabel;
|
||||
Screen: TImage;
|
||||
BackBuffer: TImage;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
private
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
TGameHandler = class Sealed(IGameHandler)
|
||||
private
|
||||
v: Integer; { Счетчик кадров. }
|
||||
public
|
||||
procedure DoIteration; override;
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
ActionThread: TActionThread;
|
||||
Field: array[-1..FieldWidth, 0..FieldHeight] of Integer; { Игровое поле. }
|
||||
{ Состояния клавиш. }
|
||||
PressedSpace, PressedLeft, PressedRight, PressedDown: Boolean;
|
||||
CurrentColor: array[1..3] of Integer;
|
||||
CurrentX, CurrentY, Score: Integer;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ Изменение размера поля в зависимости от количества и величины клеток. }
|
||||
procedure ResizeField;
|
||||
begin
|
||||
Form1.Screen.Width := CellSize * FieldWidth;
|
||||
Form1.Screen.Height := CellSize * FieldHeight;
|
||||
Form1.BackBuffer.Width := Form1.Screen.Width;
|
||||
Form1.BackBuffer.Height := Form1.Screen.Height
|
||||
end;
|
||||
|
||||
{ Инициализация игрового поля. }
|
||||
procedure InitField;
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
{ Заполняем собственно поле нулями }
|
||||
{ (соответствующими свободному пространству). }
|
||||
for i := 0 to FieldWidth - 1 do
|
||||
for j := 0 to FieldHeight - 1 do
|
||||
begin
|
||||
Field[i, j] := 0;
|
||||
{ Очистка экрана. }
|
||||
Form1.BackBuffer.Canvas.Clear
|
||||
end;
|
||||
|
||||
{ Помечаем участки, находящиеся под "стаканом", как занятые. }
|
||||
for i := 0 to FieldWidth - 1 do
|
||||
Field[i, FieldHeight] := 1;
|
||||
|
||||
{ Таким же образом помечаем участки слева и справа от поля. }
|
||||
for j := 0 to FieldHeight do
|
||||
begin
|
||||
Field[-1, j] := 1;
|
||||
Field[FieldWidth, j] := 1
|
||||
end
|
||||
end;
|
||||
|
||||
{ Можно ли поместить фигуру в (x, y)? }
|
||||
function CanPlace(x, y: Integer): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to 2 do
|
||||
if Field[x, y + i] <> 0 then
|
||||
begin
|
||||
Result := false;
|
||||
Exit
|
||||
end;
|
||||
Result := true
|
||||
end;
|
||||
|
||||
procedure DrawPiece(x, y: Integer; Color: array of Integer);
|
||||
var
|
||||
i: Integer;
|
||||
BrushColor: TColor;
|
||||
begin
|
||||
for i := 0 to 2 do
|
||||
begin
|
||||
case Color[i] of
|
||||
0:
|
||||
BrushColor := clWhite;
|
||||
1:
|
||||
BrushColor := clGreen;
|
||||
2:
|
||||
BrushColor := clBlue;
|
||||
3:
|
||||
BrushColor := clYellow;
|
||||
4:
|
||||
BrushColor := clRed
|
||||
end;
|
||||
|
||||
Form1.BackBuffer.Canvas.Brush.Color := BrushColor;
|
||||
Form1.BackBuffer.Canvas.FillRect(x * CellSize, (y + i) * CellSize,
|
||||
(x + 1) * CellSize - 1, (y + i + 1) * CellSize - 1);
|
||||
Field[x, y + i] := Color[i]
|
||||
end
|
||||
end;
|
||||
|
||||
procedure DrawPiece(x, y: Integer);
|
||||
var
|
||||
ClearColor: array[1..3] of Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 1 to High(ClearColor) do
|
||||
ClearColor[i] := 0;
|
||||
DrawPiece(x, y, ClearColor)
|
||||
end;
|
||||
|
||||
{ Цвет фигуры выбирается случайным образом. }
|
||||
procedure RandomizeColor;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 1 to High(CurrentColor) do
|
||||
CurrentColor[i] := Random(4) + 1
|
||||
end;
|
||||
|
||||
procedure MoveColors;
|
||||
var
|
||||
TemporaryColor: Integer;
|
||||
begin
|
||||
TemporaryColor := CurrentColor[1];
|
||||
CurrentColor[1] := CurrentColor[3];
|
||||
CurrentColor[3] := CurrentColor[2];
|
||||
CurrentColor[2] := TemporaryColor
|
||||
end;
|
||||
|
||||
{ Сдвиг поля (уничтожение линий). }
|
||||
function ShiftFieldHorizontally: Integer;
|
||||
var
|
||||
CurrentLine, CurrentColumn: Integer;
|
||||
i, j: Integer;
|
||||
OfSameColor: Cardinal;
|
||||
LastColor: Integer;
|
||||
begin
|
||||
{ Начинаем в левом нижнем углу. }
|
||||
CurrentLine := FieldHeight - 1;
|
||||
CurrentColumn := 0;
|
||||
OfSameColor := 0;
|
||||
LastColor := 0;
|
||||
Result := 0;
|
||||
|
||||
while CurrentLine >= 0 do
|
||||
begin
|
||||
while CurrentColumn < FieldWidth do
|
||||
begin
|
||||
if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then
|
||||
Inc(OfSameColor)
|
||||
else
|
||||
begin
|
||||
LastColor := Field[CurrentColumn, CurrentLine];
|
||||
|
||||
if OfSameColor >= 3 then
|
||||
begin
|
||||
Inc(Result);
|
||||
|
||||
{ Сдвигаем верхнюю часть поля вниз. }
|
||||
for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do
|
||||
for j := CurrentLine downto 1 do
|
||||
Field[i, j] := Field[i, j - 1];
|
||||
|
||||
{ Сдвигаем вниз также изображение на экране. }
|
||||
i := (CurrentColumn - OfSameColor) * CellSize;
|
||||
j := CurrentColumn * CellSize - 1;
|
||||
Form1.BackBuffer.Canvas.CopyRect(
|
||||
Rect(i, CellSize, j, (CurrentLine + 1) * CellSize - 1),
|
||||
Form1.BackBuffer.Canvas,
|
||||
Rect(i, 0, j, CurrentLine * CellSize - 1)
|
||||
);
|
||||
|
||||
{ Самая верхняя строка поля теперь пуста. Заполняем ее нулями. }
|
||||
Form1.BackBuffer.Canvas.Brush.Color := clWhite;
|
||||
for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do
|
||||
begin
|
||||
Field[i, 0] := 0;
|
||||
Form1.BackBuffer.Canvas.FillRect(i * CellSize, 0,
|
||||
(i + 1) * CellSize - 1, CellSize - 1)
|
||||
end;
|
||||
CurrentColumn := -1
|
||||
end;
|
||||
|
||||
if LastColor = 0 then
|
||||
OfSameColor := 0
|
||||
else
|
||||
OfSameColor := 1
|
||||
end;
|
||||
Inc(CurrentColumn)
|
||||
end;
|
||||
CurrentColumn := 0;
|
||||
Dec(CurrentLine)
|
||||
end
|
||||
end;
|
||||
|
||||
function ShiftFieldVertically: Integer;
|
||||
var
|
||||
CurrentColumn, CurrentLine: Integer;
|
||||
LastColor: Integer;
|
||||
OfSameColor: Cardinal;
|
||||
i, j: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
CurrentColumn := 0;
|
||||
CurrentLine := FieldHeight - 1;
|
||||
LastColor := 0;
|
||||
OfSameColor := 0;
|
||||
|
||||
while CurrentColumn < FieldWidth do
|
||||
begin
|
||||
while CurrentLine >= 0 do
|
||||
begin
|
||||
if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then
|
||||
Inc(OfSameColor)
|
||||
else
|
||||
begin
|
||||
LastColor := Field[CurrentColumn, CurrentLine];
|
||||
|
||||
if OfSameColor >= 3 then
|
||||
begin
|
||||
Inc(Result);
|
||||
|
||||
{ Сдвигаем верхнюю часть поля вниз. }
|
||||
for i := CurrentLine downto 0 do
|
||||
Field[CurrentColumn, i + OfSameColor] := Field[CurrentColumn, i];
|
||||
|
||||
{ Сдвигаем вниз также изображение на экране. }
|
||||
i := (CurrentLine + OfSameColor + 1) * CellSize - 1;
|
||||
j := (CurrentColumn + 1) * CellSize - 1;
|
||||
Form1.BackBuffer.Canvas.CopyRect(
|
||||
Rect(CurrentColumn * CellSize, OfSameColor * CellSize, j, i),
|
||||
Form1.BackBuffer.Canvas,
|
||||
Rect(CurrentColumn * CellSize, 0, j, (CurrentLine + 1) * CellSize - 1)
|
||||
);
|
||||
|
||||
{ Верхние строки поля теперь пустые. Заполняем ее нулями. }
|
||||
Form1.BackBuffer.Canvas.Brush.Color := clWhite;
|
||||
for i := 0 to OfSameColor - 1 do
|
||||
begin
|
||||
Field[CurrentColumn, i] := 0;
|
||||
Form1.BackBuffer.Canvas.FillRect(CurrentColumn * CellSize, i * CellSize,
|
||||
(CurrentColumn + 1) * CellSize - 1, (i + 1) * CellSize - 1)
|
||||
end;
|
||||
CurrentLine := FieldHeight
|
||||
end;
|
||||
|
||||
if LastColor = 0 then
|
||||
OfSameColor := 0
|
||||
else
|
||||
OfSameColor := 1
|
||||
end;
|
||||
Dec(CurrentLine)
|
||||
end;
|
||||
CurrentLine := FieldHeight - 1;
|
||||
Inc(CurrentColumn)
|
||||
end
|
||||
end;
|
||||
|
||||
procedure ShiftField;
|
||||
var
|
||||
RoundScore: Integer;
|
||||
begin
|
||||
repeat
|
||||
RoundScore := ShiftFieldHorizontally;
|
||||
RoundScore := RoundScore + ShiftFieldVertically;
|
||||
Score := Score + RoundScore
|
||||
until RoundScore = 0;
|
||||
|
||||
Form1.ScoreLabel.Caption := IntToStr(Score)
|
||||
end;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
GameHandler: TGameHandler;
|
||||
begin
|
||||
Score := 0;
|
||||
Randomize;
|
||||
|
||||
ResizeField;
|
||||
InitField;
|
||||
|
||||
{ Текущее значение Y-координаты, равное -1 служит индикатором }
|
||||
{ отсутствия движущихся фигур инициализация переменных. }
|
||||
CurrentX := -1;
|
||||
CurrentY := -1;
|
||||
|
||||
GameHandler := TGameHandler.Create;
|
||||
ActionThread := TActionThread.Create(GameHandler)
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
ActionThread.GameHandler.Finished := true;
|
||||
ActionThread.WaitFor;
|
||||
FreeAndNil(ActionThread)
|
||||
end;
|
||||
|
||||
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
|
||||
);
|
||||
begin
|
||||
case Key of
|
||||
VK_SPACE:
|
||||
PressedSpace := true;
|
||||
VK_LEFT:
|
||||
PressedLeft := true;
|
||||
VK_RIGHT:
|
||||
PressedRight := true;
|
||||
VK_DOWN:
|
||||
PressedDown := true
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
case Key of
|
||||
VK_SPACE:
|
||||
PressedSpace := false;
|
||||
VK_LEFT:
|
||||
PressedLeft := false;
|
||||
VK_RIGHT:
|
||||
PressedRight := false;
|
||||
VK_DOWN:
|
||||
PressedDown := false
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TGameHandler.DoIteration;
|
||||
begin
|
||||
{ Если на экране нет движущихся фигур. }
|
||||
if CurrentY = -1 then
|
||||
begin
|
||||
{ Создаем новую фигуру в верхней части экрана. }
|
||||
CurrentY := 0;
|
||||
CurrentX := FieldWidth div 2;
|
||||
RandomizeColor;
|
||||
|
||||
{ если ее нельзя разместить, конец игры }
|
||||
if not CanPlace(CurrentX, CurrentY) then
|
||||
begin
|
||||
Finished := true;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
DrawPiece(CurrentX, CurrentY); { Стираем фигуру с экрана. }
|
||||
|
||||
{ Если нажата клавиша "вниз", увеличиваем скорость игры. }
|
||||
if PressedDown then
|
||||
SlowDown
|
||||
else
|
||||
SpeedUp;
|
||||
|
||||
if PressedLeft and CanPlace(CurrentX - 1, CurrentY) then
|
||||
Dec(CurrentX); { сдвиг фигуры влево }
|
||||
if PressedRight and CanPlace(CurrentX + 1, CurrentY) then
|
||||
Inc(CurrentX); { сдвиг фигуры вправо }
|
||||
|
||||
{ Прокручивание цветов. }
|
||||
if PressedSpace then
|
||||
MoveColors;
|
||||
|
||||
Inc(v); { Увеличиваем счетчик кадров. }
|
||||
|
||||
{ Если на текущей итерации нет вертикального сдвига. }
|
||||
if v < Delay then
|
||||
DrawPiece(CurrentX, CurrentY, CurrentColor)
|
||||
else
|
||||
{ Рисуем фигуру иначе. }
|
||||
begin
|
||||
if CanPlace(CurrentX, CurrentY + 1) then
|
||||
begin
|
||||
v := 0;
|
||||
{ Если фигуру можно разместить, размещаем. }
|
||||
Inc(CurrentY);
|
||||
DrawPiece(CurrentX, CurrentY, CurrentColor)
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Иначе оставляем на прежнем месте. }
|
||||
DrawPiece(CurrentX, CurrentY, CurrentColor);
|
||||
ShiftField; { Уничтожаем собранные линии. }
|
||||
CurrentY := -1 { На экране больше нет движущихся фигур. }
|
||||
end
|
||||
end;
|
||||
|
||||
{ Обновляем содержимое экрана (копируем буфер на экран). }
|
||||
Form1.Screen.Canvas.CopyRect(
|
||||
Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height),
|
||||
Form1.BackBuffer.Canvas,
|
||||
Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height))
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,86 @@
|
||||
unit Unit2;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
const
|
||||
StartMSecsPerFrame = 20;
|
||||
|
||||
type
|
||||
IGameHandler = class(TObject)
|
||||
private
|
||||
MSecsPerFrame: Integer;
|
||||
|
||||
public
|
||||
Finished: Boolean;
|
||||
constructor Create;
|
||||
procedure DoIteration; virtual; abstract;
|
||||
|
||||
procedure SlowDown;
|
||||
procedure SpeedUp;
|
||||
end;
|
||||
|
||||
TActionThread = class(TThread)
|
||||
private
|
||||
FGameHandler: IGameHandler;
|
||||
|
||||
public
|
||||
constructor Create(AGameHandler: IGameHandler);
|
||||
destructor Destroy;
|
||||
|
||||
property GameHandler: IGameHandler read FGameHandler;
|
||||
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor IGameHandler.Create;
|
||||
begin
|
||||
Finished := false;
|
||||
MSecsPerFrame := StartMSecsPerFrame
|
||||
end;
|
||||
|
||||
procedure IGameHandler.SlowDown;
|
||||
begin
|
||||
MSecsPerFrame := StartMSecsPerFrame
|
||||
end;
|
||||
|
||||
procedure IGameHandler.SpeedUp;
|
||||
begin
|
||||
MSecsPerFrame := 100
|
||||
end;
|
||||
|
||||
constructor TActionThread.Create(AGameHandler: IGameHandler);
|
||||
begin
|
||||
inherited Create(false);
|
||||
FGameHandler := AGameHandler
|
||||
end;
|
||||
|
||||
destructor TActionThread.Destroy;
|
||||
begin
|
||||
FreeAndNil(FGameHandler)
|
||||
end;
|
||||
|
||||
procedure TActionThread.Execute;
|
||||
var
|
||||
OldTime: TDateTime;
|
||||
ToWait: Integer;
|
||||
begin
|
||||
while not GameHandler.Finished do
|
||||
begin
|
||||
OldTime := Now;
|
||||
Synchronize(@FGameHandler.DoIteration);
|
||||
{ Синхронизация с таймером. }
|
||||
ToWait := Round(GameHandler.MSecsPerFrame - (Now - OldTime) * MSecsPerDay);
|
||||
if ToWait > 0 then
|
||||
Sleep(ToWait)
|
||||
end
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user