返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 俄罗斯方块单元 ***}
{***************************************************************}
{$F+,O+,X+,S-}
Unit FBlock;
Interface
Uses
Crt,Graph,FTool,FGraph,FMouse,FWrite,FEvent,FView,
FMenu,FDsp,FSbFM,FControl,FExtDrv,FDialog;
Const
BlockHor = 10;
BlockVer = 15;
BlockHig = 19;
BlockWid = 20;
Const
JiLu:LongInt=0;
JiLuName:String='';
DelayTime:Longint=70;
Type
PBlock=^TBlock;
TBlock=Object(TWindow)
FkRec,NextRec:TRect;
FkSz:array[1..BlockHor,1..BlockVer] of Byte;
LeftFk,RightFk,Ding,Ceng,GameBegin,GameHold:Boolean;
JiFen,OldJiFen:LongInt;
MainFx1,MainZl1,MainFx,MainZl:Integer;
Curx,Cury,ColorFk,Speed:Integer;
Timer:PTimer;
JiLuStr,FenStr:PStaticText;
Constructor Init;
Procedure InitMenu;virtual;
Procedure Paint;virtual;
Procedure Draw;virtual;
Procedure MoveTo(X,Y:Integer);virtual;
Procedure HandleEvent(var Event:TEvent);virtual;
Procedure Reset;
Procedure DrawBlock(X,Y:Integer);
Procedure Xiao(X,Y:Integer;Mode:Byte;Dr:Boolean);
Procedure Ca(X,Y:Integer;Dr:Boolean);
Procedure Fk(X,Y,Fx,Zl:integer;Zt,Main,Dr:boolean);
Procedure XiaoCeng;
end;
Implementation
Const
FM_Ins:array[0..15] of Byte=(
$11, $01, $8A, $40, $F1, $F1, $11, $B3,
$00, $00, $06, $00, $00, $00, $00, $00);
Constructor TBlock.Init;
var
R:TRect;
begin
AssignRect(R,0,0,380,360);
Inherited Init(R,'俄罗斯方块',True);
AssignRect(R,20-8,60-8,20+BlockHor*BlockWid+6,60+BlockVer*BlockHig+6);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,7,0,'')));
AssignRect(R,20-3,60-3,20+BlockHor*BlockWid+1,60+BlockVer*BlockHig+1);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,1,0,0,0,'')));
AssignRect(R,240,55,360,170);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,1,0,0,0,'')));
AssignRect(R,240,180,360,200);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,$0A,0,'')));
AssignRect(R,240,205,360,225);
Insert(New(PShape,Init(gcBroad+gcHideMouse,R,0,0,$0A,0,'')));
Insert(New(PStaticText,Init(stNormal+stFColor,242,182,'记录:',$A0)));
Insert(New(PStaticText,Init(stNormal+stFColor,242,207,'得分:',$A0)));
JiLuStr:=New(PStaticText,Init(stNormal+stFColor,285,182,IntStr(JiLu),$A4));
FenStr:=New(PStaticText,Init(stNormal+stFColor,285,207,'0',$A4));
Insert(JiLuStr);
Insert(FenStr);
Timer:=New(PTimer,Init(DelayTime-Speed*10));
Insert(Timer);
AssignRect(R,240,280,338,350);
Insert(New(PShape,Init(gcDBroad+gcHideMouse,R,0,0,0,0,'')));
Insert(New(PButton,Init(275,290,300,315,'',kbUp,cmUp)));
Insert(New(PButton,Init(275,318,300,343,'',kbDown,cmDown)));
Insert(New(PButton,Init(248,318,272,343,'',kbLeft,cmLeft)));
Insert(New(PButton,Init(303,318,328,343,'',kbRight,cmRight)));
Next;
Center;
Reset;
GetDspBasePort;
GameBegin:=False;
end;
Procedure TBlock.InitMenu;
var
T:TRect;
begin
Inherited InitMenu;
AssignRect(T,5,27,Broad.b.x-5,44);
Insert(New(PMainMenu,Init(T,False,
NewSubMenu('游戏~P~',kbAltP,New(PMenu,Init(
NewMenuItem('新局',kbAltN,cmNew,nil,
NewMenuItem('暂停',kbAltS,cmStop,nil,
NewMenuItem('',0,0,nil,
NewMenuItem('关闭 ~Alt+F3~',kbAltF3,cmCloseWin,nil,nil)))))),
NewSubMenu('帮助~H~',kbAltH,New(PMenu,Init(
NewMenuItem('关于',kbNoKey,cmAbout,nil,nil))),nil)))));
end;
Procedure TBlock.Reset;
var
i,j:Integer;
begin
for i:=1 to BlockHor do
for j:=1 to BlockVer do
FkSz[i,j]:=0;
JiFen:=0;
OldJiFen:=0;
Speed:=1;
Timer^.SetTime(DelayTime-Speed*10);
Randomize;
MainFx1:=Random(4)+1;
MainZl1:=Random(7)+1;
MainFx:=Random(4)+1;
MainZl:=Random(7)+1;
Ceng:=False;
Curx:=BlockHor div 2 -1;
Cury:=1;
GameBegin:=True;
GameHold:=False;
FenStr^.Modify('0');
end;
Procedure TBlock.MoveTo;
begin
Inherited MoveTo(X,Y);
AssignRect(FkRec,Broad.a.x+20,Broad.a.y+60,Broad.a.x+20+BlockHor*BlockWid,Broad.a.y+60+BlockVer*BlockHig);
AssignRect(NextRec,Broad.a.x+240,Broad.a.y+55,Broad.a.x+360,Broad.a.y+170);
end;
Procedure TBlock.Paint;
begin
Inherited Paint;
Draw;
end;
Procedure TBlock.Draw;
var
i,j:Integer;
begin
HideMouse;
for i:=0 to BlockHor-1 do
for j:=0 to BlockVer-1 do
begin
ColorFk:=FkSz[i+1,j+1];
DrawBlock(FkRec.a.x+i*BlockWid,FkRec.a.y+j*BlockHig);
end;
Full(NextRec.a.x+2,NextRec.a.y+2,NextRec.b.x-2,NextRec.b.y-2,0);
if GameBegin then
begin
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
Fk(NextRec.a.x+20,NextRec.a.y+20,MainFx1,MainZl1,True,False,True);
end;
ShowMouse;
end;
Procedure TBlock.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmAbout:RunView(New(PMsgDialog,Init('关于',
#3'俄罗斯方块v1.0'#13#3'蓝蚂蚁工作室',mbOkOnly)),Event);
cmLeft:if LeftFk then
begin
if Curx>1 then Fk(Curx,Cury,MainFx,MainZl,False,True,True);
Dec(Curx);
Ceng:=False;
if Curx<1 then Curx:=1;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
end;
cmRight:if RightFk then
begin
if Curx<>BlockHor then Fk(Curx,Cury,MainFx,MainZl,False,True,True);
Inc(Curx);
Ceng:=False;
if Curx>BlockHor then Curx:=BlockHor;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
end;
cmUp:if not Ceng then
begin
Fk(Curx,Cury,MainFx,MainZl,False,True,True);
Inc(MainFx);
if MainFx>4 then MainFx:=1;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
end;
cmDown:if not Ceng then
begin
Fk(Curx,Cury,MainFx,MainZl,False,True,True);
while not Ceng do
begin
Fk(Curx,Cury,MainFx,MainZl,False,True,False);
Inc(Cury);
Fk(Curx,Cury,MainFx,MainZl,True,True,False);
end;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
end;
cmTimer:if (Event.InfoPtr=Timer) and
GameBegin and (not GameHold) then
begin
if Ceng then
begin
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
XiaoCeng;
Curx:=BlockHor div 2 -1;
Cury:=1;
MainFx:=MainFx1;
MainZl:=MainZl1;
MainFx1:=Random(4)+1;
MainZl1:=Random(7)+1;
Ceng:=False;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
HideMouse;
Full(NextRec.a.x+2,NextRec.a.y+2,NextRec.b.x-2,NextRec.b.y-2,0);
Fk(NextRec.a.x+20,NextRec.a.y+20,MainFx1,MainZl1,True,False,True);
if (FkSz[BlockHor div 2,1]<>0) or (FkSz[BlockHor div 2-1,1]<>0) then
begin
GameBegin:=False;
Timer^.StopTimer;
if JiLu<JiFen then
begin
JiLu:=JiFen;
JiLuStr^.Modify(IntStr(JiLu));
RunView(New(PInputWin,Init('恭喜打破记录','输入姓名:',JiLuName)),Event);
end;
end;
end else
begin
Fk(Curx,Cury,MainFx,MainZl,False,True,True);
Inc(Cury);
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
Timer^.Reset;
end;
end;
cmNew:begin
Reset;
Draw;
Fk(Curx,Cury,MainFx,MainZl,True,True,True);
Timer^.Reset;
end;
cmStop:begin
GameHold:=not GameHold;
if GameHold then
Timer^.StopTimer
else Timer^.Reset;
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
Procedure TBlock.DrawBlock;
var
x1,y1,x2,y2:Integer;
begin
x1:=x;y1:=y;
x2:=x+BlockWid-1;y2:=y+BlockHig-1;
if ColorFk=0 then
begin
Full(x1,y1,x2,y2,0);
Exit;
end;
SetLineStyle(SolidLn,0,NormWidth);
SetFillStyle(1,ColorFk);
Bar(x1+2,y1+2,x2-2,y2-2);
SetColor(ColorFk+8);
Line(x1,y1,x2,y1);
Line(x1,y1,x1,y2);
Line(x1+1,y1+1,x2-1,y1+1);
Line(x1+1,y1+1,x1+1,y2-1);
Line(x1+2,y1+2,x2-2,y1+2);
Line(x1+2,y1+2,x1+2,y2-2);
SetColor(0);
Line(x1,y2,x2,y2);
Line(x2,y1,x2,y2);
Line(x1+1,y2-1,x2-1,y2-1);
Line(x2-1,y1+1,x2-1,y2-1);
Line(x1+2,y2-2,x2-2,y2-2);
Line(x2-2,y1+2,x2-2,y2-2);
end;
Procedure TBlock.Xiao(x,y:Integer;Mode:Byte;Dr:Boolean);
begin
if (y>BlockVer) or (x>BlockHor) then Exit;
if (x=BlockHor) or ((x<BlockHor) and (FkSz[x+1,y]<>0)) then RightFk:=False;
if (x=1) or ((x>1) and (FkSz[x-1,y]<>0)) then LeftFk:=False;
if Dr and (Mode<>0) then DrawBlock(FkRec.a.x+(x-1)*BlockWid,FkRec.a.y+(y-1)*BlockHig);
if Ding then FkSz[x,y]:=ColorFk;
if (y=BlockVer) or (FkSz[x,y+1]<>0) then
begin
Ceng:=True;
FkSz[x,y]:=ColorFk;
end;
end;
Procedure TBlock.Ca(x,y:Integer;Dr:Boolean);
begin
if (y>BlockVer) or (x>BlockHor) then Exit;
if Dr then Full(FkRec.a.x+(x-1)*BlockWid,FkRec.a.y+(y-1)*BlockHig,
FkRec.a.x+x*BlockWid-1,FkRec.a.y+y*BlockHig-1,0);
FkSz[x,y]:=0;
end;
Procedure TBlock.Fk(X,Y,Fx,Zl:Integer;Zt,Main,Dr:Boolean);
var
Draw_:Byte;
Procedure F(M,N:Byte);
begin
if Main then
begin
if Zt then
Xiao(x+m-1,y+n-1,draw_,Dr)
else
Ca(x+m-1,y+n-1,Dr);
end
else
DrawBlock(x+(m-1)*BlockWid,y+(n-1)*BlockHig);
end;
Procedure FK1;
begin
case fx of
1,3: begin F(1,1);F(2,1);F(3,1);F(4,1);end;
2,4: begin F(1,1);F(1,2);F(1,3);F(1,4);end;
end;
end;
Procedure fk2;
begin
F(1,1);F(1,2);F(2,1);F(2,2);
end;
Procedure fk3;
begin
case FX of
1: begin F(1,1);F(2,1);F(3,1);F(2,2);end;
2: begin F(1,1);F(1,2);F(1,3);F(2,2);end;
3: begin F(1,2);F(2,2);F(3,2);F(2,1);end;
4: begin F(2,1);F(2,2);F(2,3);F(1,2);end;
end;
end;
Procedure fk4;
begin
case FX of
1,3: begin F(1,1);F(1,2);F(2,2);F(2,3);end;
2,4: begin F(2,1);F(3,1);F(1,2);F(2,2);end;
end;
end;
Procedure fk5;
begin
case FX of
1,3: begin F(1,2);F(1,3);F(2,1);F(2,2);end;
2,4: begin F(1,1);F(2,1);F(2,2);F(3,2);end;
end;
end;
Procedure fk6;
begin
case FX of
1: begin F(1,1);F(2,1);F(3,1);F(3,2);end;
2: begin F(1,1);F(1,2);F(1,3);F(2,1);end;
3: begin F(1,2);F(2,2);F(3,2);F(1,1);end;
4: begin F(2,1);F(2,2);F(2,3);F(1,3);end;
end;
end;
Procedure fk7;
begin
case FX of
1: begin F(1,1);F(2,1);F(3,1);F(1,2);end;
2: begin F(1,1);F(1,2);F(1,3);F(2,3);end;
3: begin F(1,2);F(2,2);F(3,2);F(3,1);end;
4: begin F(2,1);F(2,2);F(2,3);F(1,1);end;
end;
end;
begin
HideMouse;
RightFk:=True;
LeftFk:=True;
Ding:=False;
Draw_:=1;
ColorFk:=Zl;
case Zl of
1 : Fk1;
2 : Fk2;
3 : Fk3;
4 : Fk4;
5 : Fk5;
6 : Fk6;
7 : Fk7;
end;
if Ceng then
begin
Ding:=True;
Draw_:=0;
case Zl of
1 : Fk1;
2 : Fk2;
3 : Fk3;
4 : Fk4;
5 : Fk5;
6 : Fk6;
7 : Fk7;
end;
Ding:=False;
end;
ShowMouse;
ClearKbBuf;
end;
Procedure TBlock.XiaoCeng;
var
m,n,o,p,q,v,Numceng,EveryFen,EveryJia:Integer;
begin
HideMouse;
EveryFen:=0;
for q:=1 to 4 do
for m:=BlockVer downto 1 do
begin
NumCeng:=0;
for n:=1 to BlockHor do
if FkSz[n,m]<>0 then Inc(NumCeng);
if NumCeng=BlockHor then
begin
Inc(EveryFen);
for o:=m downto 2 do
for p:=1 to BlockHor do FkSz[p,o]:=FkSz[p,o-1];
for p:=1 to BlockHor do FkSz[p,1]:=0;
for o:=1 to m do
for p:=1 to BlockHor do if FkSz[p,o]<>0 then
begin
ColorFk:=FkSz[p,o];
Xiao(p,o,1,True);
end else
Ca(p,o,True);
end;
end;
ShowMouse;
if EveryFen>0 then
begin
if DspFound then
begin
FMReset;
FMSetVoice(0,FM_Instrument(FM_Ins));
FMKeyOn(0,1000,3);
Delay(100);
FMKeyOff(0);
FMReset;
end else
begin
Sound(800);
Delay(50);
NoSound;
end;
end;
case EveryFen of
0 : EveryJia:=0;
1 : EveryJia:=200;
2 : EveryJia:=500;
3 : EveryJia:=1000;
4 : EveryJia:=4000;
end;
Inc(JiFen,EveryJia);
if EveryFen>0 then FenStr^.Modify(IntStr(JiFen));
if (JiFen-OldJiFen>5000)and(Speed<7) then
begin
OldJiFen:=JiFen;
Inc(Speed);
Timer^.SetTime(DelayTime-Speed*10);
end;
end;
end.