- 14 Tháng năm 2017
- 3,974
- 7,619
- 744
- 21
- Phú Yên
- Trường THPT Lương Văn Chánh
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!
ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.
Vài hình ảnh Demo
Cái này là của mình
Cái này của a @Kiencoi_1997
vì không có ý tưởng cho game nào mới nên đành làm lại game cũ vậy
Cách chơi : Hoán đổi vị trí 2 khối sao cho có ít nhất 3 khối dọc hoặc ngang ở liền kề nhau (Copy về chơi thì sẽ biết chơi thôi )
Còn đây là Code:
Cái này là của mình
Cái này của a @Kiencoi_1997
vì không có ý tưởng cho game nào mới nên đành làm lại game cũ vậy
Cách chơi : Hoán đổi vị trí 2 khối sao cho có ít nhất 3 khối dọc hoặc ngang ở liền kề nhau (Copy về chơi thì sẽ biết chơi thôi
)Còn đây là Code:
Mã:
Program Bejeweled;
uses crt,dos,graph;
const
SCot = 10;
SHang = 10;
CDai = 47;
CRong = 30;
SMau = 7;
KCach = 10;
TgChoi = 240;
TocDo = 50;
type TTable = record
Color: integer;
Choosen,Detroyed: Boolean;
X,Y: integer;
end;
var gd,gm: integer;
Table: array[1..SCot,1..SHang] of TTable;
i,j,TChay,TChoi,Diem: integer;
HaveChoose,PGame: Boolean;
function mousex:word;assembler;asm
mov ax,3; int 33h; mov ax,cx end;
function mousey:word;assembler;asm
mov ax,3; int 33h; mov ax,dx end;
function leftclick:boolean;assembler;asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;
function MouseArea(x1,y1,x2,y2:word):boolean;
begin
if (LeftClick)
and (mousex >=x1)
and (mousex <=x2)
and (mousey >=y1)
and (mousey <=y2)
then mousearea:=true
else mousearea:=false;
end;
Function InitMouse : boolean;
var r: registers;
Begin
r.ax:=$00;intr($33,r);
if r.ax<>0 then InitMouse:=true
else InitMouse:=false;
End;
Procedure ShowMouse;
Var r: registers;
begin
r.ax:=$01;intr($33,r);
End;
Procedure HideMouse;
Var r:registers;
Begin
r.ax:=$002;
intr($33,r);
End;
Procedure ReDraw;
Begin
HideMouse;
for i := 1 to SCot do
for j := 1 to SHang do
begin
if Table[i,j].Choosen then
SetFillStyle(1,Table[i,j].Color+8)
else SetFillStyle(1,Black);
Bar((i-1)*CRong+KCach div 2,(j-1)*CDai+KCach div 2,
i*CRong+KCach div 2,j*CDai+KCach div 2);
SetFillStyle(1,Table[i,j].Color);
Bar((i-1)*CRong+KCach,(j-1)*CDai+KCach,i*CRong,j*CDai);
end;
ShowMouse;
End;
Procedure CreateTable;
Begin
for i := 1 to SCot do
for j := 1 to SHang do
begin
Table[i,j].Color := 1+Random(SMau);
Table[i,j].X := i;
Table[i,j].Y := j;
Table[i,j].Choosen := False;
Table[i,j].Detroyed := False;
end;
End;
Function DetroySquare: Boolean;
Begin
DetroySquare := False;
for i := 1 to SCot do
for j := 1 to SHang do
begin
if j <= SHang - 2 then
if (Table[i,j].Color = Table[i,j+1].Color)
and (Table[i,j].Color = Table[i,j+2].Color) then
begin
Table[i,j].Detroyed := True;
Table[i,j+1].Detroyed := True;
Table[i,j+2].Detroyed := True;
DeTroySquare := True;
if TChoi < TgChoi then
inc(TChoi,1);
inc(Diem);
end;
if i <= SCot - 2 then
if (Table[i,j].Color = Table[i+1,j].Color)
and (Table[i,j].Color = Table[i+2,j].Color) then
begin
Table[i,j].Detroyed := True;
Table[i+1,j].Detroyed := True;
Table[i+2,j].Detroyed := True;
DetroySquare := True;
if TChoi < TgChoi then
inc(TChoi,1);
inc(Diem);
end;
end;
End;
Procedure SetTable;
var k: integer;
Begin
for i := 1 to SCot do
for j := 1 to SHang do
begin
if Table[i,j].Detroyed then
begin
for k := j downto 2 do
begin
Table[i,k].Detroyed := Table[i,k-1].Detroyed;
Table[i,k].Color := Table[i,k-1].Color;
end;
Table[i,1].Detroyed := False;
Table[i,1].Color := 1+Random(SMau);
end;
end;
ReDraw;
if DetroySquare then SetTable;
End;
Procedure Change(x1,y1,x2,y2: integer);
var tam: integer;
Begin
tam := Table[x1,y1].Color;
Table[x1,y1].Color := Table[x2,y2].Color;
Table[x2,y2].Color := tam;
End;
Procedure ChooseSquare;
var x,y: integer;
Begin
if MouseAreA(mousex div Crong * CRong,mousey div CDai*CDai,
mousex div Crong*CRong + CRong,mousey div CDai*CDai + CDai) then
if (mousex div Crong + 1 in [1..SCot]) and (mousey div CDai + 1 in [1..SHang]) then
begin
x := mousex div CRong + 1;
y := mousey div CDai + 1;
if (x > 1) and Table[x-1,y].choosen then
begin
Change(x,y,x-1,y);
if not DeTroySquare then
Change(x,y,x-1,y);
Table[x,y].Choosen := False;
Table[x-1,y].Choosen := False;
HaveChoose := False;
end
else
if (x < SCot) and Table[x+1,y].choosen then
begin
Change(x,y,x+1,y);
if not DeTroySquare then
Change(x,y,x+1,y);
Table[x,y].Choosen := False;
Table[x+1,y].Choosen := False;
HaveChoose := False;
end
else
if (y > 1) and Table[x,y-1].choosen then
begin
Change(x,y,x,y-1);
if not DeTroySquare then
Change(x,y,x,y-1);
Table[x,y].Choosen := False;
Table[x,y-1].Choosen := False;
HaveChoose := False;
end
else
if (y < SHang) and Table[x,y+1].choosen then
begin
Change(x,y,x,y+1);
if not DeTroySquare then
Change(x,y,x,y+1);
Table[x,y].Choosen := False;
Table[x,y+1].Choosen := False;
HaveChoose := False;
end
else
if (not HaveChoose) or (Table[x,y].Choosen) then
begin
Table[x,y].choosen := not Table[x,y].choosen;
HaveChoose := not HaveChoose;
end;
Delay(200);
SetTable;
end;
End;
Procedure Timer;
Begin
inc(TChay);
if TChay = TocDo then
begin
inc(TChoi,-1);
TChay := 0;
end;
SetFillStyle(1,Black);
Bar(CRong*Scot+KCach+TChoi+50,50,
CRong*Scot+KCach+TChoi+2+50,60);
if TChoi > 2*TgChoi div 3 then
SetFillStyle(1,Green)
else
if TChoi > TgChoi div 3 then
SetFillStyle(1,Brown)
else
SetFillStyle(1,Red);
Bar(CRong*Scot+KCach+50,50,
CRong*Scot+KCach+TChoi+50,60);
SetFillStyle(1,Black);
Bar(CRong*Scot+KCach,50,CRong*SCot+KCach+47,65);
SetColor(white);
OutTextXy(CRong*Scot+KCach+2,52,'Time:');
End;
Procedure ShowScore;
var d: string;
Begin
SetFillStyle(1,Black);
Bar(CRong*Scot+KCach,80,CRong*Scot+KCach+100,95);
OutTextXy(CRong*SCot+KCach+2,82,'Score:');
Str(diem,d);
OutTextXy(CRong*SCot+KCach+60,82,d);
End;
Procedure ShowGame;
var cx: integer;
Begin
cx := CRong*Scot + KCach + 20;
SetColor(Blue);
SetTextStyle(DefaultFont,Horizdir,2);
OutTextXy(cx+10,160,'New');
OutTextXy(cx+40,184,'Game');
if not PGame then
OutTextXy(cx+170,180,'Pause')
else
OutTextXy(cx+180,180,'Cont');
OutTextXy(cx+100,280,'Exit');
SetColor(Yellow);
OutTextXy(cx+50,10,'BEJEWELED');
SetTextStyle(DefaultFont,Horizdir,0);
SetLineStyle(0,$C3,3);
SetColor(Cyan);
Rectangle(0,0,639,479);
SetLineStyle(0,$c3,1);
End;
Procedure ShowButton;
var cx: integer;
Begin
HideMouse;
cx := CRong*SCot+KCach+20;
SetFillStyle(1,LightRed);
Bar(cx,150,cx+120,220);
Bar(cx+150,150,cx+270,220);
Bar(cx,250,cx+270,320);
SetColor(White);
Rectangle(cx,150,cx+120,220);
Rectangle(cx+150,150,cx+270,220);
Rectangle(cx,250,cx+270,320);
ShowGame;
ShowMouse;
End;
Function NewGame: Boolean;
var cx: integer;
Begin
cx := CRong*SCot+KCach+20;
NewGame := False;
if MouseArea(cx,150,cx+120,220) then NewGame := True;
End;
Function Pause: Boolean;
var cx: integer;
Begin
cx := CRong*SCot+KCach+20;
Pause := False;
if MouseArea(cx+150,150,cx+270,220) then Pause := True;
End;
Function Exit: Boolean;
var cx: integer;
Begin
cx := CRong*SCot+KCach+20;
Exit := False;
if MouseArea(cx,250,cx+270,320) then Exit := True;
End;
Procedure PlayNewGame;
Begin
HideMouse;
ClearDevice;
CreateTable;
DeTroySquare;
SetTable;
ShowButton;
TChoi := TgChoi;
TChay := 0;
Diem := 0;
HaveChoose := False;
PGame := False;
InitMouse;
ShowMouse;
End;
BEGIN
InitGraph(gd,gm,'');
Randomize;
PlayNewGame;
repeat
if not PGame then
begin
Timer;
ShowScore;
ChooseSquare;
end;
if NewGame then PlayNewGame;
if Pause then begin PGame := not PGame;ShowButton;end;
until Exit or (TChoi <= 0);
if not Exit then
begin
SetTextStyle(DefaultFont, HorizDir, 3);
SetColor(Blue);
OutTextXy(10,200,'GAME OVER');
repeat until LeftClick;
end;
CloseGraph;
END.
