
Эксперт
   
Профиль
Группа: Участник
Сообщений: 2477
Регистрация: 29.2.2004
Репутация: нет Всего: 40
|
Моя первая игрушка! Это что-то с чем-то! Написана на Паскале. Обратите внимание, в конце, на двойной цикл repaet!  Я с этим на конференции хотел выступать в 9 классе!  :D:D:D | Код | Uses Crt, Graph; Const ErrorMessage='!Error!'; K=100; M=LightBlue; C=Yellow; G=LightGreen; H=LightCyan; Var GraphDriver, GraphMode :Integer; i,x,y,j,UnUn,None,s,pf,pfsx,pfs0,esctest :Integer; Lk,Ch :Char; cc,cc2 :String; Mass_1 :array[1..k, 1..k] of Byte;
Procedure Sow;Forward; Procedure Zero(x, y, c:Integer);Forward; Procedure Christ(x, y, c:Integer);Forward;
{*****************H1lz*************************} Function h1lz:byte; Begin If Mass_1[i+1, j]=1 Then Begin If Mass_1[i+2, j]=1 Then Begin If Mass_1[i+3, j]=1 Then Begin If Mass_1[i+4, j]=1 Then Begin Sow; Pf:=1; End; End; End; End; End;
{*****************H1cz*************************} Function H1cz:Byte; Begin If Mass_1[i+1, j]=1 Then Begin If Mass_1[i-1, j]=1 Then Begin If Mass_1[i+2, j]=1 Then Begin If Mass_1[i-2, j]=1 Then Begin Sow; Pf:=2; End; End; End; End; End;
{*****************H1rz*************************} Function H1rz:Byte; Begin If Mass_1[i-1, j]=1 Then Begin If Mass_1[i-2, j]=1 Then Begin If Mass_1[i-3, j]=1 Then Begin If Mass_1[i-4, j]=1 Then Begin Sow; Pf:=3; End; End; End; End; End;
{*****************V1upz*************************} Function V1upz:Byte; Begin If Mass_1[i, j+1]=1 Then Begin If Mass_1[i, j+2]=1 Then Begin If Mass_1[i, j+3]=1 Then Begin If Mass_1[i, j+4]=1 Then Begin Sow; Pf:=4; End; End; End; End; End;
{*****************V1cz*************************} Function V1cz:Byte; Begin If Mass_1[i, j+1]=1 Then Begin If Mass_1[i, j-1]=1 Then Begin If Mass_1[i, j+2]=1 Then Begin If Mass_1[i, j-2]=1 Then Begin Sow; Pf:=5; End; End; End; End; End;
{*****************V1dz*************************} Function V1dz:Byte; Begin If Mass_1[i, j-1]=1 Then Begin If Mass_1[i, j-2]=1 Then Begin If Mass_1[i, j-3]=1 Then Begin If Mass_1[i, j-4]=1 Then Begin Sow; Pf:=6; End; End; End; End; End;
{*****************Crl1lz*************************} Function crl1lz:Byte; Begin If Mass_1[i+1, j+1]=1 Then Begin If Mass_1[i+2, j+2]=1 Then Begin If Mass_1[i+3, j+3]=1 Then Begin If Mass_1[i+4, j+4]=1 Then Begin Sow; Pf:=7; End; End; End; End; End;
{*****************Crl1cz*************************} Function Crl1cz:Byte; Begin If Mass_1[i-1, j-1]=1 Then Begin If Mass_1[i+1, j+1]=1 Then Begin If Mass_1[i-2, j-2]=1 Then Begin If Mass_1[i+2, j+2]=1 Then Begin Sow; Pf:=8; End; End; End; End; End;
{*****************Crl1dz*************************} Function Crl1dz:Byte; Begin If Mass_1[i-1, j-1]=1 Then Begin If Mass_1[i-2, j-2]=1 Then Begin If Mass_1[i-3, j-3]=1 Then Begin If Mass_1[i-4, j-4]=1 Then Begin Sow; Pf:=9; End; End; End; End; End;
{*****************Crr1dz*************************} Function Crr1dz:Byte; Begin If Mass_1[i+1, j-1]=1 Then Begin If Mass_1[i+2, j-2]=1 Then Begin If Mass_1[i+3, j-3]=1 Then Begin If Mass_1[i+4, j-4]=1 Then Begin Sow; Pf:=10; End; End; End; End; End;
{*****************Crr1cz*************************} Function Crr1cz:Byte; Begin If Mass_1[i+1, j-1]=1 Then Begin If Mass_1[i-1, j+1]=1 Then Begin If Mass_1[i+2, j-2]=1 Then Begin If Mass_1[i-2, j+2]=1 Then Begin Sow; Pf:=11; End; End; End; End; End;
{*****************Crr1upz*************************} Function Crr1upz:Byte; Begin If Mass_1[i-1, j+1]=1 Then Begin If Mass_1[i-2, j+2]=1 Then Begin If Mass_1[i-3, j+3]=1 Then Begin If Mass_1[i-4, j+4]=1 Then Begin Sow; Pf:=12; End; End; End; End; End; {*****************H1lk*************************} Function H1lk:Byte; Begin If Mass_1[i+1, j]=2 Then Begin If Mass_1[i+2, j]=2 Then Begin If Mass_1[i+3, j]=2 Then Begin If Mass_1[i+4, j]=2 Then Begin Sow; Pf:=13; End; End; End; End; End;
{*****************H1ck*************************} Function H1ck:Byte; Begin If Mass_1[i+1, j]=2 Then Begin If Mass_1[i-1, j]=2 Then Begin If Mass_1[i+2, j]=2 Then Begin If Mass_1[i-2, j]=2 Then Begin Sow; Pf:=14; End; End; End; End; End;
{*****************H1rk*************************} Function H1rk:Byte; Begin If Mass_1[i-1, j]=2 Then Begin If Mass_1[i-2, j]=2 Then Begin If Mass_1[i-3, j]=2 Then Begin If Mass_1[i-4, j]=2 Then Begin Sow; Pf:=15; End; End; End; End; End;
{*****************V1upk*************************} Function V1upk:Byte; Begin If Mass_1[i, j+1]=2 Then Begin If Mass_1[i, j+2]=2 Then Begin If Mass_1[i, j+3]=2 Then Begin If Mass_1[i, j+4]=2 Then Begin Sow; Pf:=16; End; End; End; End; End;
{*****************V1ck*************************} Function V1ck:Byte; Begin If Mass_1[i, j+1]=2 Then Begin If Mass_1[i, j-1]=2 Then Begin If Mass_1[i, j+2]=2 Then Begin If Mass_1[i, j-2]=2 Then Begin Sow; Pf:=17; End; End; End; End; End;
{*****************V1dk*************************} Function V1dk:Byte; Begin If Mass_1[i, j-1]=2 Then Begin If Mass_1[i, j-2]=2 Then Begin If Mass_1[i, j-3]=2 Then Begin If Mass_1[i, j-4]=2 Then Begin Sow; Pf:=18; End; End; End; End; End;
{*****************Crl1lk*************************} Function Crl1lk:Byte; Begin If Mass_1[i+1, j+1]=2 Then Begin If Mass_1[i+2, j+2]=2 Then Begin If Mass_1[i+3, j+3]=2 Then Begin If Mass_1[i+4, j+4]=2 Then Begin Sow; Pf:=19; End; End; End; End; End;
{*****************Crl1ck*************************} Function Crl1ck:Byte; Begin If Mass_1[i-1, j-1]=2 Then Begin If Mass_1[i+1, j+1]=2 Then Begin If Mass_1[i-2, j-2]=2 Then Begin If Mass_1[i+2, j+2]=2 Then Begin Sow; Pf:=20; End; End; End; End; End;
{*****************Crl1dk*************************} Function Crl1dk:Byte; Begin If Mass_1[i-1, j-1]=2 Then Begin If Mass_1[i-2, j-2]=2 Then Begin If Mass_1[i-3, j-3]=2 Then Begin If Mass_1[i-4, j-4]=2 Then Begin Sow; Pf:=21; End; End; End; End; End;
{*****************Crr1dk*************************} Function Crr1dk:Byte; Begin If Mass_1[i+1, j-1]=2 Then Begin If Mass_1[i+2, j-2]=2 Then Begin If Mass_1[i+3, j-3]=2 Then Begin If Mass_1[i+4, j-4]=2 Then Begin Sow; Pf:=22; End; End; End; End; End;
{*****************Crr1ck*************************} Function Crr1ck:Byte; Begin If Mass_1[i+1, j-1]=2 Then Begin If Mass_1[i-1, j+1]=2 Then Begin If Mass_1[i+2, j-2]=2 Then Begin If Mass_1[i-2, j+2]=2 Then Begin Sow; Pf:=23; End; End; End; End; End;
{*****************Crr1upk*************************} Function Crr1upk:Byte; Begin If Mass_1[i-1, j+1]=2 Then Begin If Mass_1[i-2, j+2]=2 Then Begin If Mass_1[i-3, j+3]=2 Then Begin If Mass_1[i-4, j+4]=2 Then Begin Sow; Pf:=24; End; End; End; End; End;
{***************Sound of Win******************} Procedure Sow; Begin Sound(100); Delay(200); Sound(200); Delay(200); Sound(300); Delay(200); NoSound; End;
{*****************Win Krest*******************} Procedure WK; Begin h1lk; h1ck; h1rk; v1upk; v1ck; v1dk; crl1lk; crl1ck; crl1dk; crr1dk; crr1ck; crr1upk; End;
{******************Win Zero******************} Procedure WZ; Begin h1lz; h1cz; h1rz; v1upz; v1cz; v1dz; crl1lz; crl1cz; crl1dz; crr1dz; crr1cz; crr1upz; End;
{******************Ramka**********************} Procedure Ramka(x, y, c :Integer); Begin SetColor(c); Line(x, y, x, y-UnUn); Line(x, y-UnUn, x-UnUn, y-UnUn); Line(x-UnUn, y-UnUn, x-UnUn, y); Line(x, y, x-UnUn, y); End;
{******************Down*********************} Procedure Down; Begin If y<UnUn*S then Begin Ramka(x, y, m); y:=y+UnUn; Ramka(x, y, c); End; End;
{******************Up************************} Procedure Up; Begin If y>UnUn then Begin Ramka(x, y, m); y:=y-UnUn; Ramka(x, y, c); End; End;
{*****************Left**********************} Procedure Left; Begin If x>UnUn then Begin Ramka(x, y, m); x:=x-UnUn; Ramka(x, y, c); End; End;
{******************Right*********************} Procedure Right; Begin If x<UnUn*S then Begin Ramka(x, y, m); x:=x+UnUn; Ramka(x, y, c); End; End;
{*******************Move*********************} Function Move:Byte; Begin If None mod 2=0 Then Zero(x,y,h) Else Christ(x,y,g); End;
{******************Pole**********************} Procedure Pole; Begin For i:=0 to S do Line(0, i*UnUn, UnUn*S, i*UnUn); For j:=0 to S do Line(j*UnUn, 0, j*UnUn, S*UnUn); End;
{******************Christ********************} Procedure Christ(x, y, c:Integer); Var x1,y1: Integer; Begin SetColor(g); X1:=x-UnUn; y1:=y-UnUn; i:=x div UnUn; j:=y div UnUn; None:=None+1; If (Mass_1[i, j]=1) or (Mass_1[i, j]= 2) Then Begin None:=None-1; Sound(300); Delay(200); NoSound; End Else Begin Mass_1[i, j]:=2; Line(x1,y1,x1+UnUn,y1+UnUn); y1:=y; Line(x1,y1,x,y-UnUn); WK; End; End;
{******************Zero**********************} Procedure Zero(x,y,c:Integer); Var x2,y2: Integer; Begin SetColor(h); x2:=x-(UnUn div 2); y2:=y-(UnUn div 2); i:=x div UnUn; j:=y div UnUn; None:=None+1; If (Mass_1[i, j]=1) or (Mass_1[i, j]=2) Then Begin None:=None-1; Sound(300); Delay(100); NoSound; End Else Begin Mass_1[i, j]:=1; Circle(x2,y2,UnUn div 3); WZ; End; End;
{*********************GrapOn********************} Function GraphOn:Byte; Begin GraphDriver:=InstallUserDriver('svga256',nIl); GraphMode:=4; InitGraph(GraphDriver, GraphMode, ' '); If GraphResult <> grOk Then Begin GoToXY((80-Length(ErrorMessage)) div 2, 12); TextColor(Red); Write(ErrorMessage); ReadKey; Halt(1); End; End;
{*******************PGAME********************} Procedure pgame; Begin ClearDevice; S:=30; None:=50; SetColor(Green); OutTextXY(GetMaxX div 2-GetMaxX div 8,GetMaxY div 2-GetMaxY div 4, '’ЄЁ Q, зв®Ўл Ї®§лаЁвм Manual!'); SetColor(Yellow); OutTextXY(GetMaxX div 2-GetMaxX div 10,GetMaxY div 2-GetMaxY div 3,'!Welcome To Christ&Zero!'); SetColor(Red); OutTextXY(GetMaxX div 2-GetMaxX div 20,GetMaxY div 2+GetMaxY div 12,'1.10x10'); SetColor(Cyan); OutTextXY(GetMaxX div 2-GetMaxX div 20,GetMaxY div 2+GetMaxY div 10,'2.20x20'); SetColor(LightBlue); OutTextXY(GetMaxX div 2-GetMaxX div 12,GetMaxY div 2,'Push any key - 30x30'); Lk:=ReadKey; If lk=Chr(113) Then Begin ClearDevice; SetColor(White); OutTextXY(GetMaxX div 2-GetMaxX div 6,GetMaxY div 2+GetMaxY div 10, '? ¦¬Ё SPACE, зв®Ўл Ї®бв ўЁвм ЄаҐбвЁЄ Ё«Ё ®«ЁЄ'); OutTextXY(GetMaxX div 2-GetMaxX div 6,GetMaxY div 2, '? ¦Ё¬ © ESC,зв®Ўл ўл©вЁ ў ¬Ґо ўлЎ®а ¬ бив Ў !!'); OutTextXY(GetMaxX div 2-GetMaxX div 6,GetMaxY div 2-GetMaxY div 10, '?Ґ ’›ЉЂ‰ Њ?ЋѓЋ Є« ўЁим ®¤®ўаҐ¬Ґ® Ё«Ё Ўлбва®'); ReadKey; pgame; End; If lk=Chr(49) Then Begin None:=30; s:=10 End; If lk=Chr(50) Then Begin None:=40; S:=20; End; ClearDevice; UnUn:=GetMaxY div S; SetColor(m); Pole; Ramka(UnUn,UnUn,c); x:=UnUn; y:=UnUn; End;
{*******************ppgame*******************} Procedure ppgame; Begin REPEAT pf:=0; Ch:=ReadKey; Case Ord(Ch) of 80 : Down; 72 : Up; 77 : Right; 75 : Left; 32 : Move; End; If None=130 Then Begin ClearDevice; OuTTextXY(GetMaxX div 2,GetMaxY div 2,'ZABIL VSE POLE'); ReadKey; Break; End; If None=440 Then Begin ClearDevice; OuTTextXY(GetMaxX div 2,GetMaxY div 2,'ZABIL VSE POLE'); ReadKey; Break; End; If None=950 Then Begin ClearDevice; OuTTextXY(GetMaxX div 2,GetMaxY div 2,'ZABIL VSE POLE'); ReadKey; Break; End; If (pf=1) or (pf=2) or (pf=3) or (pf=4) or (pf=5) or (pf=6) or (pf=7) or (pf=8) or (pf=9) or (pf=10) or (pf=11) or (pf=12) or (pf=13) or (pf=14) or (pf=15) or (pf=16) or (pf=17) or (pf=18) or (pf=19) or (pf=20) or (pf=21) or (pf=22) or (pf=23) or (pf=24) Then Break; Until Ch=Chr(27); End; {********************Game********************} Procedure Game; Begin pgame; ppgame; ClearDevice; If (pf=1) or (pf=2) or (pf=3) or (pf=4) or (pf=5) or (pf=6) or (pf=7) or (pf=8) or (pf=9) or (pf=10) or (pf=11) or (pf=12) Then Begin ClearDevice; SetColor(Cyan); OutTextXY(GetMaxX div 2-GetMaxX div 20,GetMaxY div 2,'The Winner is Zeros'); Pfs0:=pfs0+1; str(pfs0,cc); str(pfsX,cc2); SetColor(LightMagenta); OutTextXY(GetMaxX div 2,GetMaxY div 2+GetMaxY div 15,cc); SetColor(LightMagenta); OutTextXY(GetMaxX div 2+GetMaxX div 30,GetMaxY div 2+GetMaxY div 15,cc2); SetColor(LightBlue); OutTextXY(GetMaxX div 2,GetMaxY div 2+GetMaxY div 20,'Z'); SetColor(LightBlue); OutTextXY(GetMaxX div 2+GetMaxX div 30,GetMaxY div 2+GetMaxY div 20,'X'); SetColor(LightGreen); Line(GetMaxX div 2+GetMaxX div 50,GetMaxY div 2+GetMaxY div 20,GetMaxX div 2+GetMaxX div 50, GetMaxY div 2+GetMaxY div 5); ReadKey; End; If (pf=13) or (pf=14) or (pf=15) or (pf=16) or (pf=17) or (pf=18) or (pf=19) or (pf=20) or (pf=21) or (pf=22) or (pf=23) or (pf=24) Then Begin ClearDevice; SetColor(Green); OutTextXY(GetMaxX div 2-GetMaxX div 20,GetMaxY div 2,'The Winner is Christs'); pfsX:=pfsX+1; str(pfs0,cc); str(pfsX,cc2); SetColor(LightMagenta); OutTextXY(GetMaxX div 2,GetMaxY div 2+GetMaxY div 15,cc); SetColor(LightMagenta); OutTextXY(GetMaxX div 2+GetMaxX div 30,GetMaxY div 2+GetMaxY div 15,cc2); SetColor(LightBlue); OutTextXY(GetMaxX div 2,GetMaxY div 2+GetMaxY div 20,'Z'); SetColor(LightBlue); OutTextXY(GetMaxX div 2+GetMaxX div 30,GetMaxY div 2+GetMaxY div 20,'X'); SetColor(LightGreen); Line(GetMaxX div 2+GetMaxX div 50,GetMaxY div 2+GetMaxY div 20,GetMaxX div 2+GetMaxX div 50, GetMaxY div 2+GetMaxY div 5); ReadKey; End; End;
{******************PROGRAMM******************} BEGIN pfsx:=0; pfs0:=0; Repeat REPEAT For i:=1 to s do For j:=1 to s do Mass_1[i, j]:=0; GraphOn; Game; Until (pfs0=3) or (pfsx=3); Until (pfs0=3) or (pfsx=3); END.
|
--------------------
Когда начинаются цифровые войны, а траффик разносит моё сознание по бесконечным просторам инета, подобно ветру, разносящему листву по полям, тогда и только тогда я чувствую себя свободным! © Я, Берсерк, что значит - Неистовый.
|