FreePascal从零开始编游戏(Display单元库使用说明)讲义.ppt

第二节 俄罗斯方块 if EraseLine then//如果是满行（消行） while j(h-1) do//从此行开始（往上） begin for i:=0 to w-1 do//遍历该行 bd[i,j]:=bd[i,j+1];//上方方块掉落 j:=j+1;//继续上一行 end; end; 第二节 俄罗斯方块 procedure FixBlock();//固定方块（落底） begin for i:=0 to 3 do for j:=0 to 3 do//遍历方块行列 if bdk[k,r,j,i]0 then bd[i+x,j+y]:=k;NewBlock();//如果是格子非空则画到场地 while EraseLine() do ;//消行 end; 第二节 俄罗斯方块 function Overlay():boolean;//判断重叠 begin Overlay:=false;//设非重叠 for i:=0 to 3 do for j:=0 to 3 do//遍历方块行列 if (bdk[k,r,j,i]0) then//如果格子非空 if (i+x0)or(i+x=w)or(j+y0)or(j+y=h) then Overlay:=true//如果超出场地则重叠 else if (bd[i+x,j+y]0) then Overlay:=true;//如果没超出场地但场地非空也重叠 end; 第二节 俄罗斯方块 procedure NewBlock();//新方块 begin x:=3;//新方块行 y:=16;//新方块列 r:=0;//新方块旋转 k:=random(7)+1;//新方块类型 if Overlay() then Restart();//如果重叠则重来 end; 第二节 俄罗斯方块 function Rotate(d:shortint):boolean;//旋转 begin r:=r+1;if r3 then r:=0;Rotate:=not(Overlay());//尝试旋转 if not(Rotate) then r:=r-1;if r0 then r:=3;//如果不能旋转则转回来 end; 第二节 俄罗斯方块 function Move(dx,dy:shortint):boolean;//移动 begin x:=x+dx;y:=y+dy;Move:=not(Overlay());//尝试移动 if not(Move) then begin x:=x-dx;y:=y-dy;end;//如果不能移动则移回来 if not(Move) and (dy0) then FixBlock();//如果不能移动且下落则固定 if dy0 then downtime:=GetTimeR();//如果下落则重置下落时间 end; 第二节 俄罗斯方块 begin//主程序 Randomize();//初始化随机种子 CreateWin(w*sz,h*sz);//建立窗口 SetTitle(俄罗斯方块);//设定标题 Restart();//重新开始 repeat//开始消息循环 if IsNextMsg() then//如果有新消息 begin 第二节 俄罗斯方块 if IsKey(37) then Move(-1,0);//如果按左则左移 if IsKey(39) then Move(+1,0);//如果按右则右移 if IsKey(40) then Move(0,-1);//如果按下则下落 if IsKey(38) then Rotate(1);//如果按上则旋转 if IsKey(32) then while Move(0,-1) do ;//如果按空格则下底 end; if GetTimeRdowntime+1 then Move(0,-1);//如果超过1秒则下落 第二节 俄罗斯方块 if GetTimeR()time+1/frame then//如果当前时间已超过一帧时间 begin while GetTimeR()time+1/frame do time:=time+1/frame;//增加帧数（包括跳帧） Clear(); for i:=0 to w-1 do for j:=0 to h-1 do DrawBlock(i,j,bd[i,j]);//画场地 for i:=0 to 3 do for j:=0 to 3 do if bdk[k,r,j,i]0 then DrawBlock(i+x,j+y,k);//画当前方块 第二节 俄罗斯方块 FreshWin();//刷新窗口 end; Delay(1);//延迟1毫秒 until not(IsWin()) or (IsKey(27));//直