Beep for Firemonkey

[david berneda 19]

Needed a "Beep" equivalent function for Android, capable of playing a sound at a specific hertz frequency, and ended up porting and adapting a Java snippet.

 

Its freely available, hope it might help:

 

https://github.com/davidberneda/FMX_Tone_Beep

 

regards !

david

 

[programmerdelphi2k 235]

hi @david berneda

 

my contribution for your project, if it's possible!

• Keyboard colored to find your Musical Notes ( no "IF" anymore )
• Play with mouse click
• Play with mouse moviment... (Ctrl + Mouse moving)
• Play your song notes  (type your notes and play it)

FMX_Piano_Keyboard_with_code_by_David_Berneda.zip

Edited December 30, 2022 by programmerdelphi2k

[programmerdelphi2k 235]

a little fix:

procedure TViewMainForm.MyPianoKeyboardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if LUseMouseMoveEvent and (ssCtrl in Shift) then
    MyPlayIt(X, Y);
end;

function TViewMainForm.MyPlayIt(const X, Y: Single): Single;
var
  Xint       : integer;
  Yint       : integer;
  LBitmap    : TBitmap;
  LBitmapData: TBitmapData;
  LPixelColor: TAlphaColor;
  LPlayMyTone: Single;
begin
  result := -1;
  Xint   := Trunc(X);
  Yint   := Trunc(Y);
  //
  LBitmap := MyPianoKeyboard.Fill.Bitmap.Bitmap;
  //
  if (LBitmap <> nil) then
    begin
      if LBitmap.Map(TMapAccess.Read, LBitmapData) then
        try
          begin
            LPixelColor := LBitmapData.GetPixel(Xint, Yint);
            //
            LPlayMyTone := MyFindColorTone(LPixelColor);
            //
            if LUseMouseMoveEvent and (LPlayMyTone = LLastTonePlayed) then
              exit;
            //
            if (LPlayMyTone > 0) then
              begin
                LLastTonePlayed := LPlayMyTone;  // <----
                result          := LPlayMyTone;
                TTone.Play(LPlayMyTone, LPlayDuration);
              end;
          end;
        finally
          LBitmap.Unmap(LBitmapData);
        end;
    end;
end;

 

[programmerdelphi2k 235]

NOTE: the bitmap from Keyboard can be replaced with any other of your choice!

Quote

  MyPianoKeyboard.Fill.Kind := TBrushKind.Bitmap;
  MyPianoKeyboard.Fill.Bitmap.Bitmap.LoadFromFile('..\..\MyPianoKeyboard.bmp');

 

Edited January 2, 2023 by programmerdelphi2k

[programmerdelphi2k 235]

to avoid many "MAP...UnMAP" pixels...

var
  LUseMouseMoveEvent: boolean = true;
  LBitmap           : TBitmap;
  LBitmapData       : TBitmapData;
...

procedure TViewMainForm.MyPianoKeyboardMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  LUseMouseMoveEvent := true; // it's ready to play...
  //
  LBitmap := MyPianoKeyboard.Fill.Bitmap.Bitmap;
  //
  if (LBitmap <> nil) then
    begin
      if LBitmap.Map(TMapAccess.Read, LBitmapData) then
        try
          MyPlayIt(X, Y);
        finally
          LBitmap.Unmap(LBitmapData);
        end;
    end;
end;

procedure TViewMainForm.MyPianoKeyboardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if LUseMouseMoveEvent and (ssCtrl in Shift) then
    MyPlayIt(X, Y);
end;

procedure TViewMainForm.MyPianoKeyboardMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  LUseMouseMoveEvent := false; // dont play anymore
  LBitmap            := nil;
end;

function TViewMainForm.MyPlayIt(const X, Y: Single): Single;
var
  Xint       : integer;
  Yint       : integer;
  LPixelColor: TAlphaColor;
  LPlayMyTone: Single;
begin
  result := -1;
  Xint   := Trunc(X);
  Yint   := Trunc(Y);
  //
  if (LBitmapData.Data <> nil) then // if mouse-key-down'ED...
    begin
      LPixelColor := LBitmapData.GetPixel(Xint, Yint);
      //
      LPlayMyTone := MyFindColorTone(LPixelColor);
      //
      if LUseMouseMoveEvent and (LPlayMyTone = LLastTonePlayed) then
        exit;
      //
      if (LPlayMyTone > 0) then
        begin
          LLastTonePlayed := LPlayMyTone;
          result          := LPlayMyTone;
          TTone.Play(LPlayMyTone, LPlayDuration);
        end;
    end;
end;

 

Edited January 2, 2023 by programmerdelphi2k