- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- 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.
Chú ý bỏ cái ngoặc chỗ Rewrite ra nha, nếu không Code sẽ lỗi, sau lần đầu tiên dùng "nên" đóng cái đó lại
Hình ảnh Demo
Mã:
Program Piano;
uses crt,graph;
const
SoPhim = 14;
Phim: array[1..SoPhim] of char = ('a','s','d','f','g','h','j',
'1','2','3','4','5','6','7');
TenNot: array[1..SoPhim] of string[3] = ('Do','Re','Mi','Fa',
'Sol','La','Si','Do"','Re"','Mi"','Fa"','Sol"','La"','Si"');
AmThanh: array[1..SoPhim] of integer = (131,147,165,175,196,220,
247,262,294,330,349,392,440,494);
CRong = 30;
Cdai = 100;
KCNgang = 80;
KCDoc = 150;
_MauPhim = LightGreen;
var
gd,gm: integer;
MauPhim: array[1..SoPhim] of integer;
k: char;
TgPhat: integer;
f: text;
GA,Playing: Boolean;
Procedure InPhimDan(i: integer);
Begin
if MauPhim[i] = _MauPhim then
SetFillStyle(1,_MauPhim)
else
SetFillStyle(1,White);
bar(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai);
SetFillStyle(1,8);
bar(KCNgang+i*CRong,KCdoc + CDai,KCNgang+(i+1)*CRong,
KCDoc + CDai + 5);
SetFillStyle(1,LightGray);
bar(KCNgang+i*CRong,KCdoc + CDai+5,KCNgang+(i+1)*CRong,
KCDoc + CDai + 10);
SetColor(Black);
Rectangle(KCNgang+i*CRong,KCDoc,KCNgang+(i+1)*CRong,KCDoc + CDai+10);
SetColor(Blue);
OutTextXY(KCNgang+i*30+15,KCDoc+70,Phim[i]);
OutTextXY(KCNgang+i*30+5,KCDoc+20,TenNot[i]);
End;
Procedure TaoDan;
var i: integer;
Begin
SetFillStyle(1,Cyan);
Bar(KCNgang + CRong - 10,KCDoc - 10,KCNgang + CRong*(SoPhim+1)+10,KCDoc+CDai+20);
for i := 1 to SoPhim do
InPhimDan(i);
Setcolor(Brown);
SetTextStyle(DefaultFont, HorizDir,3);
OutTextXy(200,100,'P I A N O');
SetTextStyle(DefaultFont, HorizDir,1);
OutTextXy(200,320,'Turn off VietKey before hitting.');
End;
Procedure ShowDan;
var trdo: string;
Begin
SetfillStyle(1,LightGreen);
Bar(KCNgang+CRong,KCDoc+Cdai+20,KCNgang + (SoPhim+1)*Crong,KCDoc+CDai+60);
{--Record--}
SetFillStyle(1,Red);
Bar(KCNgang+CRong+20,KCdoc + CDai+25,KCNgang+CRong+80,KCDoc+CDai+55);
Setcolor(Black);
if not GA then
OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Record')
else
OutTextXy(KCNgang+CRong+25,KCdoc + CDai+30,'Rec...');
OutTextXy(KCNgang+CRong+30,KCdoc + CDai+45,'( R )');
{--Truong Do--}
SetFillStyle(1,Blue);
Bar(KCNgang+CRong*(SoPhim+1)-80,KCdoc + CDai+25,
KCNgang+CRong*(SoPhim+1)-10,KCDoc+CDai+55);
Setcolor(Black);
OutTextXy(KCNgang+CRong*(SoPhim+1)-70,KCdoc + CDai+35,'T: ');
Str(TgPhat,trDo);
OutTextXy(KCNgang+CRong*(SoPhim+1)-50,KCdoc + CDai+35,trdo);
{--Play--}
SetFillStyle(1,Yellow);
Bar(KCNgang+CRong+170,KCdoc + CDai+25,KCNgang+CRong+230,KCDoc+CDai+55);
Setcolor(Black);
if not Playing then
OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Play')
else
OutTextXy(KCNgang+CRong+185,KCdoc + CDai+30,'Stop');
OutTextXy(KCNgang+CRong+180,KCdoc + CDai+45,'( P )');
End;
Procedure GhiAm(kt:string;Am: integer);
var s: array[1..3000] of string[4];
i,j: integer;
Begin
reset(f);
i := 0;
repeat
inc(i);
Readln(f,s[i]);
until s[i] = '';
rewrite(f);
for j := 1 to i-1 do
writeln(f,s[j]);
if kt = '' then
Writeln(f,Am)
else
Writeln(f,kt,Am);
Close(f);
End;
Procedure Play;
var s: string;
i,c,j:integer;
Begin
reset(f);
repeat
readln(f,s);
Val(s,i,c);
if c = 0 then
begin
Sound(AmThanh[i]);
for j := 1 to SoPhim do
if i = j then
begin
MauPhim[j] := _MauPhim;
InPhimDan(j);
end
else
if MauPhim[j] = _MauPhim then
begin
MauPhim[j] := White;
InPhimDan(j);
end;
end
else
begin
Val(Copy(s,2,Length(s)),i,c);
Delay(i);
NoSound;
end;
k := #0;
if keypressed then k := readkey;
until (s = '') or (k = 'p');
Playing := False;
ShowDan;
End;
Procedure TruongDo;
Begin
if (k = #72) or (k = #80) then
begin
if (k = #72) and (TgPhat < 400) then inc(TgPhat,50)
else
if (k = #80) and (TgPhat > 50) then inc(TgPhat,-50);
ShowDan;
end;
End;
Procedure BatGhiAm;
Begin
if k = 'r' then
begin
if not GA then
ReWrite(f);
GA := not GA;
ShowDan;
end
else
if k = 'p' then begin Playing := True;ShowDan;Play;end;
End;
Procedure DanhDan;
var i: integer;
Begin
k := #0;
if keypressed then begin k := readkey;TruongDo;BatGhiAm;end;
for i := 1 to SoPhim do
begin
if k = Phim[i] then
begin
MauPhim[i] := _MauPhim;
Sound(AmThanh[i]);
InPhimDan(i);
if GA then
begin
GhiAm('',i);
GhiAm('d',tgPhat);
end;
end
else
if MauPhim[i] = _MauPhim then
begin
MauPhim[i] := White;
InPhimDan(i);
end;
end;
if k <> #0 then delay(tgPhat);
NoSound;
End;
BEGIN
gd := EGA;
gm := EGAHI;
InitGraph(gd,gm,'');
SetBkColor(Black);
Assign(f,'GhiAm.txt');
{ReWrite(f);} { Bo dau ngoac trong lan chay dau tien, sau do dong lai}
TaoDan;
TgPhat := 200;
GA := False;
Playing := False;
ShowDan;
repeat
DanhDan;
if GA then ghiAm('d',23);
until k = #27;
CloseGraph;
END.
