K
Khách

Hãy nhập câu hỏi của bạn vào đây, nếu là tài khoản VIP, bạn sẽ được ưu tiên trả lời.

Program Game_Bong_Da;
uses crt,dos;
const
ChieuRong = 60;
ChieuCao = 23;
KhoangCachDong = 1;
KhoangCachCot = 0;
ChieuRongKhungThanh = 8;

SoCauThu = 8;

Front = 1;
BeHind = 2;
Left = 3;
Right = 4;

Tocdo = 15;

type
TSanBong = object
Procedure VeSanBong;
Procedure KhoiTaoCauThu;
end;
TViTri = object
X, Y : integer;
Procedure SetViTri(vtX, vtY: integer);
end;
TGioiHan = object
X1, X2, Y1, Y2 : integer;
Procedure SetGioiHan(vtX1, vtY1, vtX2, vtY2 : integer);
end;

TBong = object
Sohuu : array[0..2,0..SoCauThu] of Boolean;
Vitri : TVitri;
Procedure SetSoHuu(doi, ten : integer);
Procedure InBong(doi, caut, Huong : integer);
Procedure CanBong;
Procedure SutBong(Huong : integer);
Function HuongChuyenBong(doi, caut : integer) : integer;
Procedure XuLi;
end;

TCauThu = object
Doi : integer;
Ten : integer;
GioiHan : TGioiHan;
Vitri : TVitri;
MauAo : Word;
KeyPress : Char;

Procedure SetCauThuHT;
Procedure InHinh(vtX,vtY : integer);
Procedure GianhBong;
Procedure DichuyenNgauNhien;
Procedure DiChuyen(Key : char);
end;
TMayTinh = object
CauThuHT : array[1..2] of integer;
PT : Boolean;
Procedure KiemTra;
Procedure TanCong;
Procedure PhongThu;
end;

var
LastHuong,HuongChuyen,CauThuHT : integer;
san : TSanBong;
cauthu : array[1..2,1..SoCauThu] of TCauThu;
QBong : TBong;
DangSut,vtMax,DangChuyen : Boolean;
DiemSo : array[1..2] of integer;
MayTinh : TMayTinh;

procedure setcusor(bot,top: byte);
var regs : registers;
begin
regs.ah := 1;
regs.ch:= bot;
regs.cl:= top;
intr($10, regs);
end;

Procedure TViTri.SetVitri(vtX, vtY : integer);
Begin
X := vtX;
Y := vtY;
End;

Procedure TGioiHan.SetGioiHan(vtX1, vtY1, vtX2, vtY2 : integer);
Begin
X1 := vtX1;
Y1 := vtY1;
X2 := vtX2;
Y2 := vtY2;
End;

(*==============S Bong===============================*)
Procedure TBong.SetSoHuu(doi, ten: integer);
var d,t : integer;
Begin
for d := 0 to 2 do
for t := 0 to SoCauThu do
begin
if (d = doi) and (t = ten) then
SoHuu[d, t] := True
else
SoHuu[d, t] := False;
end;
End;

Procedure TBong.InBong(doi, caut, Huong : integer);
Begin
if (QBong.SoHuu[doi, caut]) and (not DangSut) then
begin
if LastHuong <> Huong then
begin
GotoXy(Vitri.X,Vitri.Y);
Write(#32);
end;
case Huong of
Front : begin
TextColor(white);
Vitri.X := CauThu[doi,caut].Vitri.X;
Vitri.Y := CauThu[doi,caut].Vitri.Y-1;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
BeHind : begin
TextColor(white);
Vitri.X := CauThu[doi,caut].Vitri.X;
Vitri.Y := CauThu[doi,caut].Vitri.Y+1;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
Left : begin
TextColor(white);
Vitri.X := CauThu[doi,caut].Vitri.X - 1;
Vitri.Y := CauThu[doi,caut].Vitri.Y;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
Right : begin
TextColor(white);
Vitri.X := CauThu[doi,caut].Vitri.X + 1;
Vitri.Y := CauThu[doi,caut].Vitri.Y;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
end;
LastHuong := Huong;
if (Vitri.Y <= Khoangcachdong+1) or
(Vitri.Y >= KhoangCachDong+ChieuCao) or
(Vitri.X <= KhoangCachcot+1) or
(Vitri.X >= KhoangCachcot + chieurong) then
begin
vtMax := True;
DangSut := True;
end;
CanBong;
end;
End;

Procedure TBong.SutBong(Huong : integer);
Begin
if not vtMax then
begin
GotoXy(Vitri.X,Vitri.Y);
Write(#32);
end;
case Huong of
Front : if Vitri.Y > Khoangcachdong+1 then
begin
TextColor(white);
Vitri.X := Vitri.X;
Vitri.Y := Vitri.Y-2;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
BeHind :if Vitri.Y < Khoangcachdong+ChieuCao then
begin
TextColor(white);
Vitri.X := Vitri.X;
Vitri.Y := Vitri.Y+2;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
Left :if Vitri.X > KhoangcachCot+1 then
begin
TextColor(white);
Vitri.X := Vitri.X - 2;
Vitri.Y := Vitri.Y;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
Right :if Vitri.X < KhoangcachCot+ChieuRong then
begin
TextColor(white);
Vitri.X := Vitri.X + 2;
Vitri.Y := Vitri.Y;
GotoXy(Vitri.X,Vitri.Y);
Write(#265);
end;
end;
if (Vitri.Y <= Khoangcachdong+1) or
(Vitri.Y >= KhoangCachDong+ChieuCao) or
(Vitri.X <= KhoangCachcot+1) or
(Vitri.X >= KhoangCachcot + chieurong) then
begin
vtMax := True;
end;
CanBong;
Cauthu[1,1].SetCauThuHT;
End;

Procedure TBong.CanBong;
var doi,caut : integer;
Begin
for doi := 1 to 2 do
for caut := 1 to Socauthu do
begin
if (CauThu[doi,caut].Vitri.X = Vitri.X)
and (CauThu[doi,caut].Vitri.Y = Vitri.Y) then
begin
SetSoHuu(doi,caut);
if CauThu[doi,caut].Vitri.Y > ChieuCao div 2 then
begin
InBong(doi,caut,Front);
Cauthu[doi,caut].Vitri.Y := Cauthu[doi,caut].Vitri.Y-1;
end
else
begin
InBong(doi,caut,Behind);
Cauthu[doi,caut].Vitri.Y := Cauthu[doi,caut].Vitri.Y+1;
end;
TextColor(Cauthu[doi,caut].MauAo);
GotoXy(Cauthu[doi,caut].Vitri.X,CauThu[doi,caut].Vitri.Y);
Write(#258);
DangSut := False;
DangChuyen := False;
end;
end;
end;

Function TBong.HuongChuyenBong(doi, caut : integer) : integer;

var ct,Min,Tam,Huong : integer;
Begin
Min := ChieuRong+ChieuCao;
for ct := 1 to SoCauThu do
if ct <> caut then
begin
Tam := Cauthu[doi, ct].Vitri.X - Cauthu[doi, caut].Vitri.X;
if Abs(Min) > Abs(Tam) then
begin
Min := Tam;
if Min < 0 then Huong := Left
else if Min > 0 then Huong := Right;
end;
Tam := Cauthu[doi, ct].Vitri.Y - Cauthu[doi, caut].Vitri.Y;
if Abs(Min) > Abs(Tam) then
begin
Min := Tam;
if Min < 0 then Huong := Front
else if Min > 0 then Huong := BeHind;
end;
HuongChuyenBong := Huong;
end;

End;

Procedure TBong.XuLi;
Begin
if (vtMax) and (Vitri.X >= CauThu[1,1].GioiHan.X1)
and (Vitri.X <= CauThu[1,1].GioiHan.X2)
and (DangSut or Dangchuyen) then
begin
DangSut := False;
DangChuyen := False;
vtMax := False;

if (Vitri.Y > ChieuCao div 2) then
begin
Inc(DiemSo[2]);
SetSoHuu(1,1);
Cauthu[1,CauThuHT].MauAo := Green;
CauThuHT:=1;
InBong(1,CauThuHT,Front);
end
else
begin
Inc(DiemSo[1]);
SetSoHuu(2,1);
InBong(2,1,BeHind);
end;
San.VeSanBong;
TextColor(Cyan);
GoToXy(65,7); Write(' Cau Thu : ',CauThuHT);
goToxy(65,9); Write(' May : ',DiemSo[2]);
goToxy(65,11);Write('Nguoi Choi : ',DiemSo[1]);
end
else
if vtMax then
begin
SetSoHuu(0,0);
ViTri.SetVitri(ChieuRong div 2 + KhoangCachCot,
chieuCao div 2 + KhoangCachDong);
Textcolor(White);
GotoXy(Vitri.X,Vitri.Y);write(#265);
San.VeSanBong;
DangSut := False;
DangChuyen := False;
vtMax := False;
end;
Textcolor(Red);
GotoXy((ChieuRong + KhoangCachCot - 20) div 2,(ChieuCao + KhoangCachDong) div 2);
if diemSo[1] >= 10 then
begin
Write('Nguoi Choi Thang Roi.');
readln;
Cauthu[1,CauThuHT].KeyPress := #27;
end
else if diemso[2] >= 10 then
begin
Write('May Thang Roi.');
readln;
Cauthu[1,CauThuHT].KeyPress := #27;
end;
end;
(*==============E Bong===============================*)

(*==============S San Bong===========================*)
Procedure TSanBong.KhoiTaoCauThu;
var Vt : TViTri;
i : integer;
Begin
CauThu[2,1].Doi := 2;
CauThu[1,1].Doi := 1;
CauThu[1,1].Ten := 1;
CauThu[2,1].Ten := 1;
for i := 2 to SoCauThu do
begin
CauThu[1,i].GioiHan.SetGioiHan(KhoangCachCot+2,KhoangCachDong+2,
KhoangCachCot+ChieuRong-1,KhoangCachDong+ChieuCao-1);
CauThu[1,i].MauAo := Green;
Cauthu[1,i].Doi := 1;
CauThu[1,i].Ten := i;
CauThu[2,i].GioiHan.SetGioiHan(KhoangCachCot+2,KhoangCachDong+2,
KhoangCachCot+ChieuRong-1,KhoangCachDong+ChieuCao-1);
CauThu[2,i].MauAo := Blue;
Cauthu[2,i].Doi := 2;
CauThu[2,i].Ten := i;
end;
for i := 1 to SoCauThu do
begin
repeat
Vt.X := RanDom(Cauthu[1,i].GioiHan.X2+1) + KhoangCachCot;
Vt.Y := Random(CauThu[1,i].GioiHan.Y2+1) + KhoangCachDong;
until (Vt.X >= Cauthu[1,i].GioiHan.X1)
and (Vt.X <= CauThu[1,i].GioiHan.X2)
and (Vt.Y >= CauThu[1,i].GioiHan.Y1)
and (Vt.Y <= Cauthu[1,i].GioiHan.Y2);
CauThu[1,i].Vitri := Vt;
Vt.SetViTri(0, 0);
end;

for i := 1 to SoCauThu do
begin
repeat
Vt.X := RanDom(Cauthu[2,i].GioiHan.X2+1) + KhoangCachCot;
Vt.Y := Random(Cauthu[2,i].GioiHan.Y2+1) + KhoangCachDong;
until (Vt.X >= Cauthu[2,i].GioiHan.X1)
and (Vt.X <= CauThu[2,i].GioiHan.X2)
and (Vt.Y >= CauThu[2,i].GioiHan.Y1)
and (Vt.Y <= Cauthu[2,i].GioiHan.Y2);
CauThu[2,i].Vitri := Vt;
Vt.SetViTri(0, 0);
end;
for i := 1 to SoCauThu do
begin
TextColor(cauthu[1,i].MauAo);
gotoxy(cauthu[1,i].vitri.X,cauthu[1,i].Vitri.Y);
Write(#258);
TextColor(cauthu[2,i].MauAo);
gotoxy(cauthu[2,i].vitri.X,cauthu[2,i].Vitri.Y);
Write(#258);
end;
End;

Procedure TSanBong.VeSanBong;
var i: integer;
Begin
clrscr;
TextColor(Yellow);
for i := 1 to ChieuRong do
begin
GotoXy(KhoangCachCot + i,KhoangCachDong);
Write(#177);
GotoXy(KhoangCachCot + i,KhoangCachDong+ChieuCao+1);
Write(#177);
end; { Ve Khung Ngang }

for i := 1 to ChieuCao do
begin
GotoXy(KhoangCachCot + 1,KhoangCachDong + i);
Write(#177);
GotoXy(KhoangCachCot + ChieuRong,KhoangCachDong+i);
Write(#177);
end; { Ve Khung Doc }

TextColor(LightGreen);
i := (ChieuRong - ChieuRongKhungThanh) div 2 + KhoangCachCot;
GotoXy(i,KhoangCachDong+1);
CauThu[1,1].GioiHan.SetGioiHan(i,KhoangCachDong+ChieuCao -
1 - ChieuRongKhungThanh div 2,
i+ChieuRongKhungThanh-1,KhoangCachDong+ChieuCao - 1);
{ Set Gioi Han Thu Mon}
CauThu[1,1].MauAo := LightGreen;
for i := 1 to ChieuRongKhungThanh do
Write(#177);
{ Ve Khung Thanh May}
TextColor(Cyan);
i := (ChieuRong - ChieuRongKhungThanh) div 2 + KhoangCachCot;
GotoXy(i,KhoangCachDong+ChieuCao);
CauThu[2,1].GioiHan.SetGioiHan(i,KhoangCachDong+2,
i+ChieuRongKhungthanh-1,ChieuRongKhungThanh div 2+KhoangCachDong+2);
{Set Gioi Han Thu Mon}
CauThu[2,1].MauAo := Cyan;
for i := 1 to ChieuRongKhungThanh do
Write(#177); { Ve Khung Thanh Nguoi Choi}
KhoiTaoCauThu;
TextColor(Cyan);
GoToXy(65,7); Write(' Cau Thu : ',CauThuHT);
goToxy(65,9); Write(' May : ',DiemSo[1]);
goToxy(65,11);Write('Nguoi Choi : ',DiemSo[2]);
Delay(1000);
End;
(*==============E San Bong===========================*)

(*==============S Cau Thu============================*)
Procedure TCauThu.SetCauThuHT;
var i,min,tamthoi1,tamthoi2,cautht: integer;
TroLai : boolean;
Begin
TroLai := True;
if (not Qbong.Sohuu[1,CauThuHT]) or (QBong.soHuu[0,0]) then
TroLai := False;
if not TroLai then
begin
Min := ChieuRong + ChieuCao;
cautht := CauThuHT;
for i := 1 to SoCauThu do
begin
tamthoi1 := Cauthu[doi,i].Vitri.X - QBong.Vitri.X;
tamthoi2 := Cauthu[doi,i].Vitri.Y - QBong.Vitri.Y;
if ABs(Min) > (ABs(TamThoi1)+Abs(Tamthoi2)) then
begin
Min := TamThoi1+Tamthoi2;
cautht := i;
end;
end;
if (cautht = 1) and ((QBong.Vitri.X < Cauthu[doi,cautht].GioiHan.X1)
or (QBong.Vitri.X > Cauthu[doi,cautht].GioiHan.X2) or
(QBong.Vitri.Y < Cauthu[doi,cautht].GioiHan.Y1) or
(QBong.Vitri.Y > Cauthu[doi,cautht].GioiHan.Y2)) then
cautht := 2;

if (CauThuHT = 1) and (doi = 2) then
CauThu[doi,CauThuHT].MauAo := Cyan
else if (CauThuHT <> 1) and (doi = 2) then
CauThu[doi,CauThuHT].MauAo := Blue
else if (CauThuHT = 1) and (doi = 1) then
CauThu[doi,CauThuHT].MauAo := LightGreen
else if (CauThuHT <> 1) and (doi = 1) then
CauThu[doi,CauThuHT].MauAo := Green;
CauThuHT := cautht;
TextColor(Cyan);
GoToXy(65,7);Write(' Cau Thu : ',CauThuHT);
end;
end;

Procedure TCauThu.InHinh(vtX, vtY : integer);
Begin
GotoXy(Vitri.X,Vitri.Y);
Write(#32);
Vitri.X := vtX;
Vitri.Y := vtY;
TextColor(MauAo);
GotoXy(Vitri.X,Vitri.Y);
Write(#258);
End;

Procedure TCauThu.GianhBong;
Begin
if not Qbong.SoHuu[Doi,Ten] then
begin
if (Qbong.Vitri.X = Vitri.X-1) and (Qbong.Vitri.Y = Vitri.Y) then
begin
SetCauthuHT;
Qbong.SetSoHuu(Doi,Ten);
Qbong.InBong(Doi,Ten,Front);
end
else if (Qbong.Vitri.X = Vitri.X+1) and (Qbong.Vitri.Y = Vitri.Y) then
begin
SetCauthuHT;
Qbong.SetSoHuu(Doi,Ten);
Qbong.InBong(Doi,Ten,Front);
end
else if (Qbong.Vitri.X = Vitri.X) and (Qbong.Vitri.Y = Vitri.Y-1) then
begin
SetCauthuHT;
Qbong.SetSoHuu(Doi,Ten);
Qbong.InBong(Doi,Ten,Front);
end
else if (Qbong.Vitri.X = Vitri.X) and (Qbong.Vitri.Y = Vitri.Y+1) then
begin
SetCauthuHT;
Qbong.SetSoHuu(Doi,Ten);
Qbong.InBong(Doi,Ten,Front);
end;
end;
end;

Procedure TCauThu.DiChuyenNgauNhien;
var Phim : integer;
Key : Char;
Begin
Phim := Random(7);
case Phim of
1 : begin
Key := #72;
end;
2 : begin
Key := #75;
end;
3 : begin
Key := #77;
end;
4 : begin
Key := #80;
end;
5 : begin
Key := #32;
end;
6 : begin
Key := #13;
end;
end;
KeyPress := Key;
End;

Procedure TCauThu.DiChuyen(Key : char);
Begin
case Key of
#72,#119:if (vitri.Y > GioiHan.Y1) then
begin
InHinh(Vitri.X,ViTri.Y - 1);
QBong.InBong(Doi,Ten, Front);
GianhBong;
delay(Tocdo);
end;
#80,#115:if (Vitri.Y < GioiHan.Y2) then
begin
InHinh(Vitri.X,Vitri.Y+1);
QBong.InBong(Doi,Ten, BeHind);
GianhBong;
delay(Tocdo);
end;
#75,#97: if (vitri.X > GioiHan.X1) then
begin
InHinh(Vitri.X-1,vitri.Y);
QBong.InBong(Doi,Ten, Left);
GianhBong;
delay(Tocdo);
end;
#77,#100:if (Vitri.X < GioiHan.X2) then
begin
InHinh(ViTri.X+1,ViTri.Y);
QBong.InBong(Doi,Ten, Right);
GianhBong;
delay(Tocdo);
end;
#13 : if QBong.SoHuu[doi,ten] then begin
QBong.SetSoHuu(0, 0);
DangSut := True;
end;
#32 : if QBong.SoHuu[doi,ten] then begin
QBong.SetSoHuu(0, 0);
DangChuyen := True;
HuongChuyen := QBong.HuongChuyenBong(doi,ten);
end;
end;
End;
(*==============E Cau Thu============================*)
(*==============S May Tinh===========================*)
Procedure TMayTinh.KiemTra;
var ct,Min,Tamthoi,caut : integer;
Begin
Min := ChieuCao + ChieuRong;
for ct := 1 to SoCauThu do
begin
TamThoi := Abs(CauThu[2,ct].Vitri.X - QBong.Vitri.X)
+ Abs(CauThu[2,ct].Vitri.Y - QBong.Vitri.Y);
if (Min) > TamThoi then
begin
Min := TamThoi;
caut := ct;
end;
end;
CauThuHT[1] := caut;

Min := ChieuCao + ChieuRong;
for ct := 1 to SoCauThu do
if (ct <> CauthuHT[1]) then
begin
TamThoi := Abs(CauThu[2,ct].Vitri.X - QBong.Vitri.X)
+ Abs(CauThu[2,ct].Vitri.Y - QBong.Vitri.Y);
if (Min > TamThoi) then
begin
Min := TamThoi;
caut := ct;
end;
end;
CauThuHT[2] := caut;
end;

Procedure TMayTinh.TanCong;
var i,ct,j : integer;
begin
ct := 0;
KiemTra;
for i := 1 to 2 do
if QBong.Sohuu[2,CauThuHT[i]] then
ct := i;
i := ct;
PT := True;
if i <> 0 then
begin
PT := False;
if (CauThu[2,CauThuHT[i]].Vitri.Y < CauThu[1,1].GioiHan.Y2) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#80);
end
else
if (CauThu[2,CauThuHT[i]].Vitri.X < (CauThu[1,1].GioiHan.X2
+ CauThu[1,1].GioiHan.X1) div 2) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#77);
end
else
if (CauThu[2,CauThuHT[i]].Vitri.X > (CauThu[1,1].GioiHan.X2
+ CauThu[1,1].GioiHan.X1) div 2) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#75);
end;
for j := 1 to SoCauthu do
if j <> i then
Begin
CauThu[2,j].DiChuyenNgauNhien;
CauThu[2,j].Dichuyen(Cauthu[2,j].KeyPress)
end;
end;
end;

Procedure TMayTinh.PhongThu;
var i,j: integer;
Begin
KiemTra;
PT := False;
for i := 1 to 2 do
if (not QBong.Sohuu[2,CauThuHT[i]]) and (not QBong.SoHuu[1,1]) then
begin
if (CauThu[2,CauThuHT[i]].Vitri.Y < QBong.Vitri.Y) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#80);
end
else
if (CauThu[2,CauThuHT[i]].Vitri.Y > QBong.Vitri.Y) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#72);
end
else
if (CauThu[2,CauThuHT[i]].Vitri.X < QBong.Vitri.X-1) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#77);
end
else
if (CauThu[2,CauThuHT[i]].Vitri.X > QBong.Vitri.X+1) then
begin
CauThu[2,CauThuHT[i]].DiChuyen(#75);
end;
PT := True;
for j := 1 to SoCauthu do
if j <> i then
Begin
CauThu[2,j].DiChuyenNgauNhien;
CauThu[2,j].Dichuyen(Cauthu[2,j].KeyPress)
end;
end;
end;

(*==============E May Tinh===========================*)

Procedure NewGame;
Begin
clrscr;
SetCusor(32,0);
San.VeSanBong;
QBong.SetSoHuu(0, 0);
TextColor(White);
Qbong.vitri.SetVitri(ChieuRong div 2 + KhoangCachCot,
chieuCao div 2 + KhoangCachDong);
GotoXy(QBong.Vitri.X,QBong.Vitri.Y);
Write(#265);
CauthuHT := 2;
DangSut := False;
DangChuyen := False;
end;

Procedure PlayerPlay;
var i : integer;
Begin
Cauthu[1,CauThuHT].MauAo := Red;
if Keypressed then
begin
Cauthu[1,CauThuHT].KeyPress := readkey;
for i := 1 To SoCauThu do
if i <> CauThuHT then
Cauthu[1,i].DichuyenNgauNhien;
end;
Cauthu[1,CauThuHT].DiChuyen(Cauthu[1,CauThuHT].KeyPress);
for i := 1 To SoCauThu do
if i <> CauThuHT then
Cauthu[1,i].Dichuyen(Cauthu[1,i].KeyPress);
if Dangsut then QBong.SutBong(LastHuong)
else if DangChuyen then QBong.SutBong(HuongChuyen);
MayTinh.PhongThu;
MayTinh.TanCong;
QBong.XuLi;
Cauthu[1,1].SetCauThuHT;
end;

BEGIN
NewGame;
repeat
PlayerPlay;
if MayTinh.PT then
until Cauthu[1,CauThuHT].KeyPress = #27;
END.

*Bậc cmn thầy*

Enter:Sút

space: chuyền

a,s,d,w: di chuyển

* dán vô notepad rồi sau đó đổi đuôi thành .pas nhá. bỏ vào đường link nè:

link: C:\FPC\2.0.4\bin\i386-win32

Lập trình hoàn toàn bằng pascal nhá.

Bậc cmn thầy

1
24 tháng 9 2017

Thế giới này thật là đáng sợ, tui cũng muốn làm lập trình viên nhưng mà .... ếu biết cái gì cả

ĐÁP ÁN VÒNG 2 CUỘC THI TIN HỌC: * ĐỀ 1: Câu 1: CÂU 1: const fi='uc.inp'; fo='uc.out'; var f: text; a,b,c : integer; function uc(x,y): integer; var z: integer; begin while y<>0 do begin z:=x mod y; x:=y; y:=z; end; uc:=x; end; procedure ip; begin assign(f,fi); reset(f); read(f,a,b,c); close(f); end; procedure out; begin assign(f,fo); rewrite(f); write(f,uc(uc(a,b),c); close(f); end; begin ip; out; end. Câu 2: const fi='SN.inp'; fo='SN.out'; var f:text; i,n:integer; s:real; procedure...
Đọc tiếp

ĐÁP ÁN VÒNG 2 CUỘC THI TIN HỌC:

* ĐỀ 1:

Câu 1:

CÂU 1:
const fi='uc.inp';
fo='uc.out';
var f: text;
a,b,c : integer;
function uc(x,y): integer;
var z: integer;
begin
while y<>0 do
begin
z:=x mod y;
x:=y;
y:=z;
end;
uc:=x;
end;
procedure ip;
begin
assign(f,fi);
reset(f);
read(f,a,b,c);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
write(f,uc(uc(a,b),c);
close(f);
end;
begin
ip;
out;
end.

Câu 2:

const fi='SN.inp';
fo='SN.out';
var
f:text;
i,n:integer;
s:real;
procedure ip;
begin
assign(f,fi);
reset(f);
read(f,n);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
s:=0;
for i:= 1 to n do
begin
if i mod 2 <> 0 then
s:=s+(i/(i+1));
if i mod 2 = 0 then
s:=s-(i/(i+1));
end;
write(f,s:0:2);
close(f);
end;
BEGIN
ip;
out;
END.

Câu 3:

const fi='SSNT.inp';
fo='SSNT.out';
var
f:text;
n,i,max,j:integer;
s:string;
a:array[1..32000] of integer;
function nt(x:integer):boolean;
var
i:integer;
begin
nt:=false;
if x < 2 then exit;
for i:= 2 to trunc(sqrt(x)) do
if x mod i = 0 then exit;
nt:=true;
end;
function snt(x:integer):boolean;
begin
snt:=false;
if x= 0 then exit;
while nt(x) = true do
x := x div 10;
if x = 0 then snt:=true;
end;
procedure ip;
begin
assign(f,fi);
reset(f);
max:=a[1];
readln(f,n);
for i:= 1 to n do
begin
read(f,a[i]);
if( a[i] < max ) and (nt(a[i]) = true) then
max:=a[i];
end;
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
writeln(f,max);
max:=0;
for i:= 1 to n do
begin
if snt(a[i]) = true then
begin
str(a[i],s);
if length(s) = 2 then
max:=max+a[i];
s:='';
end
else
a[i]:=-32000;
end;
writeln(f,max);
for i:= 1 to n-1 do
for j :=i+1 to n do
if a[i] > a[j] then
begin
max:=a[i];
a[i]:=a[j];
a[j]:=max;
end;
for i:= 1 to n do
if (a[i] > 0) and (a[i] <> a[i-1]) then write(f,a[i],' ');
close(f);
end;
BEGIN
ip;
out;
END.

CÂU 4:

const fi='TUOI.INP';
fo='TUOI.OUT';
var f: text;
a,b: byte;
procedure ip;
begin
assign(f,fi);
reset(f);
read(f,a,b);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
if (x=y*2) and (x>18) and (x-y>=18) then write(f,'CO') else write(f,x-y*2);
close(f);
end;
begin
ip;
out;
end.

const fi='CM.INP';

fo='CM.OUT';

var f: text;

a,n,b,k: integer;

a1: array[1..32000] of integer;

function nt(x: integer): boolean;

var i: integer;

begin

nt:=false;

if x<2 then exit;

for i:=2 to trunc(sqrt(x)) do if x mod i=0 then exit;

nt:=true;

end;

procedure ip;

begin

assign(f,fi);

reset(f);

read(f,n);

close(f);

end;

procedure out;

begin

assign(f,fo);

rewrite(f);

d:=0;

for a:=1 to k do

if nt(a) then

begin

inc(d);

a1[d]:=a;

end;

for a:=1 to d do

for b:=x to d do

if a1[a]+a1[b]=k then writeln(f,a1[a],'+',a1[b]);

end;

close(f);

end;

begin

ip;

out;

end.

*ĐỀ 2 :

BÀI LÀM CỦA BẠN LÊ HOÀNG THẮNG:

//----------------------------CAU 1--------------------------------

var s,d,n,i,u:longint;
a:array[0..32001] of longint;
f:text;
function ucln(x,y:longint):longint;
begin
if y=0 then exit(x) else exit(ucln(y,x mod y));
end;
begin
assign(f,'ucln.inp');reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]); close(f);
u:=a[1];
for i:=2 to n do u:=ucln(u,a[i]);
assign(f,'ucln.out');rewrite(f);
write(f,'UCLN: ',u,'; UC: ');
for i:=1 to u do if u mod i=0 then
begin
if i<>u then write(f,i,',') else write(f,i);
if i<10 then inc(d) else inc(s,i);
end;
writeln(f);
writeln(f,d); write(f,s);
close(f);
end.

//----------------------------CAU 2--------------------------------

var n,i:longint;
s:real;
f:text;
begin
assign(f,'sn.inp');reset(f);
readln(f,n); close(f);
for i:=1 to n do if odd(i) then s:=s-i/(i+1) else s:=s+i/(i+1);
assign(f,'sn.out');rewrite(f);
write(f,s:0:2);
close(f);
end.

//----------------------------CAU 3--------------------------------

var a:array[0..1000000] of boolean;
b:array[0..1000000] of longint;
i,j,k,n,d:longint;
f:text;
procedure taosang(n:longint);
var i,j:longint;
begin
for i:=2 to trunc(sqrt(n)) do if not(a[i]) then
begin
j:=i*i;
while j<=n do begin a[j]:=true; inc(j,i); end;
end;
end;
begin
assign(f,'boso.inp');reset(f);
readln(f,n); taosang(n); close(f);
assign(f,'boso.out');rewrite(f);
for i:=2 to n do if not(a[i]) then
begin
inc(d);
b[d]:=i;
end;
for i:=1 to d do
for j:=i to d do
if (n-b[i]-b[j]>=b[j]) and not(a[n-b[i]-b[j]]) then
writeln(f,b[i],' ',b[j],' ',n-b[i]-b[j]);
close(f);
end.

//----------------------------CAU 4--------------------------------

THAM KHẢO ĐỀ 1.

//----------------------------CAU 5--------------------------------

var n,i,s,t:longint;
f:text;
begin
assign(f,'u.inp');reset(f);
readln(f,n); t:=n; close(f);
assign(f,'u.out');rewrite(f);
for i:=2 to trunc(sqrt(n)) do
begin
if n mod i=0 then
begin
write(f,i,' ');
repeat n:=n div i until n mod i>0;
end;
if t mod (i*i)=0 then inc(s,i*i);
end;
writeln(f);
write(f,s+1);
close(f);
end.

*ĐỀ CHUNG:

BÀI LÀM CỦA BẠN ĐÀO XUÂN SƠN :

Câu 1:

const fi='TCS.inp';
fo='TCS.out';
var
f:text;
x:char;
tg:byte;
s:integer;
CODE:integer;
procedure ip;
begin
assign(f,fi);
reset(f);
s:=0;
while not(eof(f)) do
begin
read(f,x);
if x in ['0'..'9'] then
begin
val(x,tg,CODE);
s:=s+tg;
end;
end;
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
write(f,s);
close(f);
end;
BEGIN
ip;
out;
END.

Câu 2:

const fi='t.inp';
fo='t.out';
var
f:text;
s:string;
i:byte;
procedure ip;
begin
assign(f,fi);
reset(f);
read(f,s);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
s[1]:=upcase(s[1]);
for i:= 2 to length(s) do
if s[i-1] <> #32 then
s[i]:=lowercase(s[i]) else
s[i]:=upcase(s[i]);
write(f,s);
close(f);
end;
BEGIN
ip;
out;
END.

1
8 tháng 1 2020

Em dốt tin lắm cô ơi, cô tạo khóa học nào đi, cô còn kèm em học yeu

7 tháng 5 2021

Phương án nào dưới đây là khai báo mảng hợp lệ ?

A. mang : array[0..10] of integer;                          B. mang : array[0..10] : integer;

C. mang : integer of array[0..10];                           D. mang : array(0..10) : integer;

 

Đề bài yêu cầu gì vậy bạn?

5 tháng 5 2021

Đề yêu cầu sắp xếp lại .a) if mod a=0 then.b) while i<50 do

 

 

 

ĐÁP ÁN VÒNG 1 CUỘC THI TIN HỌC Câu 1: const fi='tong.inp'; fo='tong.out'; var f:text;i,n:integer;t:real; procedure ip; begin assign(f,fi); reset(f); readln(f,n); t:=abs(sqrt(4)*1/2); for i:= 1 to n do t:=t+(i/(i+1)); close(f); end; procedure out; begin assign(f,fo); rewrite(f); write(f,t:0:3); close(f); end; BEGIN ip; out; END. Câu 2: Bài làm của bạn Lê Hoàng Thắng : var a:array[1..10000000] of longint; min,vtmin,vtmax,n,i,k,demk,max,sum:longint;...
Đọc tiếp

ĐÁP ÁN VÒNG 1 CUỘC THI TIN HỌC

Câu 1:

const fi='tong.inp';

fo='tong.out';

var

f:text;i,n:integer;t:real;

procedure ip;

begin

assign(f,fi);

reset(f);

readln(f,n);

t:=abs(sqrt(4)*1/2);

for i:= 1 to n do

t:=t+(i/(i+1));

close(f);

end;

procedure out;

begin

assign(f,fo);

rewrite(f);

write(f,t:0:3);

close(f);

end;

BEGIN

ip;

out;

END.

Câu 2: Bài làm của bạn Lê Hoàng Thắng :

var a:array[1..10000000] of longint; min,vtmin,vtmax,n,i,k,demk,max,sum:longint; sm:boolean;
function nguyento(x:longint):boolean;
var demuoc,t:longint;
begin
demuoc:=0;
for t:=1 to x do if (x mod t = 0) then inc(demuoc);
if demuoc=2 then nguyento:=true else nguyento:=false;
end;
function hoanhao(y:longint):boolean;
var tong,g:longint;
begin
tong:=0;
for g:=1 to y-1 do if (y mod g=0) then tong:=tong+g;
if tong=y then hoanhao:=true else hoanhao:=false;
end;
begin
assign(input,'mang.inp'); reset(input);
assign(output,'mang.out'); rewrite(output);
readln(n); readln(k); demk:=0;
for i:=1 to n do read(a[i]);
min:=a[n];
for i:=n downto 1 do if a[i]<min then begin min:=a[i]; vtmin:=i; end;
max:=abs(a[1]);
for i:=1 to n do if abs(a[i])>max then begin max:=abs(a[i]); vtmax:=i; if a[i]<0 then sm:=true else sm:=false; end;
for i:=1 to n do if (k=a[i]) then inc(demk);
sum:=0;
for i:=1 to n do
begin
if (nguyento(a[i]) or hoanhao(a[i])) then sum:=sum+a[i];
end;
writeln(vtmin);
if sm=false then writeln(max,' ,vi tri: ',vtmax) else writeln('-',max,' ,vi tri: ',vtmax);
if (demk=0) then writeln('khong, so lan xuat hien :0') else writeln('co, so lan xuat hien :',demk);
write(sum);
close(input); close(output);
end.

Câu 3: Bài làm của bạn Lê Hoàng Thắng:

const fi='xau.inp';

fo='xau.out';

var s1,s2:string; match,i:longint; f: text;

procedure ip;

begin
assign(f,fi); reset(f);
readln(s1); read(s2);

close(f);

end;

procedure out;

begin

assign(f,fo); rewrite(f);
match:=0;
if s1=s2 then begin write('KHONG'); exit; end;
for i:=1 to length(s1) do
begin
if s1[i]=s2[i] then inc(match);
end;
if match=length(s1)-2 then write('CO') else write('KHONG');
close(f);

end;

Begin

ip;

out;
end.

Câu 4: Bài làm của bạn Đào Xuân Sơn :

const fi='STN.inp';
fo='STN.out';
var
f:text;
s:string;
n,t,i:integer;
function dx(x:string):boolean;
var
i:byte;
begin
dx:=false;
for i:= 1 to length(x) div 2 do
if x[i] <> x[length(x)-i+1] then
exit;
dx:=true;
end;
procedure ip;
begin
assign(f,fi);
reset(f);
read(f,n);
close(f);
end;
procedure out;
begin
assign(f,fo);
rewrite(f);
str(n,s);
if dx(s) = true then writeln(f,'CO') else writeln(f,'KHONG');
t:=0;
for i:= 1 to n div 2 do
if n mod i = 0 then t:=t+i;
if t=n then
begin
write(f,'CO,');
t:=0;
while n<>0 do
begin
t:=t+(n mod 10);
n:=n div 10;
end;
writeln(f,' ',t);
end else
writeln(f,'KHONG');
write(f,length(s));
close(f);
end;
BEGIN
ip;
out;
END.

Bài 5: Bài làm của bạn Vinh Lê:

const fi=’tich.inp’;

fo=’tich.out’;

var f: text;

a,b: integer;

procedure ip;

begin

assign(f,fi);

reset(f);

readln(f,a);

read(b);

close(f);

procedure out;

begin

assign(f,fo);

rewite(f);

t:=a;

t:=t*b;

write(f,t);

close(f);

end;

Begin

ip;

out;

end.

Đây là các bộ code sử dụng thuật toán hoàn chỉnh nhất và tối ưu.

1
25 tháng 7 2019

thiệt ko vậy

Cách khai báo thứ 1 đúng