Russian square source code

.dfmobject Form1: TForm1 Left = 175 Top = 98 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'Form1' ClientHeight = 409 ClientWidth = 253 Color = clGray Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = - 11 Font.Name = 'MS Sans Serif' Font.Style = [] KeyPreview = True Menu = MainMenu1 OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy OnKeyDown = FormKeyUp OnPaint = FormPaint PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 168 Top = 40 Width = 73 Height = 57 AutoSize = False Font.Charset = DEFAULT_CHARSET Font.Color = clNavy Font.Height = -24 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] ParentFont = False end object Label2 : TLabel Left = 168 Top = 16 Width = 73 Height = 25 AutoSize = False Caption = # 24471 # 20998 Color = clSilver Font.Charset = DEFAULT_CHARSET Font.Color = clBlue Font.Height = -16 Font.Name = 'MS Sans Serif 'Font.Style = [fsBold] ParentColor = False ParentFont = False Transparent = True end object Label3: TLabel Left = 168 Top = 104 Width = 81 Height = 73 AutoSize = False Color = clPurple ParentColor = False end object Panel1: TPanel Left = 16 TOP = 16 width = 150 height = 300 bevelouter = bvlowered color = clmoneygreen taborder = 0 End Object Timer1: TTIMER enabled = false interval =

550 OnTimer = Timer1Timer Left = 224 Top = 248 end object MainMenu1: TMainMenu Left = 224 Top = 280 object N1: TMenuItem Caption = # 28216 # 25103 object N2: TMenuItem Caption = # 24320 # 22987 ShortCut = 119 OnClick = N2Click end object N3 : TMenuItem Caption = # 20572 # 27490 ShortCut = 113 OnClick = N3Click end object N4: TMenuItem Caption = '-' end object N5: TMenuItem Caption = # 26242 # 20572 Enabled = False ShortCut = 116 OnClick = N5Click end object N6: TMenuItem Caption = # 32487 # 32493 enabled = false shortcut = 117 onclick = n6click end end12.pasunit rusianfrm;

Interface

Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, Stdctrls, Menus; {Type Tpos = Array [1..3] of integer;} type tcurshape = array [1..3, 1..2] of integer; type tcont = array [-1..21, 1..10] of boolean; type tclearlines = array [2..5] of integer; type tform1 = class (tform) Panel1: TPANEL ; Timer1: TTimer; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; Label1: TLabel; Label2: TLabel; Label3: TLabel; procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Timer1Timer (Sender: TObject); procedure N2Click (Sender: TObject); procedure N3Click (Sender: TObject ); Procedure N5Click (sender: TOBJECT); Procedure N6Click (sender: TOBJECT); Procedure FormPaint; Private {private declarations} public procedure drawshape (canvas1: tcontrolcanvas; a: tpoint; shape1: tcurshape; isclear: bool); procedure rerote (var a: tcurshape); procedure fillcurshape1 (shapecode: integer; var ab: tcurshape); procedure getshapesuperxy (a: tpoint; b: TCURSHAPE; VAR Minx, Miny, Maxx, Maxy: Integer; Function GetNewpos (VAR A: TPOINT): Integer; Function Locate (var A: Tcurshape; var B: tcont): Integer; function isxist (var A: tpoint; b : tcurshape; c: tcont): Integer; function isfullline (b: integer; l: integer; c: tcont; var f: tclearlines): integer; procedure ClearLines (A: tclearlines; b: integer; procedure redraw1 (); process; Function Putup (): Integer; procated islost (): integer; procedure drawnextshape (); Procedure GolefTright (LR: Integer; A: tpoint;

b: tcurshape); {Public declarations} end; const line: integer = 1; const rightgun: integer = 2; const leftgun: integer = 3; const rightgene: integer = 4; const leftgene: integer = 5; const threesharpe: integer = 6; Const Square: integer = 7; const atomsize: integer = 15; var form1: tform1; contcanvas: tcontrolcanvas; shape: array [1..7, 1..3, 1..2] of integer; curpos: TPOINT; CURSHAPE: TCURSHAPE; Cont: Tcont; IsoRuning, Score, NextShape: Integer; Implementation {$ r * .dfm} function TFORM1.ISLOST (): Integer; // Has been filled in Dalg VARI: Integer; beginislost: = 0 For i: = 0 to 9 dobeginif Cont [0] [i] thenbeginislost: = 1; Break; end; end; end; procedure tform1.initc (); // Initializing the container and current block position VARI, J: Integer; Beginism: = 1; score: = 0; for i: = 0 to 19 do for j: = 0 to 9 do cont [i] [j]: = false; curpos.x: = 5; curpos.y: = 0 RDomize;: = (Random (3000) 1) MOD 7 1; NextShape: = (Random (2800) 1) MOD 7 1; Self.Drawnextshape; FillCurshape1 (i, curshape); end; procedure tform1 . Form: TOBJECT; VarcontainerHDC: HDC; Begin Shape [line] [1] [1]: = 1; // Strip Shape [line] [1] [2]: = 0; // Shape [line] [2] [1]: = - 1; // Shape [line] [2] [2]: = 0 ; // shape [line] [3] [1]: = - 2; // shape [line] [3] [2]: = 0; //

Shape [rightgun] [1] [1]: = 0; // shape [rightgun] [1] [2]: = - 1; // Shape [Rightgun] [2] [1]: = 0; // Shape [RightGun] [2] [2]: = 1; // L Shape [Rightgun] [3] [1]: = 1; // Shape [Rightgun] [3] [2]: = 1; //

Shape [Leftgun] [1] [1]: = 0; // Shape [Leftgun] [1] [2]: = - 1; // Shape [Leftgun] [2] [1]: = 0; // Shape [Leftgun] [2] [2]: = 1; // Anti-l Shape [Leftgun] [3] [1]: = - 1; // Shape [Leftgun] [3] [2]: = 1; // Shape [RightGene] [1] [1]: = 0; // Shape [RightGene] [1] [2]: = - 1; // Shape [RightGene] [2] [1]: = 1; // Shape [RightGene] [2] [2]: = 0; // Shape [RightGene] [3] [1]: = 1; // Shape [RightGENE] [3] [2]: = 1; //

Shape [LeftGene] [1] [1]: = 0; // Shape [LeftGene] [1] [2]: = - 1; // Shape [LeftGene] [2] [1]: = - 1; // Shape [LeftGene] [2] [2]: = 0; // Shape [LeftGene] [3] [1]: = - 1; // Shape [LeftGene] [3] [2]: = 1; //

Shape [threeesharpe] [1] [1]: = - 1; // Shape [threeesharpe] [1] [2]: = 0; // shape [threeesharpe] [2] [1]: = 1; // Shape [threeesharpe] [2] [2]: = 0; // Shape [threeesharpe] [3] [1]: = 0; // Shape [threeesharpe] [3] [2]: = 1; //

Shape [Square] [1] [1]: = 1; // Shape [Square] [1] [2]: = 0; // Shape [Square] [2] [1]: = 0; // Shape Square] [2] [2]: = 1; // Shape [Square] [3] [1]: = 1; // Shape [Square] [3] [2]: = 1; // ContainerHDC: = Getdc (panel1.Handle); ContCanvas: = tcontrolcanvas.Create; ContCanvas.Handle: = containerhdc; end; procedure TForm1.FormDestroy (Sender: TObject); beginContCanvas.FreeHandle; ContCanvas.Free; end; procedure tform1.goleftright (lr: integer A: TPOINT; B: TCURSHAPE); // Control to the left, right shift VARI: Integer; Beginseelf.drawshape; AX: = A. X LR; i: = self.isexist (A, B, CONT); if i <> 1 dam.x: = a.xelseif (curpos.x> = 1) AND (lr = -1) or (curpos.x <9) and (Curpos.x <9) LR = 1) Thencurpos.x: = Curpos.x lr; end; self.drawshape (Contcanvas, Curpos, Curshape, False); End; Procedure TFORM1.FORMKEYUP (Sender: Tobject; var Key: Word; Shift: tshiftstate) Vara, F: tpoint; b: tcurshape; i, j, m, n: integer; beginif isruning <> 1 thenexit; ax: = curpos.x; ay: = curpos.y; for i: = 1 to 3 dobeginb [i] [1]: = CURSHA PE [I] [1]; B [i] [2]: = Curshape [i] [2]; end; case key of37: beginself.goleftright (-1, a, b); end; 38, 16: / / Rotate Beginseelf.drawshape (Contcanvas, Curpos, Curshape, True); Self.Rerote (Curshape); i: = self.isexist (A, Curshape, Cont); if (i <> 1) Thenbeginif i = 2 ThencurPos.x : = ax; end; self.drawshape (Contcanvas, Curpos, Curshape, False); Self.putup; End; 39: Beginseelf.golefTright (1, A, B); END; 40: Begintimer1.interval: = 1; END; ;

Function TFORM1.ISFULLLLINE (B: Integer; L: Integer; C: Tcont; var f: tclearlines): Integer; var // detection There are several lines filled with I, J, M: Integer; Beginm: = 0; for i: = B DOWNTO L DOBEGINFOR J: = 0 TO 9 DOBEGINIF NOT C [I] [J] THENBREAK; END; IF J> 9 THENBEGINF [2 M]: = i; m: = m 1; score: = score 100; label1.caption: = INTOSTR (SCORE); end; end; result: = m-1; end; procedure tform1.fillcurshape1 (Shapecode: integer; var abode: integer; // Filling Prorating Duo: Integer; Begin IF (Shapecode> 0) and (Shapecode <= 7) Then Begin for i: = 1 to 3 do begin ab [i] [1]: = shape [shapecode] [i] [1]; ab [i] [2 ]: = shape [shapecode] [i] [2]; end; end; end; procedure tform1.clearlines (a: tclearlines; b: integer); // Remove a few lines in a container VARI, J, M : integer; beginj: = 1; for i: = a [j 1] -1 Downto 1 dobeginif J-1 a [j 2]) or (b = 0) Thenbeginfor M: = 0 to 9 DOCONT [i j] [m]: = cont [i] [m]; end; end; end; procedure TFORM1 .redraw1 (); // Used to restore VARI, J: Integer; Rect1: TRECT; begincanvas.brush.color: = RGB (255, 125, 125); for i: = 19 Downto 1 DOFOR J: = 0 TO 9 DoBeginif Cont [I] [J] ThenbeginRect1.Left : = j * atomsize; Rect1.top: = i * atomsize; rest atomsize; Rect1.bottom: = Rect1.top atomsize; with contcanvas dobeginfillRect (RECT1); end; end; end; END;

Function TForm1.GetneWPOS (VAR A: TPOINT): Integer; VARA1, B, C, F: Integer; P: Tpoint; i: integer; beginend; function tform1.isexist (var A: tpoint; b: tcurshape; c: tcont : Integer; VAR // Detects whether the current location has been filled I, J, M, N: Integer; beginm: = 0; for i: = 1 to 3 dobeginif (C [AY] [AX]) OR (C [C " A.Y B [i] [2]] [A.X B [I] [1]]) OR (A.X B [i] [1] <0) OR (A.X B [ I] [1]> 9) Thenbeginif C [AY] [A.X B [i] [1]] THENM: = 0ELSEIF A.X B [i] [1] <0 thenbeginm: = 1; endelseif A .x b [i] [1]> 9 thenbeginm: = 2; end; break; end; end; if i> 3 ThenbeginResult: = 0; EXIT; Endelseif M <> 0 Thenbeginself.getshapeSuperxy (a, b, i , J, M, N); IF i <0 THEN BEGIN AX: = AX-I; Result: = 2; EXIT; END ELSE IF M> 9 THEN BEGIN AX: = A.x 9-m; Result: = 2; End; end; end; result: = 1; end; function tform1.putup (): integer; // Place square VARI, J, M, N: Integer; c: tclearlines; A: TPOINT; begin result: = 0; if self.locate (CURSHAPE, CONT) = 1 dam RESULT: = 1; Self.getshapeSuperxy (Curpos, Curshape, I, J, M, N); i: = self.isfullline (n, j, contact c); IF i <> - 1 Then Begin Self.clearLines (C, I); with Contcanvas Do Begin Brush.Color: = Panel1.color; FillRect (PAN El1.clientRect; end; self.redraw1; end; if self.Iss = 0 dam; curpos.x: = 5; curpos.y: = 0; Self.FillCurshape1 (NEXTSHAPE, CURSHAPE); Randomize; NextShape: = Random (3000) 1) MOD 7 1; self.drawnextshape; time1.enabled: = false; sleep (1000); Timer1.Nabled: = true; end else beg; isruning: = 0; END;

END;

Procedure TFORM1.GETSHAPESUPERXY (A: TPOINT; B: TCURSHAPE; VAR Minx, Miny, Maxx, Maxy: Integer; var // Gets the boundary of the current shape: I: integer; begin minx: = 50; miny: = 50 ; MAXX: = 0; MAXY: = 0; for i: = 1 to 3 Do Begin if A.X B [i] [1]> maxx the maxx: = a.x b [i] [1]; IF A.X B [i] [1] maxy kilaxy: = a. Y b [i] [2]; if a.y b [i] [2]

procedure tform1.drawshape (canvas1: tcontrolcanvas; a: tpoint; shape1: tcurshape; isclear: bool); varrect1: trect; i: integer; beginif isclear thencanvas1.Brush.Color: = panel1.Colorelsecanvas1.Brush.Color: = rgb ( 255,125,125); with canvas1 do begin rect1.Left: = ax * atomsize; rect1.Top:=ay*atomsize; rect1.Right: = rect1.Left atomsize; rect1.Bottom: = rect1.top atomsize; FillRect (rect1 ); For i: = 1 to 3 dobegin reference1.Left: = (A.X shape1 [i] [1]) * atomsize; Rect1.top:= (A.y shape1[i][2]) atomsize; rect1.Right: = rect1.Left atomsize; rect1.Bottom: = rect1.top atomsize; FillRect (rect1); end; end; end; procedure TForm1.Timer1Timer (Sender: TObject); begintimer1.Interval: = 550; if self.putup = 0 THENBEGINSELF.DRAWSHAPE (Contcanvas, Curpos, Curshape, true); curpos.y: = curpos.y 1; Self.Drawshape (Contcanvas, Curpos, Curshape, False); end; end; procedure TFORM1.REROTE (VAR A: TCURSHAPE); // Rotate Vari, M: Integer; BeginFor i: = 1 to 3 dobeginm: = a [i] [1]; a [i] [1]: = - a [i ] [2]; A [i] [2]: = m; end;

procedure TForm1.N2Click (Sender: TObject); beginn5.Enabled: = true; with ContCanvas dobeginbrush.Color: = panel1.Color; fillrect (panel1.ClientRect); end; self.initc; timer1.Enabled: = true; end;

procedure TForm1.N3Click (Sender: TObject); vari, j: integer; beginn5.Enabled: = false; n6.Enabled: = false; timer1.Enabled: = false; with ContCanvas dobeginbrush.Color: = panel1.Color; fillrect ( Panel1.clientRect); end; for i: = 0 to 19 do for j: = 0 to 9 DO Cont [I] [j]: = false; curpos.x: = 5; curpos.y: = 0; isRuning: = 0;

Procedure tform1.n5click (sender: TOBJECT); beginism: = 0; Timer1.enabled: = false; n5.enabled: = false; n6.enabled: = true;

procedure TForm1.N6Click (Sender: TObject); beginisruning: = 1; n5.Enabled: = true; n6.Enabled: = false; timer1.Enabled: = true; end; procedure TForm1.FormPaint (Sender: TObject); beginpanel1. repaint; self.redraw1; self.drawnextshape; end; procedure tform1.drawnextshape (); vara: tpoint; b: tcurshape; begina.x: = 3; ay: = 2; self.fillcurshape1 (nextshape, b); with label3 .Canvas do begin brush.color: = label3.color; FillRect (label3.clientRect); end; self.drawshape (tcontrol3.canvas), A, B, false); end; end. {} {Self.getshapeSuperxy (A, Curshape, A1, B, C, F); IF (Cont [A [2]] [A1]) AND NOT (Cont [A [2]] [C 1]) AND NOT (CONT [A [) 2]] [C-1]) AND NOT (Cont [A [2]] [C]) and (c <9) THEN BEGIN A [1]: = a [1] 1; Result: = 2; Exit ; End; IF ((Cont [A [2]] [C]) or (Cont [A [2]] [C-1])))) AND NOT (CONT [A [2]] [A1]) AND (A1 > 0) THEN Begin A [1]: = a [1] -1; IF (Cont [A [2]] [C-1]) AND (A1> 1) THEN A [1]: = a [1] -1; Result: = 2; EXIT; End; IF (A1 <0) THEN Begin P [1]: = a [1] -A1; P [2]: = a [2]; if (a [1] = curpos.x) THEN BEGIN I: = Self.getNewPos (P); if i = 2 Then Begin A [1]: = a [1] -A1; Result: = 1; exit; END; ELSE IF (C> 9) THEN Begin P [1]: = a [1] 9-C; IF (a [1] = curpos.x) Then Begin if self.getnewpos (P) = 2 THEN Begin A [1]: = a [1] 9-C; Result: = 1; EXIT; End; end; end; result: = 0;} // if self.isexist (A, Curshape, CONT)