一楼度娘

二楼原作者 狼妹宋天琢



{$APPTYPE GUI}
{$MODE DELPHI}
program WinPiece;
uses
Windows; const
AppName = 'WinPiece';
pm = 25; var
flat :boolean;
dc : hdc;
AMessage : Msg;
hWindow: HWnd;
hPen ,hBrush : longword;
intNextPiece, intCurPiece,intTempPiece : longint;
BigMap : array [0..11,-4..20] of boolean;
NextPiece,CurPiece,TempPiece : array [0..3,0..3] of boolean;
isGameing : boolean;
Piece : array [0..18] of longint;
scoreString, levelString: string;
xPos, yPos : integer;
score,level : longint; //分数,关卡
speed : integer; procedure TimerProc(Window:HWND;uMsg:UINT;idEvent:UINT;Time:DWORD);stdcall;
FORWARD;
Procedure IntToNextPiece ( );
var
i,j : integer;
t: longint;
begin
t:=intNextPiece;
For i:=0 TO 3 DO
For j:=0 TO 3 DO
begin
If (t mod 2=1) Then
NextPiece[j][i] := true
else
NextPiece[j][i] := false ; t := t div 2;
end; end; Procedure IntToCurPiece ( );
var
i,j : integer;
t : longint;
begin
t:=intCurPiece;
For i:=0 TO 3 DO
For j:=0 TO 3 DO
begin
If (t mod 2=1) Then
CurPiece[j][i] := true
else
CurPiece[j][i] := false ;
t := t div 2;
end;
end; Procedure IntToTempPiece ( );
var
i,j : integer;
t : longint;
begin
t:=intTempPiece;
For i:=0 TO 3 DO
For j:=0 TO 3 DO
begin
If (t mod 2=1) Then
TempPiece[j][i] := true
else
TempPiece[j][i] := false ;
t := t div 2;
end;
end; Procedure DrawPiece(x,y:integer);
begin
SelectObject (dc,GetStockObject (NULL_PEN)) ; //选择空画笔
hBrush := CreateSolidBrush (RGB(255,0,128)); //创建粉色笔刷
SelectObject (dc,hBrush) ; //选择我们创建的粉色笔刷
Rectangle(dc,x,y,x+pm,y+pm); //画粉色矩形
DeleteObject(hBrush); //删除刚创建的粉色笔刷
SelectObject (dc,GetStockObject (WHITE_PEN)) ; //选择白色画笔
MoveToEx (dc, x+24,y, nil);
LineTo(dc,x,y);
LineTo(dc,x,y+24);
hPen:=CreatePen(PS_SOLID,1, RGB(100,100,100)); //创建灰色画笔
SelectObject (dc,hPen) ; //选择我们刚创建的灰色画笔
LineTo(dc,x+24,y+24);
LineTo(dc,x+24,y);
DeleteObject(hPen); //删除我们刚创建的灰色画笔
end;

Procedure DrawNextMap( );
var
i, j : integer;
begin
SelectObject (dc,GetStockObject (BLACK_PEN)); //选择黑色画笔
SelectObject (dc,GetStockObject (BLACK_BRUSH)); //选择黑色画笔
Rectangle(dc,277,66,277+pm*4,66+pm*4); //先画BigMap黑色矩形背景
IntToNextPiece();
SelectObject (dc,GetStockObject (WHITE_PEN)) ;
For i:= 0 to 3 DO
begin
For j:=0 TO 3 DO
begin
If NextPiece[i][j] Then
begin
DrawPiece(277+pm*i,66+pm*j);
end;
end;
end;
end;
Procedure DrawBigMap( );
var
i, j:integer;
begin
For i:= 1 TO 10 DO
begin
For j:= 0 TO 19 DO
begin
If BigMap[i][j] Then
DrawPiece(12+(i-1)*pm,66+j*pm)
else
begin
SelectObject (dc, GetStockObject (BLACK_PEN)) ;
SelectObject (dc, GetStockObject (BLACK_BRUSH)) ;
Rectangle(dc,12+(i-1)*pm,66+j*pm,12+(i-1)*pm+pm,66+j*pm+pm);
end;
end;
end;
end; Procedure DrawCurMap();
var
i, j : integer;
begin
IntToCurPiece();
For i:=0 TO 3 DO
For j:= 0 TO 3 DO
If (CurPiece[i][j]) and (yPos+j>=0) Then DrawPiece(12+(xPos+i-1)*pm,66+(yPos+j)*pm);
end; Procedure DrawScore ( );
begin
SetBkColor(dc,RGB(200,200,200)); //设置字体的背景色为灰色，以与窗口背景保持一致
TextOut(dc,277,210,PChar(scoreString),length(scoreString)); //输出分数
TextOut(dc,277,260, PChar(levelString),length(levelString)); //输出过关数
//MessageBox(0,'','',MB_OK);
end;


Procedure FillBigMap ( ); //记录大图
var
i, j : integer;
begin
For i:=0 TO 3 DO
For j:=0 TO 3 DO
If CurPiece[i][j] Then
BigMap[xPos+i][yPos+j]:=true;
end; Function IsGameOver ( ) : boolean; //游戏是过否结束
var
i:integer;
r:boolean;
begin
r:=false ;
For i:=1 TO 10 DO
If BigMap[i][0] Then //当 最上一行有小格为1，返回真
begin
r:=true ;
break
end;
IsGameOver := r ;
end; Procedure ClearLine ( ); //消行
var
linesCount, count, i, j, k, m: integer;
begin
linesCount := 0; //一次消行的行数
j:=19;
while j>=0 do
begin
count:=0;
For i:=1 TO 10 DO
If BigMap[i][j] Then
inc(count);
If count=10 Then //count=10，表明该行已满
begin
inc(linesCount);
For k:= j downTO 1 DO
For m:= 1 TO 10 DO
BigMap[m][k]:=BigMap[m][k-1];
//inc(j);
//这个怎么办????
//此问题由Recano解决
end else dec(j);
end;
if(linesCount>0) then
begin
k := 0;
for i := 1 to linesCount do
begin
k := k + 10;
score:=score+k;
end;
str(score,scoreString);
scoreString:='分数:'+ scoreString + ' ';
if( level<>(score div 1000) ) then
begin
level := score div 1000;
str(level,levelString);
levelString:='级别:'+ levelString + ' ';
KillTimer(hwindow,11);
speed:=speed div 2;
SetTimer(hWindow,11,speed,@TimerProc);
end;
end;
end; procedure TimerProc(Window:HWND;uMsg:UINT;idEvent:UINT;Time:DWORD);stdcall;
begin
If (CanDown()) then //如果能继续下落
yPos := yPos + 1 //则CurPiece下落（纵坐标加1 ）
else //如果不能下落
begin
FillBigMap(); //将CurPiece填入BigMap
intCurPiece:=intNextPiece;
IntToCurPiece(); intNextPiece:=NewPiece(); //随机产生新方块，并复制给NextPiece
IntToNextPiece();
xPos:=4; //横坐标初始化为4
yPos:=-4; //纵坐标初始化为-1
ClearLine(); //消行
if(IsGameOver()) then
begin
KillTimer(window,11);
isGameing:=false ;
MessageBox(window,'游戏结束！','提示',MB_OK);
end; end;
PostMessage(window, WM_PAINT, 0, 0);
end; Procedure BeginGame ( );
begin
flat := true; //此处由Recano修改，表示游戏开始
init();
randomize;
intCurPiece:=NewPiece(); //随机产生新方块，并复制给NextPiece
IntToCurPiece();
intNextPiece:=NewPiece(); //随机产生新方块，并复制给NextPiece
IntToNextPiece();
isGameing:=true;
speed:=1000;
SetTimer(hWindow,11,speed,@TimerProc); //定时器id为11，时间间隔为1000ms，时间回调函数是TimerProc()
end;

WM_KEYDOWN:
begin
if(isGameing) then
begin
NrMenu := WParam And $FFFF;
case NrMenu of
VK_UP:
If CanTurn() Then
begin
PostMessage(window,WM_PAINT,0,0);
end;
VK_LEFT:
If CanLeft() Then
begin
dec(xpos);
PostMessage(window,WM_PAINT,0,0);
end;
VK_RIGHT:
If CanRight() Then
begin
inc(xpos);
PostMessage(window,WM_PAINT,0,0);
end;
VK_DOWN:
If CanDown() Then
begin
TimerProc(window,11,0,0);
end;
end;
end;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end; { Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: WndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@WindowProc);
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppName; WinRegister := RegisterClass(WindowClass) <> 0;
end; { Create the Window Class }
function WinCreate: HWnd; begin
hWindow := CreateWindow(AppName, '俄罗斯方块',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
400, 615, 0, 0, system.MainInstance, nil); if hWindow <> 0 then
begin
ShowWindow(hWindow, CmdShow);
ShowWindow(hWindow, SW_SHOW);
UpdateWindow(hWindow);
end; WinCreate := hWindow;
end;

Procedure VarInit( );
begin
Piece[0]:=13056;
Piece[1]:=8738;
Piece[2]:=3840;
Piece[3]:=25344;
Piece[4]:=4896;
Piece[5]:=13824;
Piece[6]:=8976;
Piece[7]:=29184;
Piece[8]:=17984;
Piece[9]:=9984;
Piece[10]:=4880;
Piece[11]:=25120;
Piece[12]:=29696;
Piece[13]:=17504;
Piece[14]:=5888;
Piece[15]:=12832;
Piece[16]:=18176;
Piece[17]:=8800;
Piece[18]:=28928;
end; begin
VarInit();
if not WinRegister then
begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if longint(hWindow) = 0 then
begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end; while GetMessage(@AMessage, 0, 0, 0) do
begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.


各种膜拜

Orz

orz

我邮箱[email protected]欢迎交流

刘明

代码和exe都能发一份吗，万分感谢！[email protected]

代码和exe都能发一份吗，万分感谢！ 我的邮箱是[email protected] 谢谢啦

求代码、exe发到[email protected]
万分感谢

[email protected]
源代码和EXE各发一份，谢谢了~~~

亲，能否把exe发到我的邮箱？[email protected]

还有代码。。。。哦