⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 eg9413.pas

📁 一个类似俄罗斯方块的游戏
💻 PAS
📖 第 1 页 / 共 5 页
字号:
       { If buf2 = 'showshadow' Then
	  Case buf[1] Of
	   'Y', 'y': showshadow := False;
	   'N', 'n': showshadow := False
	  End; }
	 If buf2 = 'tournament' Then
	  Case buf[1] Of
	   'Y', 'y': tournament := True;
	   'N', 'n': tournament := False
	  End;
	 If buf2 = 'tournamentgame' Then
	  Begin
	   Val(buf, i, j);
	   If (j = 0) And (i In [0..ngames-1]) Then
	    tournamentgame := i
	  End;
	 If buf2 = 'xshape' Then
	  Case buf[1] Of
	   'C', 'c': xshape := 1;
	   'E', 'e': xshape := 2;
	   'M', 'm': xshape := 3;
	   'H', 'h': xshape := 4
	  End;
	 If buf2 = 'styleblocks' Then
	  Case buf[1] Of
	   'N', 'n': styleblocks := 1;
	   'C', 'c': styleblocks := 2;
	   'P', 'p': styleblocks := 3;
	   'B', 'b': styleblocks := 4;
	   'A', 'a': styleblocks := 5;
	   'E', 'e': styleblocks := 6;
	   'R', 'r': styleblocks := nstyletabs
	  End;
	 If buf2 = 'sound' Then
	  Case buf[1] Of
	   'Y', 'y': tones := True;
	   'N', 'n': tones := False
	  End;
	 If buf2 = 'title' Then
	  Case buf[1] Of
	   'Y', 'y': title := True;
	   'N', 'n': title := False
	  End;

	 if buf2 = 'palette' then
	  begin
	   for x := 0 to palettesiz-2 do
	    begin
	     i := pos (',', buf);
	     if i <> 0 then
	      begin
	       buf3 := copy (buf, 1, i-1);
	       buf := copy (buf, i+1, length (buf)-i);
	       val(buf3, y, j);
	       if (j = 0) and (y in [0..63]) then
		userpalette.colors[x] := y
	       else
		userpalette.colors[0] := -1;
	      end
	     else
	      userpalette.colors[0] := -1;
	    end;
	    val(buf,y,j);
	    if (j = 0) and (y in [0..63]) then
	     userpalette.colors[palettesiz-1] := y
	    else
	     userpalette.colors[0] := -1;
	  end;

	 if buf2 = 'keybinding' then
	  Case buf[1] Of
	   'C', 'c': binding := 1;
	   'R', 'r': binding := 2;
	   'B', 'b': binding := 3;
	   'L', 'l': binding := 4;
	   'F', 'f': binding := 5;
	   'S', 's': binding := 6;
	   'A', 'a': binding := 7;
	   'U', 'u': binding := 8;
	   '0'..'9': begin
		      binding := 8;
		      for x := 1 to nkeys-1 do
		       begin
			i := pos (',', buf);
			if i <> 0 then
			 begin
			  buf3 := copy(buf, 1, i-1);
			  buf := copy(buf, i+1, length(buf)-i);
			  val(buf3, y, j);
			  if (j = 0) and (y in [0..255]) then
			   keybindingtab[nkeybindings, x] := y
			  else
			    keybindingtab[nkeybindings, 1] := 0;
			 end
			else
			 keybindingtab[nkeybindings, 1] := 0;
		       end;
		      val(buf, y, j);
		      if (j = 0) and (y in [0..255]) then
		       keybindingtab[nkeybindings, nkeys] := y
		      else
		       keybindingtab[nkeybindings, 1] := 0;
		     end
	  end
	End
      End;
     Close(fconfig)
    End;

   If ParamCount > 0 Then
    Begin
     buf := Copy(ParamStr(1), 1, 1);
     Case buf[1] Of
      'B', 'b': display := bw;
      'C', 'c': display := color;
      'M', 'm': display := mono;
      'P', 'p': display := plasma
     End
    End;

   If RegisterBGIdriver(@EGAVGADriver) < 0 Then
    abortgraphics;
   if registerbgidriver(@hercdriver) < 0 then
    abortgraphics;

   If RegisterBGIfont(@SansSerifFontProc) < 0 Then
    abortgraphics;
   If RegisterBGIfont(@SmallFontProc) < 0 Then
    abortgraphics;

   dographics;

   For i := 1 To nshapes Do
    For j := 1 To shapesiz-1 Do
     Begin
      xshapetab[i, 0, j, 1] :=	pixelsperblock*shapetab[i, j, 1];
      yshapetab[i, 0, j, 1] :=	shapetab[i, j, 1];
      xshapetab[i, 0, j, 2] :=	pixelsperblock*shapetab[i, j, 2];
      yshapetab[i, 0, j, 2] :=	shapetab[i, j, 2];
      xshapetab[i, 1, j, 1] :=	pixelsperblock*shapetab[i, j, 2];
      yshapetab[i, 1, j, 1] :=	shapetab[i, j, 2];
      xshapetab[i, 1, j, 2] := -pixelsperblock*shapetab[i, j, 1];
      yshapetab[i, 1, j, 2] := -shapetab[i, j, 1];
      xshapetab[i, 2, j, 1] := -pixelsperblock*shapetab[i, j, 1];
      yshapetab[i, 2, j, 1] := -shapetab[i, j, 1];
      xshapetab[i, 2, j, 2] := -pixelsperblock*shapetab[i, j, 2];
      yshapetab[i, 2, j, 2] := -shapetab[i, j, 2];
      xshapetab[i, 3, j, 1] := -pixelsperblock*shapetab[i, j, 2];
      yshapetab[i, 3, j, 1] := -shapetab[i, j, 2];
      xshapetab[i, 3, j, 2] :=	pixelsperblock*shapetab[i, j, 1];
      yshapetab[i, 3, j, 2] :=	shapetab[i, j, 1]
     End;

   For i := 1 To ncolors Do
    shapecolors[i] := shapecolortab[display, i];

   colornormal := mesgcolortab[display, normal];
   colorhigh   := mesgcolortab[display, high];

   FillChar(hiscore, SizeOf(hiscore), 0);
   i := 1;
   Assign(fhiscore, hiscorename);
   FileMode := 0;			{ read-only }
   Reset(fhiscore);
   If IOResult = 0 Then
    Begin
     While (i <= nhiscores) And (Not Eof(fhiscore)) Do
      Begin
       Read(fhiscore, hiscore[i]);
       Inc(i)
      End;
     Close(fhiscore)
    End;

   SetVisualPage(page);
   page := 1-page;
   SetActivePage(page);

   GetMem(scrollptr, ImageSize(colmin+1, rowmin, colmax-1,
    rowmax+pixelsperblock));

   getmem(emptyrow, ImageSize(colmin+1, rowmin, colmax-1,
    rowmin+pixelsperblock+1));
   isiz := ImageSize(colmin+1, rowmin, colmax-1, rowmin+pixelsperblock);

 { isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
   SetColor(colorhigh);
   SetFillPattern(filltab[1], colornormal);
   Bar(0, 0, pixelsperblock, pixelsperblock Shr 1);
   GetMem(shadows, isiz);
   GetImage(0, 0, pixelsperblock, pixelsperblock Shr 1, shadows^);
   PutImage(0, 0, shadows^, XORPut); }

   isiz := ImageSize(0, 0, pixelsperblock, pixelsperblock);
   SetColor(colornormal);
   SetFillStyle(SolidFill, colornormal);
   Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
   SetColor(Black);
   Rectangle(3, 3, pixelsperblock-3, pixelsperblock-3);
   Line(1, 1, 3, 3);
   Line(1, pixelsperblock-1, 3, pixelsperblock-3);
   Line(pixelsperblock-1, 1, pixelsperblock-3, 3);
   Line(pixelsperblock-1, pixelsperblock-1, pixelsperblock-3,
	pixelsperblock-3);

   For i := 1 To ncolors Do		  { new }
    For j := 1 To nstyles Do
     Begin
      SetFillPattern(filltab[j], shapecolors[i]);
      Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
      GetMem(xstyletabs[1, i, j], isiz);
      GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[1, i, j]^)
     End;

   For i := 1 To ncolors Do		  { pumped full of drugs }
    For j := 1 To nstyles Do
     Begin
      SetFillPattern(filltab[Random(nstyles)+1],
		     shapecolors[Random(ncolors)+1]);
      Bar(4, 4, 7, 7);
      SetFillPattern(filltab[Random(nstyles)+1],
		     shapecolors[Random(ncolors)+1]);
      Bar(7, 4, 10, 7);
      SetFillPattern(filltab[Random(nstyles)+1],
		     shapecolors[Random(ncolors)+1]);
      Bar(4, 7, 7, 10);
      SetFillPattern(filltab[Random(nstyles)+1],
		     shapecolors[Random(ncolors)+1]);
      Bar(7, 7, 10, 10);
      GetMem(xstyletabs[3, i, j], isiz);
      GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[3, i, j]^)
     End;

  if display = mono then
   begin
    for i := 1 to ncolors do		    { barbed wire kisses }
     for j := 1 to nstyles do
      begin
       for x := 4 to pixelsperblock-4 do
	for y := 4 to pixelsperblock-4 do
	 begin
	  if random(3) > 0 then
	   putpixel(x, y, shapecolors[i])
	  else
	   putpixel(x, y, 0);
	 end; { for }
	GetMem(xstyletabs[4, i, j], isiz);
	GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[4, i, j]^)
       End
   end
  else
   begin
    for i := 1 to ncolors do
     for j := 1 to nstyles do
      begin
       for x := 4 to pixelsperblock-4 do
	for y := 4 to pixelsperblock-4 do
	 begin
	  if random(2) = 0 then
	   putpixel(x, y, shapecolors[i])
	  else
	   putpixel(x, y, shapecolors[random(ncolors)+1])
	 end; { for }
	GetMem(xstyletabs[4, i, j], isiz);
	GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[4, i, j]^)
       End
   end;

   SetFillPattern(filltab[1], colornormal);
   Bar(4, 4, pixelsperblock-4, pixelsperblock-4);
   GetMem(filler, isiz);
   GetImage(0, 0, pixelsperblock, pixelsperblock, filler^);
   PutImage(0, 0, filler^, XORPut);

   For i := 1 To ncolors Do		{ classic }
    Begin
     SetColor(shapecolors[i]);
     For j := 1 To nstyles Do
      Begin
       SetFillPattern(filltab[j], shapecolors[i]);
       Rectangle(1, 1, pixelsperblock-1, pixelsperblock-1);
       Bar(3, 3, pixelsperblock-3, pixelsperblock-3);
       GetMem(xstyletabs[2, i, j], isiz);
       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[2, i, j]^)
      End
    End;

   For i := 1 To ncolors Do		{ arpeggiator }
    Begin
     SetColor(shapecolors[i]);
     For j := 1 To nstyles Do
      Begin
       SetFillPattern(filltab[j], shapecolors[i]);
       bar(1, 1, pixelsperblock-1, pixelsperblock-1);
       GetMem(xstyletabs[5, i, j], isiz);
       GetImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[5, i, j]^)
      End
    End;

  if display = mono then
   begin
    for i := 1 to ncolors do		  { elephant stone }
     for j := 1 to nstyles do
      begin
       for x := 1 to pixelsperblock-1 do
	for y := 1 to pixelsperblock-1 do
	 begin
	  if random(3) > 0 then
	   putpixel(x, y, shapecolors[i])
	  else
	   putpixel(x, y, 0);
	 end; { for }
	getMem(xstyletabs[6, i, j], isiz);
	getImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[6, i, j]^)
       end
   end
  else
   begin
    for i := 1 to ncolors do		  { elephant stone }
     for j := 1 to nstyles do
      begin
       for x := 1 to pixelsperblock-1 do
	for y := 1 to pixelsperblock-1 do
	 begin
	  if random(2) = 0 then
	   putpixel(x, y, shapecolors[i])
	  else
	   putpixel(x, y, shapecolors[random(ncolors)+1])
	 end; { for }
	getMem(xstyletabs[6, i, j], isiz);
	getImage(0, 0, pixelsperblock, pixelsperblock, xstyletabs[6, i, j]^)
       end;
    end;

   SetColor(colorhigh);
   SetFillPattern(filltab[2], colornormal);
   Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
   GetMem(curtain[true], isiz);
   GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[true]^);

   SetFillPattern(filltab[3], colornormal);
   Bar(1, 1, pixelsperblock-1, pixelsperblock-1);
   GetMem(curtain[false], isiz);
   GetImage(0, 0, pixelsperblock, pixelsperblock, curtain[false]^);
   PutImage(0, 0, curtain[false]^, XORPut);

   For i := 1 To ncolors Do
    For j := 1 To nstyles Do
     xstyletabs[nstyletabs, i, j] := xstyletabs[Random(nstyletabs-1)+1, i, j];
{				       Random(ncolors)+1,
				       Random(nstyles)+1] }

   if display = color then
    begin
     userpalette.size := palettesiz;
     if userpalette.colors[0] = -1 then
      for i := 0 to palettesiz-1 do
       userpalette.colors[i] := palettemap[i];
     setallpalette(userpalette)
    end
  End; {-init-}


 Procedure drawtitle;

  Const
   titlesiz	  = 95;
   titletab	  : Array [1..titlesiz, 1..2] Of integer =
		    (( 75,  57), ( 75,	71), ( 75, 85), ( 75, 99),
		      ( 75, 113), ( 75, 127), ( 75, 141),
		     ( 89,  57), ( 89, 99), ( 89, 141),
		     (103,  57), (103, 99), (103, 141),
		     (117,  57), (117, 99), (117, 141),
		     (131,  57), (131, 141),

		     (159,  71), (159, 85), (159, 99), (159, 113),
		      (159, 127),
		     (173,  57), (173, 141),
		     (187,  57), (187, 141),
		     (201,  57), (201, 99), (201, 141),
		     (215,  71), (215, 99), (215, 113), (215, 127),

		     (243,  71), (243, 85), (243, 99), (243, 113),
		      (243, 127), (243, 141),
		     (257,  57), (257, 99),
		     (271,  57), (271, 99),
		     (285,  57), (285, 99),
		     (299,  71), (299, 85), (299, 99), (299, 113),
		      (299, 127), (299, 141),

		     (327,  57), (327, 141),
		     (341,  57), (341, 141),
		     (355,  57), (355,	71), (355, 85), (355, 99),
		      (355, 113), (355, 127), (355, 141),
		     (369,  57), (369, 141),
		     (383,  57), (383, 141),

		     (411,  57), (411,	71), (411, 85), (411, 99),
		      (411, 113), (411, 127), (411, 141),
		     (425,  71),
		     (439, 85),
		     (453, 99),
		     (467,  57), (467,	71), (467, 85), (467, 99),
		      (467, 113), (467, 127), (467, 141),

		     (495,  57),
		     (509,  57),
		     (523,  57), (523,	71), (523, 85), (523, 99),
		      (523, 113), (523, 127), (523, 141),
		     (537,  57),
		     (551,  57));

  Var
   test 	  : Array [1..titlesiz] Of boolean;
   ch		  : word;
   i, j, c, s	  : integer;
   x, y1, y2	  : integer;
   p		  : pointer;

  Begin {-drawtitle-}
   FillChar(test, SizeOf(test), 0);

   If styleblocks = 0 Then
    styleblocks := Random(nstyletabs-1)+1;
   s := 1;

   if title then
    begin
     For i := 1 To titlesiz Do
      Begin
       Repeat
	j := Random(titlesiz)+1
       Until Not test[j];
       c := Random(ncolors)+1;
       If styleblocks = 3 Then
	s := Random(nstyles)+1;
       x := titletab[j, 1];
       If KeyPressed Then
	y1 := titletab[j, 2]
       Else
	Begin
	 y1 := 0;
	 y2 := dropinc
	End;
       p := xstyletabs[styleblocks, c, s];
       PutImage(x, y1, p^, XORPut);
       SetVisualPage(page);
       page := 1-page;
       SetActivePage(page);

       While (Not KeyPressed) And (y2 < titletab[j, 2]) Do
	Begin
	 PutImage(x, y2, p^, XORPut);
	 Delay(dropdelay);
	 SetVisualPage(page);
	 page := 1-page;
	 SetActivePage(page);
	 PutImage(x, y1, p^, XORPut);
	 y1 := y2;
	 Inc(y2, dropinc)
	End;

       PutImage(x, titletab[j, 2], p^, XORPut);
       SetVisualPage(page);
       page := 1-page;
       SetActivePage(page);

       PutImage(x, y1, p^, XORPut);
       PutImage(x, titletab[j, 2], p^, XORPut);
       test[j] := True
      End;
     While KeyPressed Do
      ch := getkey;

     SetTextJustify(CenterText, TopText);
     SetColor(colorhigh);
     SetTextStyle(SansSerifFont, HorizDir, 4);
     OutTextXY(320, 7, 'Welcome to version '+version+' of');
     OutTextXY(320, 162, copyright);

     SetTextStyle(SmallFont, HorizDir, 4);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -