Advertisement
THOMAS_SHELBY_18

07/04 back

Apr 7th, 2024
215
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 19.61 KB | Source Code | 0 0
  1. unit ConstructorUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ExtCtrls;
  8.  
  9. type
  10.   TConstructorForm = class(TForm)
  11.     MainMenu: TMainMenu;
  12.     FileMenuItem: TMenuItem;
  13.     ManualMenuItem: TMenuItem;
  14.     AboutDeveloperMenuItem: TMenuItem;
  15.     LoadTemplateMenuItem: TMenuItem;
  16.     SaveTemplateMenuItem: TMenuItem;
  17.     BackLabel: TLabel;
  18.     StartLabel: TLabel;
  19.     UserFieldImage: TImage;
  20.     HLongShip: TImage;
  21.     HMiddleShip: TImage;
  22.     HSmallShip: TImage;
  23.     HShortShip: TImage;
  24.     VLongShip: TImage;
  25.     VMiddleShip: TImage;
  26.     VSmallShip: TImage;
  27.     VShortShip: TImage;
  28.     procedure LabelMouseEnter(Sender: TObject);
  29.     procedure LabelMouseLeave(Sender: TObject);
  30.     procedure BackLabelClick(Sender: TObject);
  31.     procedure FormShow(Sender: TObject);
  32.     procedure UserFieldImageDragOver(Sender, Source: TObject; X, Y: Integer;
  33.       State: TDragState; var Accept: Boolean);
  34.     procedure UserFieldImageDragDrop(Sender, Source: TObject; X, Y: Integer);
  35.     procedure UserFieldImageMouseDown(Sender: TObject; Button: TMouseButton;
  36.       Shift: TShiftState; X, Y: Integer);
  37.     procedure UserFieldImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  38.       Y: Integer);
  39.     procedure UserFieldImageMouseUp(Sender: TObject; Button: TMouseButton;
  40.       Shift: TShiftState; X, Y: Integer);
  41.     procedure ShipStartDrag(Sender: TObject; var DragObject: TDragObject);
  42.   private
  43.     { Private declarations }
  44.   public
  45.     { Public declarations }
  46.   end;
  47.  
  48. var
  49.   ConstructorForm: TConstructorForm;
  50.  
  51. implementation
  52.  
  53. uses
  54.     GridUnit, FieldGeneratorUnit;
  55.  
  56. const
  57.     CELL_WIDTH = 30;
  58. var
  59.     Field, TempField, NewField: TField;
  60.     IsDrag, IsMovingShipHorizontal: Boolean;
  61.     MovingShipType: TShip;
  62.     ImpossibleCellsMatrix, TempMatrix: TImpossibleCellsMatrix;
  63.     ShipCol, ShipRow: Byte;
  64.     CanPlaceShip: Boolean;
  65.     MovingShip: TImage;
  66.  
  67. {$R *.dfm}
  68.  
  69. procedure TConstructorForm.BackLabelClick(Sender: TObject);
  70. begin
  71.     ConstructorForm.Close;
  72. end;
  73.  
  74. procedure DrawShips();
  75. begin
  76.     with ConstructorForm do
  77.     begin
  78.         DrawShip(HLongShip, 4, 1);
  79.         DrawShip(HMiddleShip, 3, 1);
  80.         DrawShip(HSmallShip, 2, 1);
  81.         DrawShip(HShortShip, 1, 1);
  82.         DrawShip(VLongShip, 1, 4);
  83.         DrawShip(VMiddleShip, 1, 3);
  84.         DrawShip(VSmallShip, 1, 2);
  85.         DrawShip(VShortShip, 1, 1);
  86.     end;
  87. end;
  88.  
  89. procedure TConstructorForm.FormShow(Sender: TObject);
  90. begin
  91.     Field := CreateField();
  92.     ImpossibleCellsMatrix := CreateImpossibleCellsMatrix();
  93.     DrawField(UserFieldImage, Field);
  94.     DrawShips;
  95. end;
  96.  
  97. procedure TConstructorForm.LabelMouseEnter(Sender: TObject);
  98. begin
  99.     with Sender as TLabel do
  100.     begin
  101.         Font.Color := clBlack;
  102.     end;
  103. end;
  104.  
  105. procedure TConstructorForm.LabelMouseLeave(Sender: TObject);
  106. begin
  107.     with Sender as TLabel do
  108.     begin
  109.         Font.Color := clGrayText;
  110.     end;
  111. end;
  112.  
  113. function IsShipFromFormHorizontal(MovingShip: TImage): Boolean;
  114. var
  115.     IsHorizontal: Boolean;
  116. begin
  117.     if MovingShip.Width Div CELL_WIDTH  = 1 then
  118.         IsHorizontal := False
  119.     else
  120.         IsHorizontal := True;
  121.  
  122.    IsShipFromFormHorizontal := IsHorizontal;
  123. end;
  124.  
  125. function CanPlaceShipHere(Field: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean): Boolean;
  126. var
  127.     I: ShortInt;
  128.     CanPlace: Boolean;
  129.     ReturnCellStateFunction: TReturnCellStateFunction;
  130. begin
  131.     I := 0;
  132.     CanPlace := True;
  133.     if IsHorizontal then
  134.         ReturnCellStateFunction := ReturnRowElemState
  135.     else
  136.         ReturnCellStateFunction := ReturnColElemState;
  137.  
  138.     while (I < Ord(Ship)) and CanPlace do
  139.     begin
  140.        CanPlace := ReturnCellStateFunction(Field, Col, Row, I) = stFree;
  141.        Inc(I);
  142.     end;
  143.  
  144.     CanPlaceShipHere := CanPlace;
  145. end;
  146.  
  147. function ConvertImageToShipType(MovingShip: TImage; IsHorizontal: Boolean): TShip;
  148. const
  149.     TempArr: array [1..4] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
  150. var
  151.     DeckCount: Byte;
  152. begin
  153.     if IsHorizontal then
  154.         DeckCount := MovingShip.Width div CELL_WIDTH
  155.     else
  156.         DeckCount := MovingShip.Height div CELL_WIDTH;
  157.  
  158.     ConvertImageToShipType := TempArr[DeckCount];
  159. end;
  160.  
  161. procedure TConstructorForm.ShipStartDrag(Sender: TObject;
  162.   var DragObject: TDragObject);
  163. begin
  164.     MovingShip := TImage(Sender);
  165.     IsMovingShipHorizontal := IsShipFromFormHorizontal(MovingShip);
  166.     MovingShipType := ConvertImageToShipType(MovingShip, IsMovingShipHorizontal);
  167. end;
  168.  
  169. procedure TConstructorForm.UserFieldImageDragOver(Sender, Source: TObject; X,
  170.   Y: Integer; State: TDragState; var Accept: Boolean);
  171. var
  172.     Col, Row: ShortInt;
  173.     DeckCount: Byte;
  174. begin
  175.     Col := X div CELL_WIDTH;
  176.     Row := Y div CELL_WIDTH;
  177.  
  178.     Accept := CanPlaceShipHere(Field, MovingShipType, Col, Row, IsMovingShipHorizontal);
  179.     if Accept then
  180.     begin
  181.         TempField := Field;
  182.         PlaceShip(TempField, MovingShipType, Col, Row, IsMovingShipHorizontal);
  183.         DrawField(UserFieldImage, TempField);
  184.     end;
  185.  
  186.     if State = dsDragLeave then
  187.         DrawField(UserFieldImage, Field);
  188. end;
  189.  
  190. procedure TConstructorForm.UserFieldImageDragDrop(Sender, Source: TObject; X,
  191.   Y: Integer);
  192. var
  193.     Col, Row: Byte;
  194. begin
  195.     Col := X div CELL_WIDTH;
  196.     Row := Y div CELL_WIDTH;
  197.  
  198.     Field := TempField;
  199.     FillImpossibleCellsMatrix(ImpossibleCellsMatrix, MovingShipType, Col, Row, IsMovingShipHorizontal);
  200.  
  201.     DrawField(UserFieldImage, Field);
  202. end;
  203.  
  204. ////////////Поправляем вставленный корабль
  205. function IsShipInFieldHorizontal(Field: TField; Ship: TShip; Col, Row: ShortInt): Boolean;
  206. var
  207.     IsHorizontal: Boolean;
  208. begin
  209.     if Ship = tShortShip then
  210.         IsHorizontal := True
  211.     else
  212.     begin
  213.         if (Field[Col-1, Row] <> stImpossible) or (Field[Col+1, Row] <> stImpossible) then
  214.              IsHorizontal := True
  215.         else
  216.             IsHorizontal := False;
  217.     end;
  218.     IsShipInFieldHorizontal := IsHorizontal;
  219. end;
  220.  
  221. procedure TConstructorForm.UserFieldImageMouseDown(Sender: TObject;
  222.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  223. var
  224.     Col, Row, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow: ShortInt;
  225.     IsShip: Boolean;
  226. begin
  227.     Col := X div CELL_WIDTH;
  228.     Row := Y div CELL_WIDTH;
  229.  
  230.     IsShip := Ord(Field[Col, Row]) > 0;
  231.  
  232.     if IsShip then
  233.     begin
  234.         IsDrag := True;
  235.  
  236.         TempField := Field;
  237.         TempMatrix := ImpossibleCellsMatrix;
  238.  
  239.         MovingShipType := ConvertFieldStateToShip(TempField[Col, Row]);
  240.         IsMovingShipHorizontal := IsShipInFieldHorizontal(TempField, MovingShipType, Col, Row);
  241.  
  242.         FindSideOfShip(TempField, MovingShipType, Col, Row, FirstSideCol, FirstSideRow, IsMovingShipHorizontal, -1);
  243.         FindSideOfShip(TempField, MovingShipType, Col, Row, SecondSideCol, SecondSideRow, IsMovingShipHorizontal, 1);
  244.  
  245.         DeleteShip(TempField, TempMatrix, FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, IsMovingShipHorizontal);
  246.     end;
  247. end;
  248.  
  249. procedure TConstructorForm.UserFieldImageMouseMove(Sender: TObject;
  250.   Shift: TShiftState; X, Y: Integer);
  251. begin
  252.     if IsDrag then
  253.     begin
  254.         ShipCol := X div CELL_WIDTH;
  255.         ShipRow := Y div CELL_WIDTH;
  256.         NewField := TempField;
  257.  
  258.         CanPlaceShip := CanPlaceShipHere(NewField, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);
  259.  
  260.         if CanPlaceShip then
  261.         begin
  262.             PlaceShip(NewField, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);
  263.             DrawField(UserFieldImage, NewField);
  264.         end;
  265.     end;
  266. end;
  267.  
  268. procedure TConstructorForm.UserFieldImageMouseUp(Sender: TObject;
  269.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  270. begin
  271.     if IsDrag and CanPlaceShip then
  272.     begin
  273.         Field := NewField;
  274.         FillImpossibleCellsMatrix(TempMatrix, MovingShipType, ShipCol, ShipRow, IsMovingShipHorizontal);
  275.         ImpossibleCellsMatrix := TempMatrix;
  276.     end;
  277.     IsDrag := False;
  278.     DrawField(UserFieldImage, Field);
  279. end;
  280.  
  281.  
  282. end.
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293. unit FieldGeneratorUnit;
  294.  
  295. interface
  296. type
  297.     TFieldCellState = (stImpossible = -1, stFree, stShortShip, stSmallShip, stMiddleShip, stLongShip);
  298.     TField = array [-1..10, -1..10] of TFieldCellState;
  299.     TImpossibleCellsMatrix = array [-1..10, -1..10] of ShortInt;
  300.  
  301.     TShip = (tShortShip = 1, tSmallShip, tMiddleShip, tLongShip);
  302.     TShipsArray = array [0..9] of TShip;
  303.  
  304.     TReturnCellStateFunction = function (ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
  305.     TPlaceShipProcedure = procedure (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
  306.     TCompareFunction = function(ShootField: TField; Ship: TShip; Col, Row, I: ShortInt): Boolean;
  307.  
  308.     TCellsArray = array [0..99] of Byte;
  309.  
  310.     function CreateField(): TField;
  311.     procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var SideCol: ShortInt; var SideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
  312.     procedure DeleteShip (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col1, Row1, Col2, Row2: ShortInt; IsHorizontal: Boolean);
  313.     function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
  314.     function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
  315.     function ReturnRowElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
  316.     function ReturnColElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
  317.     procedure PlaceShip(var Field: TField; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
  318.     function CreateImpossibleCellsMatrix(): TImpossibleCellsMatrix;
  319.     procedure FillImpossibleCellsMatrix(var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
  320. implementation
  321.  
  322. function CreateField(): TField;
  323. var
  324.     I, J: ShortInt;
  325.     NewField: TField;
  326. begin
  327.     for J := Low(NewField) to High(NewField) do
  328.         NewField[-1, J] := stImpossible;
  329.  
  330.     for I := Low(NewField)+1 to High(NewField)-1 do
  331.     begin
  332.         for J := Low(NewField)+1 to High(NewField)-1 do
  333.             NewField[I, J] := stFree;
  334.         NewField[I, Low(NewField)] := stImpossible;
  335.         NewField[I, High(NewField)] := stImpossible;
  336.     end;
  337.  
  338.     for J := Low(NewField) to High(NewField) do
  339.         NewField[High(NewField), J] := stImpossible;
  340.  
  341.     CreateField := NewField;
  342. end;
  343.  
  344. function CreateImpossibleCellsMatrix(): TImpossibleCellsMatrix;
  345. var
  346.     I, J: ShortInt;
  347.     NewField: TImpossibleCellsMatrix;
  348. begin
  349.     for J := Low(NewField) to High(NewField) do
  350.         NewField[-1, J] := 1;
  351.  
  352.     for I := Low(NewField)+1 to High(NewField)-1 do
  353.     begin
  354.         for J := Low(NewField)+1 to High(NewField)-1 do
  355.             NewField[I, J] := 0;
  356.         NewField[I, Low(NewField)] := 1;
  357.         NewField[I, High(NewField)] := 1;
  358.     end;
  359.  
  360.     for J := Low(NewField) to High(NewField) do
  361.         NewField[High(NewField), J] := 1;
  362.  
  363.     CreateImpossibleCellsMatrix := NewField;
  364. end;
  365.  
  366. function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
  367. const
  368.     TempArr: array [TShip] of TFieldCellState = (stShortShip, stSmallShip, stMiddleShip, stLongShip);
  369. begin
  370.     ConvertShipToFieldState := TempArr[Ship];
  371. end;
  372.  
  373. function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
  374. const
  375.     TempArr: array [stShortShip..stLongShip] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
  376. begin
  377.     ConvertFieldStateToShip := TempArr[FieldState];
  378. end;
  379.  
  380. function CompareCellsVertically(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
  381. begin
  382.     CompareCellsVertically := ShootField[Col, Row+I] = ConvertShipToFieldState(Ship);
  383. end;
  384.  
  385. function CompareCellsHorizontally(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
  386. begin
  387.     CompareCellsHorizontally := ShootField[Col+I, Row] = ConvertShipToFieldState(Ship);
  388. end;
  389.  
  390. procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var SideCol: ShortInt; var SideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
  391. var
  392.     I: ShortInt;
  393.     HasPartOfShip: Boolean;
  394. begin
  395.     if IsHorizontal then
  396.     begin
  397.         I := 0;
  398.         Repeat
  399.             Inc(I);
  400.             HasPartOfShip := CompareCellsHorizontally(ShootField, Ship, Col, Row, DirectionCoef*I);
  401.         Until not HasPartOfShip;
  402.  
  403.         SideRow := Row;
  404.         SideCol := Col + DirectionCoef * I;
  405.     end
  406.     else
  407.     begin
  408.         I := 0;
  409.         Repeat
  410.             Inc(I);
  411.             HasPartOfShip := CompareCellsVertically(ShootField, Ship, Col, Row, DirectionCoef*I);
  412.         Until not HasPartOfShip;
  413.         SideCol := Col;
  414.         SideRow := Row + DirectionCoef * I;
  415.     end;
  416. end;
  417.  
  418. procedure DeleteShipPart (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col, Row: ShortInt);
  419. begin
  420.     Dec(Matrix[Col, Row]);
  421.     if (Matrix[Col, Row] = 0) then
  422.         Field[Col, Row] := stFree;
  423. end;
  424.  
  425. procedure DeleteShip (var Field: TField; var Matrix: TImpossibleCellsMatrix; Col1, Row1, Col2, Row2: ShortInt; IsHorizontal: Boolean);
  426. var
  427.     I: ShortInt;
  428. begin
  429.     if IsHorizontal then
  430.         for I := Col1 to Col2 do
  431.         begin
  432.             DeleteShipPart(Field, Matrix, I, Row1-1);
  433.             DeleteShipPart(Field, Matrix, I, Row1);
  434.             DeleteShipPart(Field, Matrix, I, Row1+1);
  435.         end
  436.     else
  437.         for I := Row1 to Row2 do
  438.         begin
  439.             DeleteShipPart(Field, Matrix, Col1-1, I);
  440.             DeleteShipPart(Field, Matrix, Col1, I);
  441.             DeleteShipPart(Field, Matrix, Col1+1, I);
  442.         end;
  443. end;
  444.  
  445. function ReturnRowElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
  446. begin
  447.     ReturnRowElemState := ShipField[Col+I, Row];
  448. end;
  449.  
  450. function ReturnColElemState(ShipField: TField; Col, Row, I: ShortInt): TFieldCellState;
  451. begin
  452.     ReturnColElemState := ShipField[Col, Row+I];
  453. end;
  454.  
  455. procedure FillImpossibleCellsHorizontal (var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt);
  456. var
  457.     I: ShortInt;
  458. begin
  459.     for I := -1 to Ord(Ship) do
  460.     begin
  461.         Inc(Matrix[X+I, Y-1]);
  462.         Inc(Matrix[X+I, Y]);
  463.         Inc(Matrix[X+I, Y+1]);
  464.     end;
  465. end;
  466.  
  467. procedure FillImpossibleCellsVertical (var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt);
  468. var
  469.     I: ShortInt;
  470. begin
  471.     for I := -1 to Ord(Ship) do
  472.     begin
  473.         Inc(Matrix[X-1, Y+I]);
  474.         Inc(Matrix[X, Y+I]);
  475.         Inc(Matrix[X+1, Y+I]);
  476.     end;
  477. end;
  478.  
  479. procedure FillImpossibleCellsMatrix(var Matrix: TImpossibleCellsMatrix; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
  480. begin
  481.     if IsHorizontal then
  482.         FillImpossibleCellsHorizontal(Matrix, Ship, X, Y)
  483.     else
  484.         FillImpossibleCellsVertical(Matrix, Ship, X, Y);
  485. end;
  486.  
  487. procedure PlaceShipHorizontal (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
  488. var
  489.     I: ShortInt;
  490. begin
  491.     for I := -1 to Ord(Ship) do
  492.     begin
  493.         ShipsField[X+I, Y-1] := stImpossible;
  494.         ShipsField[X+I, Y] := ConvertShipToFieldState(Ship);
  495.         ShipsField[X+I, Y+1] := stImpossible;
  496.     end;
  497.     ShipsField[X-1, Y] := stImpossible;
  498.     ShipsField[X+Ord(Ship), Y] := stImpossible;
  499. end;
  500.  
  501. procedure PlaceShipVertical (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
  502. var
  503.     I: ShortInt;
  504. begin
  505.     for I := -1 to Ord(Ship) do
  506.     begin
  507.         ShipsField[X-1, Y+I] := stImpossible;
  508.         ShipsField[X, Y+I] := ConvertShipToFieldState(Ship);
  509.         ShipsField[X+1, Y+I] := stImpossible;
  510.     end;
  511.     ShipsField[X, Y-1] := stImpossible;
  512.     ShipsField[X, Y+Ord(Ship)] := stImpossible;
  513. end;
  514.  
  515. procedure PlaceShip(var Field: TField; Ship: TShip; X, Y: ShortInt; IsHorizontal: Boolean);
  516. begin
  517.     if IsHorizontal then
  518.         PlaceShipHorizontal (Field, Ship, X, Y)
  519.     else
  520.         PlaceShipVertical (Field, Ship, X, Y);
  521. end;
  522.  
  523. end.
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534. unit GridUnit;
  535.  
  536. interface
  537. uses
  538.     Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  539.     Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ExtCtrls, FieldGeneratorUnit;
  540.  
  541.  
  542.     procedure DrawField(var Image: TImage; StateMatrix: TField);
  543.     procedure DrawShip(var Image: TImage; ColCount, RowCount: Byte);
  544.  
  545. implementation
  546. const
  547.     CELL_WIDTH = 30;
  548.  
  549. procedure DrawShip(var Image: TImage; ColCount, RowCount: Byte);
  550. var
  551.     I, J, X, Y: Byte;
  552.     CurrRect: TRect;
  553. begin
  554.     with Image do
  555.     begin
  556.         Height := RowCount * CELL_WIDTH;
  557.         Width := ColCount * CELL_WIDTH;
  558.  
  559.         Picture := nil;
  560.  
  561.         Canvas.Pen.Color:= clDkGray;
  562.         for I := 0 to RowCount-1 do
  563.         begin
  564.             Y :=  I*CELL_WIDTH;
  565.             for J := 0 to ColCount-1 do
  566.             begin
  567.                 X := J*CELL_WIDTH;
  568.                 CurrRect := Rect(X, Y, X + CELL_WIDTH, Y + CELL_WIDTH);
  569.  
  570.                 Canvas.Brush.Color:=clNavy;
  571.                 Canvas.FillRect(CurrRect);
  572.  
  573.                 Canvas.Rectangle(CurrRect);
  574.             end;
  575.         end;
  576.     end;
  577. end;
  578.  
  579. procedure DrawField(var Image: TImage; StateMatrix: TField);
  580. const
  581.     SIZE = 10;
  582. var
  583.     I, J: ShortInt;
  584.     X, Y: Word;
  585.     CurrRect: TRect;
  586.     CellColor: TColor;
  587. begin
  588.     with Image do
  589.     begin
  590.         Height := SIZE * CELL_WIDTH;
  591.         Width := SIZE * CELL_WIDTH;
  592.  
  593.         Canvas.Pen.Color:=clSkyBlue;
  594.         for I := Low(StateMatrix)+1 to High(StateMatrix)-1 do
  595.         begin
  596.             Y :=  I*CELL_WIDTH;
  597.             for J := Low(StateMatrix)+1 to High(StateMatrix)-1 do
  598.             begin
  599.                 X := J*CELL_WIDTH;
  600.                 CurrRect := Rect(X, Y, X + CELL_WIDTH, Y + CELL_WIDTH);
  601.  
  602.                 case StateMatrix[J, I] of
  603.                     stImpossible: CellColor := clGrayText;
  604.                     stFree: CellColor := clWhite;
  605.                 else
  606.                     CellColor := clBlue;
  607.                 end;
  608.  
  609.                 Canvas.Brush.Color:=CellColor;
  610.                 Canvas.FillRect(CurrRect);
  611.  
  612.                 Canvas.Rectangle(CurrRect);
  613.             end;
  614.         end;
  615.     end;
  616. end;
  617.  
  618. end.
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629. unit StartUnit;
  630.  
  631. interface
  632.  
  633. uses
  634.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  635.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.StdCtrls, ConstructorUnit;
  636.  
  637. type
  638.   TStartForm = class(TForm)
  639.     BackgroundImage: TImage;
  640.     StartLabel: TLabel;
  641.     SettingsLabel: TLabel;
  642.     AboutDeveloperLabel: TLabel;
  643.     ManualLabel: TLabel;
  644.     ExitLabel: TLabel;
  645.     procedure LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
  646.       Y: Integer);
  647.     procedure LabelMouseLeave(Sender: TObject);
  648.     procedure LabelMouseEnter(Sender: TObject);
  649.     procedure ExitLabelClick(Sender: TObject);
  650.     procedure StartLabelClick(Sender: TObject);
  651.   private
  652.     { Private declarations }
  653.   public
  654.     { Public declarations }
  655.   end;
  656.  
  657. var
  658.   StartForm: TStartForm;
  659.  
  660. implementation
  661.  
  662. {$R *.dfm}
  663.  
  664. procedure TStartForm.ExitLabelClick(Sender: TObject);
  665. begin
  666.     StartForm.Close;
  667. end;
  668.  
  669. procedure TStartForm.LabelMouseEnter(Sender: TObject);
  670. begin
  671.     with Sender as TLabel do
  672.     begin
  673.         Font.Color := clBlack;
  674.     end;
  675. end;
  676.  
  677. procedure TStartForm.LabelMouseLeave(Sender: TObject);
  678. begin
  679.     with Sender as TLabel do
  680.     begin
  681.         Font.Color := clGrayText;
  682.     end;
  683. end;
  684.  
  685. procedure TStartForm.LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
  686.   Y: Integer);
  687. begin
  688.     with Sender as TLabel do
  689.     begin
  690.         Font.Color := clBlack;
  691.     end;
  692. end;
  693.  
  694. procedure TStartForm.StartLabelClick(Sender: TObject);
  695. begin
  696.     StartForm.Hide;
  697.     ConstructorForm.ShowModal;
  698.     StartForm.Show;
  699. end;
  700.  
  701. end.
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement