unit unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, Psock, NMMSG,
Menus,unit2,unit3,ScktComp, NMSTRM;
const
GlassWidth=10;
GlassHeight=23;
var
fi:integer=1;
cac:integer;
GlassWorkSheet: array [1..GlassHeight,1..GlassWidth] of Byte;
OldGlassWorkSheet: array [1..GlassHeight,1..GlassWidth] of Byte;
mess:string;
messx1,messy1,messx2,messy2:string[3];
messex1,messey1,messex2,messey2:string[3];
type
TFigureWorksheet=array [1..4,1..4] of Byte;
const
Triada: TFigureWorksheet=
((0,1,0,0),
(1,1,1,0),
(0,0,0,0),
(0,0,0,0));
LCorner: TFigureWorksheet=
((1,1,1,0),
(1,0,0,0),
(0,0,0,0),
(0,0,0,0));
RCorner: TFigureWorksheet=
((1,1,1,0),
(0,0,1,0),
(0,0,0,0),
(0,0,0,0));
LZigzag: TFigureWorksheet=
((1,1,0,0),
(0,1,1,0),
(0,0,0,0),
(0,0,0,0));
RZigzag: TFigureWorksheet=
((0,1,1,0),
(1,1,0,0),
(0,0,0,0),
(0,0,0,0));
Stick: TFigureWorksheet=
((1,1,1,1),
(0,0,0,0),
(0,0,0,0),
(0,0,0,0));
Box: TFigureWorksheet=
((1,1,0,0),
(1,1,0,0),
(0,0,0,0),
(0,0,0,0));
const
FigureWorkSheet: TFigureWorksheet=
((0,0,0,0),
(0,0,0,0),
(0,0,0,0),
(0,0,0,0));
const
BarWidth= 14;
BarHeight=14;
NextBarWidth= 9;
NextBarHeight=9;
TopOfs= 6;
LeftOfs= 160;
FieldWidth=7;
MaxFigureNumber=7;
MaxCornerNumber=4;
MaxFigureSize= 4;
MaxFigureColor= 7;
type
TMoveDirect= (mdDown,mdLeft,mdRight);
TFigureCorner=(fc00,fc90,fc180,fc270);
type
Tform1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Timer1: TTimer;
Bevel3: TBevel;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel4: TBevel;
Bevel5: TBevel;
MainMenu1: TMainMenu;
system1: TMenuItem;
connect1: TMenuItem;
about1: TMenuItem;
help1: TMenuItem;
N1: TMenuItem;
StatusBar1: TStatusBar;
NMStrm1: TNMStrm;
NMStrmServ1: TNMStrmServ;
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure help1Click(Sender: TObject);
procedure connect1Click(Sender: TObject);
procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
private
public
Level: Byte;
Score: Longint;
ReentTimer: Boolean;
ReentKeys: Boolean;
FigureActive: Boolean;
FigureType: Byte;
FigureX: Byte;
FigureY: Byte;
FigureCorner: TFigureCorner;
FigureMove: TMoveDirect;
FirstColor: Byte;
SecondColor: Byte;
FirstFigure: Byte;
SecondFigure: Byte;
NextTopOfs: Integer;
NextLeftOfs: Integer;
RedrawSheet: Boolean;
function FigureXSize: Byte;
function FigureYSize: Byte;
procedure GenerateNewFigure;
procedure ClearFigureIntoGlass;
function PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
procedure RotateFigure;
procedure ScanFillLines;
procedure SetFigureColor;
end;
var
form1: Tform1;
implementation
{$R *.DFM}
procedure Tform1.FormPaint(Sender: TObject);
var
X1,Y1,X2,Y2: Integer;
NewRect: TRect;
I,J: Byte;
CurSheet: TFigureWorksheet;
NextColor: TColor;
MS: TMemoryStream;
begin
if RedrawSheet then FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
for I := 1 to GlassHeight do
for J := 1 to GlassWidth do begin
if GlassWorkSheet[I,J]=OldGlassWorkSheet[I,J] then Continue;
X1 := LeftOfs+(J-1)*BarWidth;
X2 := X1+BarWidth;
Y1 := TopOfs+(I-1)*BarHeight;
Y2 := Y1+BarHeight;
case GlassWorkSheet[I,J] of
0: Canvas.Brush.Color := clnavy;
1: Canvas.Brush.Color := clteal;
2: Canvas.Brush.Color := clRed;
3: Canvas.Brush.Color := clLime;
4: Canvas.Brush.Color := clBlue;
5: Canvas.Brush.Color := clFuchsia;
6: Canvas.Brush.Color := clAqua;
7: Canvas.Brush.Color := clYellow;
8: Canvas.Brush.Color := clWhite;
end;
if GlassWorkSheet[I,J]>0 then
begin
NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
Canvas.FillRect(NewRect);
if form3.caption='connected' then
begin
case x1 of
0..9 : messx1:='00'+inttostr(x1);
10..99 : messx1:='0'+inttostr(x1);
100..999 : messx1:=inttostr(x1);
end;
case y1 of
0..9 : messy1:='00'+inttostr(y1);
10..99 : messy1:='0'+inttostr(y1);
100..999 : messy1:=inttostr(y1);
end;
case x2 of
0..9 : messx2:='00'+inttostr(x2);
10..99 : messx2:='0'+inttostr(x2);
100..999 : messx2:=inttostr(x2);
end;
case y2 of
0..9 : messy2:='00'+inttostr(y2);
10..99 : messy2:='0'+inttostr(y2);
100..999 : messy2:=inttostr(y2);
end;
mess:=messx1+messy1+messx2+messy2;
NMStrm1.Host :=form3.edit1.text;
MS := TMemoryStream.Create;
try
StreamLn(MS, MESS);
NMStrm1.PostIt(MS);
finally
MS.Free;
end;
end;
end
else begin
NewRect := Rect(X1,Y1,X2,Y2);
Canvas.FillRect(NewRect);
end;
end;
case FirstFigure of
0: Move(Triada,CurSheet,SizeOf(CurSheet));
1: Move(LCorner,CurSheet,SizeOf(CurSheet));
2: Move(RCorner,CurSheet,SizeOf(CurSheet));
3: Move(LZigzag,CurSheet,SizeOf(CurSheet));
4: Move(RZigzag,CurSheet,SizeOf(CurSheet));
5: Move(Stick,CurSheet,SizeOf(CurSheet));
6: Move(Box,CurSheet,SizeOf(CurSheet));
end;
case FirstColor of
0: NextColor := clnavy;
1: NextColor := clteal;
2: NextColor := clRed;
3: NextColor := clLime;
4: NextColor := clBlue;
5: NextColor := clFuchsia;
6: NextColor := clAqua;
7: NextColor := clYellow;
8: NextColor := clWhite;
end;
for I := 1 to MaxFigureSize-2 do
for J := 1 to MaxFigureSize do begin
X1 := NextLeftOfs+(J-1)*NextBarWidth;
X2 := X1+NextBarWidth;
Y1 := NextTopOfs+(I-1)*NextBarHeight;
Y2 := Y1+NextBarHeight;
if CurSheet[I,J]>0 then begin
NewRect := Rect(X1+1,Y1+1,X2-1,Y2-1);
Canvas.Brush.Color := NextColor;
Canvas.FillRect(NewRect);
end
else begin
Canvas.Brush.Color := clgreen;
NewRect := Rect(X1,Y1,X2,Y2);
Canvas.FillRect(newRect);
end;
end;
Move(GlassWorkSheet,OldGlassWorkSheet,SizeOf(OldGlassWorkSheet));
end;
function Tform1.FigureXSize: Byte;
var
I,J,K: Byte;
begin
K := 0;
for J := 1 to MaxFigureSize do
for I := 1 to MaxFigureSize do
if FigureWorkSheet[J,I]>0 then
if K<I then K := I;
FigureXSize := K;
end;
function Tform1.FigureYSize: Byte;
var
I,J,K: Byte;
begin
K := 0;
for J := 1 to MaxFigureSize do
for I := 1 to MaxFigureSize do
if FigureWorkSheet[J,I]>0 then
if K<J then K := J;
FigureYSize := K;
end;
procedure Tform1.GenerateNewFigure;
begin
Timer1.Enabled := False;
SecondFigure := FirstFigure;
SecondColor := FirstColor;
FigureType := SecondFigure;
FigureX := 5;
FigureY := 0;
FigureCorner := fc270;
FillChar(FigureWorkSheet,SizeOf(FigureWorkSheet),0);
case FigureType of
0: Move(Triada,FigureWorkSheet,SizeOf(FigureWorkSheet));
1: Move(LCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
2: Move(RCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
3: Move(LZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
4: Move(RZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
5: Move(Stick,FigureWorkSheet,SizeOf(FigureWorkSheet));
6: Move(Box,FigureWorkSheet,SizeOf(FigureWorkSheet));
end;
SetFigureColor;
FigureMove := mdDown;
FirstFigure := Random(MaxFigureNumber);
FirstColor := Random(MaxFigureColor)+1;
Timer1.Enabled := True;
end;
procedure Tform1.ClearFigureIntoGlass;
var
I,J: Byte;
begin
for J := 1 to FigureYSize do
for I := 1 to FigureXSize do
if FigureWorkSheet[J,I]>0 then
GlassWorkSheet[FigureY+J,FigureX+I] := 0;
end;
function Tform1.PutFigureIntoGlass(MoveDirect: TMoveDirect): Boolean;
var
I,J: Byte;
begin
PutFigureIntoGlass := True;
if (FigureY+FigureYSize>GlassHeight) and (MoveDirect=mdDown) then begin
Dec(FigureY);
PutFigureIntoGlass := False;
Exit;
end
else
while (FigureX+FigureXSize>GlassWidth) and (MoveDirect=mdDown) do
Dec(FigureX);
for J := 1 to FigureYSize do begin
for I := 1 to FigureXSize do begin
if (FigureWorkSheet[J,I]>0) and
(GlassWorkSheet[FigureY+J,FigureX+I]>0) then begin
PutFigureIntoGlass := False;
case MoveDirect of
mdDown: Dec(FigureY);
mdRight: Dec(FigureX);
mdLeft: Inc(FigureX);
end;
Exit;
end;
end;
end;
for J := 1 to FigureYSize do
for I := 1 to FigureXSize do
if FigureWorkSheet[J,I]>0 then
GlassWorkSheet[FigureY+J,FigureX+I] := FigureWorkSheet[J,I];
RedrawSheet := False;
FormPaint(Self);
RedrawSheet := True;
end;
procedure Tform1.ScanFillLines;
var
I,J,K,L: byte;
begin
ClearFigureIntoGlass;
for I := 1 to GlassHeight do begin
K := 0;
for J := 1 to GlassWidth do
if GlassWorkSheet[I,J]>0 then Inc(K);
if K=GlassWidth then begin
for L := I downto 1 do
for J := 1 to GlassWidth do
if L>1 then GlassWorkSheet[L,J] := GlassWorkSheet[L-1,J];
end;
end;
PutFigureIntoGlass(FigureMove);
end;
procedure Tform1.Timer1Timer(Sender: TObject);
var
I,J: Byte;
begin
if ReentTimer then Exit
else ReentTimer := True;
if StrToInt(Label3.Caption)<>Level then Label3.Caption := IntToStr(Level);
if StrToInt(Label4.Caption)<>Score then Label4.Caption := IntToStr(Score);
if not FigureActive then begin
GenerateNewFigure;
if not PutFigureIntoGlass(FigureMove) then begin
MessageDlg('Glass is full... Game over!',mtInformation,[mbOk],0);
FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
Timer1.Enabled := False;
SpeedButton5.Enabled := True;
SpeedButton6.Enabled := False;
SpeedButton7.Enabled := False;
ClearFigureIntoGlass;
FigureActive := False;
Level := 1;
Score := 0;
for I := 1 to GlassHeight do
for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
RedrawSheet := False;
FormPaint(Self);
RedrawSheet := True;
end;
FigureActive := True;
end
else begin
ClearFigureIntoGlass;
Inc(FigureY);
if not PutFigureIntoGlass(FigureMove) then begin
case FigureType of
0: Score := Score+10;
1: Score := Score+30;
2: Score := Score+30;
3: Score := Score+25;
4: Score := Score+25;
5: Score := Score+15;
6: Score := Score+20;
end;
if Score>300 then Level := 2;
if Score>700 then Level := 3;
if Score>1300 then Level := 4;
if Score>2000 then Level := 5;
if Score>3000 then Level := 6;
if Score>5000 then Level := 7;
Timer1.Interval := 500;
FigureActive := False;
end;
end;
ScanFillLines;
ReentTimer := False;
end;
procedure Tform1.FormCreate(Sender: TObject);
begin
FillChar(OldGlassWorkSheet,SizeOf(OldGlassWorkSheet),#255);
RedrawSheet := True;
with Bevel3 do begin
Top := TopOfs-FieldWidth+3;
Left := LeftOfs-FieldWidth+2;
Width := GlassWidth*BarWidth+FieldWidth*2;
Height := GlassHeight*BarHeight+FieldWidth*2;
end;
ClientWidth := Bevel3.Width+FieldWidth*3+SpeedButton5.Width+170;
ClientHeight := Bevel3.Height+FieldWidth*2;
bevel5.width:=bevel3.width-2;
bevel5.height:=bevel3.height;
bevel5.top:=bevel3.top;
SpeedButton5.Left := Bevel3.Width+FieldWidth*2+160;
SpeedButton6.Left := SpeedButton5.Left;
SpeedButton7.Left := SpeedButton5.Left;
SpeedButton8.Left := SpeedButton5.Left;
Label1.Left := Bevel3.Width+FieldWidth*2+160;
Label2.Left := Label1.Left;
Bevel1.Left := Label1.Left;
Bevel1.Width := SpeedButton5.Width;
Bevel2.Left := Label1.Left;
Bevel2.Width := SpeedButton5.Width;
Label3.Left := Bevel1.Left+FieldWidth+10;
Label4.Left := Bevel1.Left+FieldWidth+38;
Bevel4.Top := SpeedButton7.Top+SpeedButton7.Height+25;
Bevel4.Left := SpeedButton7.Left+SpeedButton7.Width div 4-4;
Bevel4.Height := NextBarHeight*(MaxFigureSize-1)+4;
Bevel4.Width :=NextBarWidth*MaxFigureSize+8;
NextTopOfs := SpeedButton7.Top+SpeedButton7.Height+32;
NextLeftOfs := SpeedButton7.Left+SpeedButton7.Width div 4;
Level := 1;
Timer1.Interval := Round((6.5-Level)*100);
Score := 0;
ReentTimer := False;
ReentKeys := False;
FigureActive := False;
Label3.Caption := '1';
Label4.Caption := '0';
Randomize;
FirstFigure := Random(MaxFigureNumber);
FirstColor := Random(MaxFigureColor)+1;
end;
procedure Tform1.RotateFigure;
var
OldFigureCornet: TFigureCorner;
CurSheet: TFigureWorksheet;
OldFigureCorner: TFigureCorner;
procedure RotateFigureWorksheet;
var
VertFlag: Byte;
HorizFlag: Byte;
K,I,J: Byte;
begin
FillChar(FigureWorkSheet,SizeOf(FigureWorkSheet),0);
case FigureType of
0: Move(Triada,FigureWorkSheet,SizeOf(FigureWorkSheet));
1: Move(LCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
2: Move(RCorner,FigureWorkSheet,SizeOf(FigureWorkSheet));
3: Move(LZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
4: Move(RZigzag,FigureWorkSheet,SizeOf(FigureWorkSheet));
5: Move(Stick,FigureWorkSheet,SizeOf(FigureWorkSheet));
6: Move(Box,FigureWorkSheet,SizeOf(FigureWorkSheet));
end;
FillChar(CurSheet,SizeOf(CurSheet),0);
for K := 0 to Byte(FigureCorner) do begin
for I := 1 to MaxFigureSize do
for J := 1 to MaxFigureSize do
CurSheet[J,I] := FigureWorkSheet[MaxFigureSize-I+1,J];
Move(CurSheet,FigureWorkSheet,SizeOf(FigureWorkSheet));
end;
SetFigureColor;
HorizFlag := 0;
while HorizFlag=0 do begin
for I := 1 to MaxFigureSize do
if FigureWorkSheet[1,I]>0 then HorizFlag := 1;
if HorizFlag=0 then begin
for J := 1 to MaxFigureSize-1 do
for I := 1 to MaxFigureSize do
FigureWorkSheet[J,I] := FigureWorkSheet[J+1,I];
for J := 1 to MaxFigureSize do
FigureWorkSheet[MaxFigureSize,J] := 0;
end;
end;
VertFlag := 0;
while VertFlag=0 do begin
for J := 1 to MaxFigureSize do
if FigureWorkSheet[J,1]>0 then VertFlag := 1;
if VertFlag=0 then begin
for J := 1 to MaxFigureSize do
for I := 1 to MaxFigureSize-1 do
FigureWorkSheet[J,I] := FigureWorkSheet[J,I+1];
for J := 1 to MaxFigureSize do
FigureWorkSheet[J,MaxFigureSize] := 0;
end;
end;
end;
begin
ClearFigureIntoGlass;
OldFigureCorner := FigureCorner;
if FigureCorner>fc00 then Dec(FigureCorner)
else FigureCorner := fc270;
RotateFigureWorksheet;
if not PutFigureIntoGlass(mdDown) then begin
FigureCorner := OldFigureCorner;
RotateFigureWorksheet;
PutFigureIntoGlass(mdDown);
end;
end;
procedure Tform1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ReentKeys then Exit
else ReentKeys := True;
if not FigureActive then begin
ReentKeys := False;
Exit;
end;
case Key of
VK_UP: RotateFigure;
VK_DOWN: begin
repeat
ClearFigureIntoGlass;
Inc(FigureY);
until not PutFigureIntoGlass(mdDown);
Inc(Score,5);
end;
VK_LEFT: if FigureX>0 then begin
ClearFigureIntoGlass;
Dec(FigureX);
PutFigureIntoGlass(mdLeft);
end;
VK_RIGHT: if FigureX+FigureXSize<GlassWidth then begin
ClearFigureIntoGlass;
Inc(FigureX);
PutFigureIntoGlass(mdRight);
end;
end;
ReentKeys := False;
end;
procedure Tform1.SetFigureColor;
var
I,J: Byte;
begin
for I := 1 to MaxFigureSize do
for J := 1 to MaxFigureSize do
if FigureWorkSheet[I,J]>0 then FigureWorkSheet[I,J] := SecondColor;
end;
procedure Tform1.SpeedButton8Click(Sender: TObject);
begin
if Application.Messagebox('退出游戏?','退出系统',mb_okcancel+mb_iconstop)=idok then
Application.Terminate;
end;
procedure Tform1.SpeedButton5Click(Sender: TObject);
begin
Timer1.Enabled := True;
SpeedButton5.Enabled := False;
SpeedButton6.Enabled := True;
SpeedButton7.Enabled := True;
end;
procedure Tform1.SpeedButton6Click(Sender: TObject);
begin
if (cac mod 2)=0 then speedbutton6.caption:='再来(&C)';
if (cac mod 2)<>0 then speedbutton6.caption:='歇一歇(&P)';
inc(cac);
if Timer1.Enabled then begin
Timer1.Enabled := False;
end
else begin
Timer1.Enabled := True;
end;
end;
procedure Tform1.SpeedButton7Click(Sender: TObject);
var
I,J: Byte;
begin
if speedbutton6.caption='再来(&C)' then
begin
speedbutton6.caption:='歇一歇(&C)';
cac:=0;
end;
Timer1.Enabled := False;
ClearFigureIntoGlass;
FigureActive := False;
Level := 1;
Score := 0;
for I := 1 to GlassHeight do
for J := 1 to GlassWidth do GlassWorkSheet[I,J] := 0;
RedrawSheet := False;
FormPaint(Self);
RedrawSheet := True;
Timer1.Enabled := True;
end;
procedure Tform1.help1Click(Sender: TObject);
begin
form2.showmodal;
end;
procedure Tform1.connect1Click(Sender: TObject);
begin
form3.showmodal;
end;
procedure Tform1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
SS: TStringStream;
newrect2:trect;
begin
SS := TStringStream.Create('');
try
SS.CopyFrom(strm, strm.size);
messex1:=copy(SS.DataString,1,3);
messey1:=copy(SS.DataString,4,3);
messex2:=copy(SS.DataString,7,3);
messey2:=copy(SS.DataString,10,3);
finally
SS.Free;
end;
with form1.canvas do
begin
if fi=1 then
begin
brush.color:=clnavy;
newrect2:=rect(6,6,150,500);
fillrect(newrect2);
fi:=0;
end;
brush.color:=clwhite;
newrect2:=rect(strtoint(messex1)-155+1,strtoint(messey1)+1,strtoint(messex2)-155-1,strtoint(messy2)-1);
canvas.fillrect(newrect2);
end;
end;
end.