delphi4arab منتديات دلفي للعرب

كيف تحول لوحة المفاتيح الى الات موسيقية
كود :
'Rabih pascal './/
var
  Form1: TForm1;
   var
  mo: dword;  // Çæ hmidiout
  i:Shortint;

implementation
    uses mmsystem,math;

    //ÏÇáÉ äÍÊÇÌåÇ ááÊÚÇãá ãÚ ÑÓÇÆá ÇáãíÏí
  function getmidi(was,was2,was3: integer):dword;
   begin
    result:=
     was
     + (was2*$100)     
     +(was3*$10000) ;         
     end;

procedure changesound(i:Shortint);
            begin
             midiOutShortMsg(mo, getmidi($C0,i,127));//FOR ' I ' is the number of sound required help 'Standard MIDI Patch Assignments'
               end;                                   //127  ááÊÍßã ÈÇáÕæÊ
     procedure play(sound: byte);
         begin
            midiOutShortMsg(mo,getmidi($90,sound,127));//$90  mean play
                end;
    procedure stop(sound: byte);
      begin
        midiOutShortMsg(mo,getmidi($80,sound,127)); // $80 mean stop

             end;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Interval:=200;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
timer1.Enabled:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 midiOutClose(mo);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
midiOutOpen(@mo,0,0, 0,0);
     changesound(12);//Marimba sound.   Find All sounds in help 'Standard MIDI Patch Assignments'
          updown1.Associate:=form1;

end;

                     //åÐå ãÌÑÏ ÝßÑÉ áÇÓÊÚãÇá áæÍÉÇáãÝÇÊíÍ
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

if key=$51 then
shape1.Brush.Color:=clred
else
shape1.Brush.Color:=clwhite;
if shape1.Brush.Color=clred then
  begin
 play(48);
end;


if key=$57 then
  shape3.Brush.Color:=clred
  else
  shape3.Brush.Color:=clwhite;
  if shape3.brush.color=clred then
   begin
play(50);end;


  if key=$45 then
  shape5.Brush.Color:=clred
  else
  shape5.Brush.Color:=clwhite;
  if shape5.Brush.Color=clred then
   begin
 play(52);end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);

var
r:byte;
begin     //uses Math
r:=randomrange(48,60);   
play(r);
if r=48 then                  //'DO' 
 shape1.brush.color:=clred
 else
 shape1.brush.color:=clwhite;

if r=49 then                  //'DO #'   // ÇáäæÊÉ ÇáÓæÏÇÁ ÇáÊí ÊÃÊí ÎáÝ äæÊÉ Çá Ïæ      '#' ÊÑÝÚ ÇáÕæÊ Çáì ÇáäæÊÉ ÇáÊí ÊáíåÇ Çáì Çáíãíä  
 shape2.brush.color:=clred   
   else
   shape2.brush.color:=clblack;
if r=50 then                    //'RE '
  shape3.brush.color:=clred
  else
   shape3.brush.color:=clwhite;


  if r=51 then                   //'RE #'
 shape4.brush.color:=clred
    else
   shape4.brush.color:=clblack;

 if r=52then                     //'MI'
 shape5.brush.color:=clred
   else
   shape5.brush.color:=clwhite;
 if r=53 then                    //'FA'
 shape6.brush.color:=clred
    else
   shape6.brush.color:=clwhite;
 if r=54 then                     //'FA #'  
 shape7.brush.color:=clred
     else
   shape7.brush.color:=clblack;
if r=55 then                       //'SOL'
 shape8.brush.color:=clred
     else
   shape8.brush.color:=clwhite;

 if r=56 then                     //'SOL #'
 shape9.brush.color:=clred
   else
   shape9.brush.color:=clblack;
 if r=57then                        //'LA '
 shape10.brush.color:=clred
    else
   shape10.brush.color:=clwhite;
 if r=58 then                       // 'LA #'
 shape11.brush.color:=clred
   else
   shape11.brush.color:=clblack;
 if r=59 then                        // 'SI'
 shape12.brush.color:=clred
   else
   shape12.brush.color:=clwhite;
end;

procedure TForm1.UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
begin
form1.Caption:=inttostr(updown1.Position);
changesound(strtoint(form1.Caption));
if caption='1' then
 caption:='1' + '__bright piano'+'  by rabih Pascal'; // help 'Standard MIDI Patch Assignments''Help' ãÞÇÑäÉ ÇáÇÕæÇÊ ãÚ ÇáÏáÝí
end;
rabihpascal
