Tin học sử dụng sound để lập trình Piano Pascal

 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.