1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546: 547: 548:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, Grids, ComCtrls, ExtCtrls, StdCtrls;
type TForm1 = class(TForm) MainMenu1: TMainMenu; Spiel1: TMenuItem; NeuesSpiel1: TMenuItem; N1: TMenuItem; Beenden1: TMenuItem; StatusBar1: TStatusBar; Spielfeld: TStringGrid; info1: TMenuItem; Leiste: TStringGrid; Zeit: TTimer; Hilfe1: TMenuItem; Info2: TMenuItem; Optionen1: TMenuItem; Steuerung1: TMenuItem; Musik: TMenuItem; Fortsetzen1: TMenuItem; Stopp1: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; Sounds1: TMenuItem; Leicht: TMenuItem; N8: TMenuItem; Mittel: TMenuItem; N9: TMenuItem; Schwer: TMenuItem; N10: TMenuItem; Highscore1: TMenuItem; N2: TMenuItem; Spielmodus1: TMenuItem; Musik1: TMenuItem; N11: TMenuItem; Musik2: TMenuItem; N12: TMenuItem; Musik3: TMenuItem; N13: TMenuItem; Memories1: TMenuItem; N14: TMenuItem; SwaggerJackin1: TMenuItem; procedure Beenden1Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure NeuesSpiel; procedure SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure NeuesSpiel1Click(Sender: TObject); procedure SpielfeldSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure GleicheFarbenFinden(x, y : integer); procedure GleicheFarbenLoeschen; procedure ZeitTimer(Sender: TObject); procedure LeisteDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure Info2Click(Sender: TObject); procedure Hilfe1Click(Sender: TObject); procedure Highscore1Click(Sender: TObject); procedure Steuerung1Click(Sender: TObject); procedure Stopp1Click(Sender: TObject); procedure Fortsetzen1Click(Sender: TObject); procedure LeichtClick(Sender: TObject); procedure MittelClick(Sender: TObject); procedure SchwerClick(Sender: TObject); procedure Spielmodus1Click(Sender: TObject); procedure Musik1Click(Sender: TObject); procedure Musik2Click(Sender: TObject); procedure Musik3Click(Sender: TObject); procedure Memories1Click(Sender: TObject); procedure SwaggerJackin1Click(Sender: TObject); private public end;
var Form1 : TForm1; Zellengroesse : integer = 30; anzahlgleichfarbigerbloecke : integer; Punkte : integer; Runden : integer; Kaestchen : integer; LetzteZeile : boolean; Classic : boolean; start : TDatetime; Level : integer; PunkteEnde : integer;
implementation
uses Unit2, Unit3, Unit4, Unit5, Unit7, Unit6, Unit8, Unit10, Unit11, Unit12, Unit13, Unit14;
{$R *.DFM}
procedure TForm1.Beenden1Click(Sender: TObject); begin Application.Terminate; end;
procedure TForm1.FormActivate(Sender: TObject); begin Spielfeld.DefaultColWidth := Zellengroesse; Spielfeld.DefaultRowHeight := Zellengroesse; Spielfeld.ClientWidth := Spielfeld.ColCount*(Zellengroesse+Spielfeld.GridLineWidth); Spielfeld.ClientHeight := Spielfeld.RowCount*(Zellengroesse+Spielfeld.GridLineWidth); Leiste.DefaultColWidth := Zellengroesse; Leiste.DefaultRowHeight := Zellengroesse; Leiste.ClientWidth := Leiste.ColCount*(Zellengroesse+Leiste.GridLineWidth); Leiste.ClientHeight := Leiste.RowCount*(Zellengroesse+Leiste.GridLineWidth); StatusBar1.Panels[0].Width := StatusBar1.Width div 2; Form1.Width := Spielfeld.ClientWidth+12; Form1.Height := Spielfeld.ClientHeight+80+Leiste.ClientHeight+30; randomize; NeuesSpiel; Spielfeld.Enabled := false; Zeit.Enabled := false; Classic:= true; end;
procedure TForm1.NeuesSpiel; var x,y,i : integer; begin for x := 0 to Spielfeld.ColCount-1 do begin i := random(4)+1; for y := Spielfeld.RowCount-i to Spielfeld.RowCount-1 do Spielfeld.Cells[x,y] := IntToStr(random(5)); for y := 0 to Spielfeld.RowCount-i-1 do Spielfeld.Cells[x,y] := '-1'; end; for x := 0 to Leiste.ColCount-1 do Leiste.Cells[x,0] := IntToStr(random(5)); Zeit.Enabled := true; Zeit.Interval := 500; Kaestchen := Spielfeld.ColCount; LetzteZeile := false; Spielfeld.Enabled := true; if Classic=false then Zeit.Interval := 100; end;
procedure TForm1.SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if Spielfeld.Cells[ACol,Arow] <> '-1' then case Spielfeld.Cells[ACol,Arow][1] of '0' : Spielfeld.Canvas.Brush.Color := clRed; '1' : Spielfeld.Canvas.Brush.Color := clBlue; '2' : Spielfeld.Canvas.Brush.Color := clYellow; '3' : Spielfeld.Canvas.Brush.Color := clGreen; '4' : Spielfeld.Canvas.Brush.Color := clWhite; else Spielfeld.Canvas.Brush.Color := clBLack; end; Spielfeld.Canvas.Pen.Color := clBlack; Spielfeld.Canvas.Rectangle(Rect); end;
procedure TForm1.LeisteDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if Leiste.Cells[ACol,Arow] <> '-1' then case Leiste.Cells[ACol,ARow][1] of '0' : Leiste.Canvas.Brush.Color := clRed; '1' : Leiste.Canvas.Brush.Color := clBlue; '2' : Leiste.Canvas.Brush.Color := clYellow; '3' : Leiste.Canvas.Brush.Color := clGreen; '4' : Leiste.Canvas.Brush.Color := clWhite; else Leiste.Canvas.Brush.Color := clBlack; end; Leiste.Canvas.Pen.Color := clBlack; Leiste.Canvas.Rectangle(Rect); end;
procedure TForm1.NeuesSpiel1Click(Sender: TObject); begin NeuesSpiel; Statusbar1.Panels[0].Text := 'Punkte : 0'; Statusbar1.Panels[1].Text := 'Runden : 30'; Punkte := 0; Runden := 30; anzahlgleichfarbigerbloecke := 0; Zeit.Enabled := true; start := now; end;
procedure TForm1.GleicheFarbenLoeschen; var x,y ,i ,x1 : integer; Lueckevorhanden,LeereZeile : boolean; ZeileBloecke : integer; begin if anzahlGleichfarbigerbloecke > 1 then begin for x := 0 to Spielfeld.ColCount -1 do for y := 0 to Spielfeld.RowCount -1 do if StrToInt(Spielfeld.Cells[x,y]) > 4 then Spielfeld.Cells[x,y] := '-1'; for x := 0 to Spielfeld.ColCount -1 do begin repeat Lueckevorhanden := false; ZeileBloecke := -1; for y := 0 to Spielfeld.RowCount - 2 do if (Spielfeld.Cells[x,y] <> '-1') and (Spielfeld.Cells[x,y+1]='-1') then begin ZeileBloecke := y; Lueckevorhanden := true; end; if Lueckevorhanden then begin while (ZeileBloecke < Spielfeld.RowCount -1) and (Spielfeld.Cells[x,ZeileBloecke+1]='-1')do begin for y := ZeileBloecke downto 0 do begin Spielfeld.Cells[x,y+1] :=Spielfeld.Cells[x,y]; Spielfeld.Cells[x,y] := '-1'; end; end; end; until not Lueckevorhanden; end; for x := 1 to Spielfeld.ColCount -2 do begin i := 0; for y := 0 to Spielfeld.RowCount -1 do begin if Spielfeld.Cells[x,y] = '-1' then i := i+1; end; if i = Spielfeld.RowCount then begin if x <= Spielfeld.ColCount/2 then begin for x1 := x downto 1 do begin for y := 0 to Spielfeld.RowCount-1 do Spielfeld.Cells[x1,y] := Spielfeld.Cells[x1-1,y]; end; for y := 0 to Spielfeld.RowCount-1 do Spielfeld.Cells[0,y] := '-1'; end else begin for x1 := x to Spielfeld.ColCount -2 do begin for y := 0 to Spielfeld.RowCount-1 do Spielfeld.Cells[x1,y] := Spielfeld.Cells[x1+1,y]; end; for y := 0 to Spielfeld.RowCount-1 do Spielfeld.Cells[Spielfeld.ColCount-1,y] := '-1'; end; end; end; end else begin for x := 0 to Spielfeld.ColCount -1 do for y := 0 to Spielfeld.RowCount -1 do if StrToInt(Spielfeld.Cells[x,y]) > 4 then Spielfeld.Cells[x,y] := IntToStr(StrToInt(Spielfeld.Cells[x,y])-5); end; LeereZeile := true; for x := 0 to Spielfeld.ColCount-1 do begin if Spielfeld.Cells[x,Spielfeld.RowCount-1] <> '-1' then LeereZeile := false; end; if LeereZeile = true then Punkte := Punkte + 2000; end;
procedure TForm1.GleicheFarbenFinden(x, y : integer); var farbwert : string; begin anzahlgleichfarbigerbloecke := anzahlgleichfarbigerbloecke+1; farbwert := Spielfeld.Cells[x,y]; Spielfeld.Cells[x,y] := IntToStr(StrToInt(Spielfeld.Cells[x,y])+5); if y > 0 then if Spielfeld.Cells[x,y-1] = farbwert then GleicheFarbenFinden(x,y-1); if x < Spielfeld.ColCount - 1 then if Spielfeld.Cells[x+1,y] = farbwert then GleicheFarbenFinden(x+1,y); if y < Spielfeld.RowCount - 1 then if Spielfeld.Cells[x,y+1] = farbwert then GleicheFarbenFinden(x,y+1); if x > 0 then if Spielfeld.Cells[x-1,y] = farbwert then GleicheFarbenFinden(x-1,y); end;
procedure TForm1.SpielfeldSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var b, i : integer; begin anzahlgleichfarbigerbloecke := 0; if Spielfeld.Cells[ACol,Arow] <> '-1' then GleicheFarbenFinden(ACol, ARow); b := anzahlgleichfarbigerbloecke; case b of 0,1 : Punkte := Anzahlgleichfarbigerbloecke * 0 + Punkte; 2 : Punkte := Anzahlgleichfarbigerbloecke * 5 + Punkte; 3 : Punkte := Anzahlgleichfarbigerbloecke * 10 + Punkte; 4 : Punkte := Anzahlgleichfarbigerbloecke * 15 + Punkte; 5 : Punkte := Anzahlgleichfarbigerbloecke * 20 + Punkte; 6 : Punkte := Anzahlgleichfarbigerbloecke * 25 + Punkte; 7 : Punkte := Anzahlgleichfarbigerbloecke * 30 + Punkte; else Punkte := Anzahlgleichfarbigerbloecke * 60 + Punkte; end; Statusbar1.Panels[0].Text := 'Punkte :' + IntToStr(Punkte); GleicheFarbenLoeschen;
end;
procedure TForm1.ZeitTimer(Sender: TObject); var x,y : integer; begin if Kaestchen = Leiste.ColCount then begin for x := 0 to Spielfeld.ColCount-1 do begin if Spielfeld.Cells[x,0] <> '-1' then begin LetzteZeile := true; Zeit.Enabled := false; Spielfeld.Enabled := false; PunkteEnde := Punkte; Form8.ShowModal; end; if LetzteZeile = true then break; end; if LetzteZeile = false then begin for y := 0 to Spielfeld.RowCount-1 do begin for x := 0 to Spielfeld.ColCount-1 do Spielfeld.Cells[x,y] := Spielfeld.Cells[x,y+1]; end; for x := 0 to Spielfeld.ColCount-1 do Spielfeld.Cells[x,Spielfeld.RowCount-1] := Leiste.Cells[x,0]; for x := 0 to Leiste.ColCount-1 do Leiste.Cells[x,0] := '-1'; Kaestchen := 0; Runden := Runden -1; Statusbar1.Panels[1].Text := 'Runden :' + IntToStr(Runden); if Runden = 0 then begin Zeit.Enabled := false; Spielfeld.Enabled := false; PunkteEnde := Punkte; Form13.ShowModal; Runden := 30; if Level = Level+1 then begin Runden :=(Level-1)*5+30; Zeit.Interval := 500; Zeit.Interval := Zeit.Interval-10; Zeit.Enabled := true; Spielfeld.Enabled := true; end; end; end; end else begin Leiste.Cells[Kaestchen,0] := IntToStr(random(5)); Kaestchen := Kaestchen+1; end; end;
procedure TForm1.Info2Click(Sender: TObject); begin Form3.ShowModal; end;
procedure TForm1.Hilfe1Click(Sender: TObject); begin Form4.Show; end;
procedure TForm1.Highscore1Click(Sender: TObject); begin Form5.ShowModal; end;
procedure TForm1.Steuerung1Click(Sender: TObject); begin Form6.Show; end;
procedure TForm1.Stopp1Click(Sender: TObject); begin if Zeit.Enabled = true then begin Zeit.Enabled := false; end; if Spielfeld.Enabled = true then begin Spielfeld.Enabled := false; end; end;
procedure TForm1.Fortsetzen1Click(Sender: TObject); begin if Zeit.Enabled = false then begin Zeit.Enabled := true; end; if Spielfeld.Enabled = false then begin Spielfeld.Enabled := true; end; end;
procedure TForm1.LeichtClick(Sender: TObject); begin NeuesSpiel; Zeit.Enabled := true; Zeit.Interval := 500; Statusbar1.Panels[1].Text := 'Runden : 30'; Runden := 30; Leicht.Enabled := False; Mittel.Enabled := True; Schwer.Enabled := True; Statusbar1.Panels[0].Text := 'Punkte : 0'; Punkte := 0; if Runden = 0 then begin Level :=Level+1; Runden :=(Level-1)*5+30; Zeit.Interval := Zeit.Interval-5; end; begin if anzahlGleichfarbigerbloecke > 1 then begin GleicheFarbenLoeschen; end; end end;
procedure TForm1.MittelClick(Sender: TObject); begin NeuesSpiel; Zeit.Enabled := true; Zeit.Interval := 350; Statusbar1.Panels[1].Text := 'Runden : 50'; Runden := 50; Leicht.Enabled := True; Mittel.Enabled := False; Schwer.Enabled := True; Statusbar1.Panels[0].Text := 'Punkte : 0'; Punkte := 0; end;
procedure TForm1.SchwerClick(Sender: TObject); begin NeuesSpiel; Zeit.Enabled := true; Zeit.Interval := 200; Statusbar1.Panels[1].Text := 'Runden : 70'; Runden := 70; Leicht.Enabled := True; Mittel.Enabled := True; Schwer.Enabled := False; Statusbar1.Panels[0].Text := 'Punkte : 0'; Punkte := 0; end;
procedure TForm1.Spielmodus1Click(Sender: TObject); begin Zeit.Enabled := false; Form9.ShowModal; end;
procedure TForm1.Musik1Click(Sender: TObject); begin Form7.ShowModal; end;
procedure TForm1.Musik2Click(Sender: TObject); begin Form11.ShowModal; end;
procedure TForm1.Musik3Click(Sender: TObject); begin Form12.ShowModal; end;
procedure TForm1.Memories1Click(Sender: TObject); begin Form2.ShowModal; end;
procedure TForm1.SwaggerJackin1Click(Sender: TObject); begin Form14.ShowModal; end;
end. |