ピアノ鍵盤表示

 JavaScript版

• ソースは[https:./inc/uPianoKey.js]<-右クリック保存で
• デモサンプル[https:./inc/uPianoKey.html]
• [JavaScript Audio.playで音を出す]に音が出るサンプルがあります-->[https:./inc/makeSnd3.html]

下記pascal版からJavaScriptにPas2JavaSc.pasで変換して必要部分を組み込んで作ったものです

ご自由にお使い下さい。貼り付け改変ご自由に。制限は日本語以外に翻訳禁止だけです。

 pascal版

計算で効果音を作るアプリ作成の為に　鍵盤の表示が必要だと考えました。昔作ったのを思い出し、Lazarusで動くように調整し、動く事を確認しました。

• コンポーネントをインストールする方法はこちらの記事→lazarus:Lazarusで自作コンポーネントを作る

使用方法

IDEにインストールしてあれば設計画面で

• KeySizeで鍵盤の数
• SetingKeyNoでアクティブな鍵盤(範囲外(例-1)なら非表示)
• Mouseを押した時等にOnChangeが呼ばれます。
• 複数の鍵盤オン状態などをしたい場合は OnPianoPaint を使って下さい
• 利用、改変ははご自由に。連絡も不要です。

uPianoKey.pas(9)ソース

unit uPianoKey;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
{ ピアノの鍵盤のような表示をするコンポーネントです。
     ソース形式です。 DELPHI 4  C++ビルダで動作確認しています。
     PIANOKEY.DCRは各自作成して下さい。

 簡単な説明

 鍵盤の色、枠、は
           ColorBlackKey     ColorWhiteKey     ColorBorderで指定します


 鍵盤の番号は  KeyLeftNo?  KeySizeの間になります。

  鍵盤の数は指定出来ます。KeySizeが12なら１オクターブ分を表示
  域全体に収まるよう表示します。

 SetingKeyNo により指定した位置の鍵盤の色は
              ColorSelBlack ColorSelWhite で指定した色です
            このプロパテイでは１個の鍵盤しか指定出来ません。複数の鍵盤
            を指定したい場合は   OnPianoPaint を使います。
            ソースを追いかえればわかると思いますが
            単にSender.CanvasのBrushを設定してuf:=Falseとします。

  座標位置の鍵盤の番号を知るには XY2scale(x, y: integer): integer;を呼びます
   帰り値が負数なら枠外か鍵盤枠上です


    |  | | | |  |  | | | | | |  |
    |  |_| |_|  |  |_| |_| |_|  |
    |   |   |   |   |   |   |   |
    |   |   |   |   |   |   |   |
    +---+---+---+---+---+---+---+

}


interface

uses
   Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms
   ;

type
     TuPianoKey = class;
TPianoPaintEvent =
 procedure(Sender:TuPianoKey;PolyDt:array Of TPoint;kno:Integer;c:TColor;var uf:Boolean) of object;


  TuPianoKey = class(TCustomControl)
  private
    fMouseOn: boolean;

    { Private 宣言 }
  protected
    { Protected 宣言 }
  FOnPianoPaint:TPianoPaintEvent ;
  FOnChange:TNotifyEvent;
  kTop ,kSize :Integer;
  setNo  :Integer;
  ReEntry :Boolean;
  ColorWaku,ColorB,ColorW:TColor;
  ColorSB,ColorSW:TColor;
  procedure SetkTop (Value:Integer);
  procedure SetkSize(Value:Integer);
  procedure SetSetNo(Value:Integer);
  procedure SetColorWaku(Value:TColor);
  procedure SetColorW   (Value:TColor);
  procedure SetColorB   (Value:TColor);
  procedure SetColorSB  (Value:TColor);
  procedure SetColorSW  (Value:TColor);
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;   X, Y: Integer);override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;

 public
    { Public 宣言 }
  ExtID:Integer; //このコンポでは未使用

  constructor Create(AOwner: TComponent); override;
  procedure PianoKBPaint(cvs:TCanvas ;no:Integer;c0,cw,cb:Tcolor);
  procedure Paint; override;
  procedure Invalidate ;override;
   {輪郭 pt 内側 pf を得る}
  function  outline(no:Integer;var pt,pf:array of Tpoint):integer;
  function XY2scale(x, y: integer): integer;
  Property MouseOn    :boolean  read fMouseOn;

  published
   property SetingKeyNo:Integer  read setNo      write SetSetNo;
   property ColorBorder:  TColor read ColorWaku  write SetColorWaku ;
   property ColorBlackKey:TColor read ColorB     write SetColorB ;
   property ColorWhiteKey:TColor read ColorW     write SetColorW ;
   property ColorSelBlack:TColor read ColorSB    write SetColorSB ;
   property ColorSelWhite:TColor read ColorSW    write SetColorSW ;
   property KeyLeftNo:    Integer read kTop   write SetkTop   ;
   property KeySize:     Integer read kSize  write SetkSize   ;
   property Canvas;
   property    OnPianoPaint:TPianoPaintEvent
        read  FOnPianoPaint
       write  FOnPianoPaint;

   property OnChange:TNotifyEvent read FOnChange write FOnChange;
   property OnClick    ;
   property OnDblClick ;
   property OnMouseMove;
   property OnMouseDown;
   property OnMouseUp  ;
   property OnEnter    ;
   property OnKeyDown  ;
   property OnKeyPress ;
   property OnKeyUp    ;
   property OnExit     ;
   property Anchors    ;


    { Published 宣言 }
  end;

procedure Register;

implementation
//uses uMyFunc;
procedure Register;
begin
  RegisterComponents('Mine', [TuPianoKey]);
end;



//////////////////////////////////////////////
function PolygonEdge(x,y,n:integer;pt:array of TPoint):boolean;
begin
// Result:=IsPolyLineNear( pt , Point(x,y) , 3 );
 Result:=false;  //輪郭上ならという判定だが不要だろう
end;

function PolygonExterior(x,y,n:integer;pt:array of TPoint):boolean;
var i,ct,nx,dx,dy,rx,ry,u:integer;
begin
pt[n]:=pt[0]; {始点は終点と等しいとします}
ct :=0;
 for i:=0 to n-1 do begin
  rx:=x-pt[i].x;
  nx:=x-pt[i+1].x;
   if ((rx<=0)and(nx>=0)) or ((rx>0) and (nx<0))  then begin
    ry:=y-pt[i].y;
    dx:= pt[i+1].x- pt[i].x;
    dy:= pt[i+1].y- pt[i].y;
    u := longint(rx)*longint(dy)-longint(ry)*longint(dx);
    if  u<0 then Inc (ct) else Dec(ct);
   end;
  end;

  Result:=ct=0;
end;

/////////////////////////////////////////////
function PianoKeyNoChk(no:Integer):Integer; { 黒鍵 なら負数を返す }
 begin
  while no>12 do no:=no-12;
  while no<0  do no:=no+12;
  if no > 4 then Inc(no);
  if (no and 1)=1 then no:=-1-no;
  result:=no div 2;

 end;

function TuPianoKey.XY2scale(x,y:integer):integer;
var
 xwidth:Integer;
 var  ioct,moct:integer;
 var mc,absmk:integer;
 var ik,absik:integer;
  function chk(n:integer):boolean;
   var pt,pf:array [0..12] of TPoint;
   var asz:integer;
  begin
    asz:=outline(n,pt,pf);
    Result:=(not PolygonExterior(x,y,asz,pf))
     or(    PolygonEdge (x,y,asz,pf));


  end;
begin
 Result:=-1;
  if x<0 then exit;
  if y<0 then exit;
  if x>width  then exit;
  if y>height then exit;

 xwidth :=width -1;
 ioct   :=KeyLeftNo div 12;
 moct   :=(KeyLeftNo +KeySize ) div 12;
 absmk  :=Abs(PianoKeyNoChk( (KeyLeftNo+KeySize +12000) mod 12)); {*鍵盤数*}
 ik     := PianoKeyNoChk(KeyLeftNo mod 12);{* 黒鍵なら負数を返す   *}
 absik  :=Abs(ik);
 mc     :=((absmk-absik)+(moct-ioct)*7); {鍵盤の数}
 Result :=KeyLeftNo + (((x*mc) div xwidth)*12 div 7) ;

  if chk(Result) then exit;
  inc(Result);
  if chk(Result) then exit;
  inc(Result);
  if chk(Result) then exit;
  dec(Result,3);
  if chk(Result) then exit;
  Result:=-1;
end;

function TuPianoKey.outline(no:Integer;var pt,pf:array of Tpoint):integer;
var
 aSize,
 xPixSize,
 yPixSize:Integer;
      procedure PianoBlack(vx,vyh:Integer);
      var xm,xp:Integer;
      begin
        xp:= (xPixSize*5 div 14);xm:=-xp;

       pt[0].x:=vx+xm;
       pt[0].y:=0;
       pt[1].x:=vx+xm;
       pt[1].y:=vyh;
       pt[2].x:=vx+xp;
       pt[2].y:=vyh;
       pt[3].x:=vx+xp;
       pt[3].y:=0;

       pf[0].x:=pt[0].x+1;
       pf[0].y:=pt[0].y;
       pf[1].x:=pt[1].x+1;
       pf[1].y:=pt[1].y-1;
       pf[2].x:=pt[2].x-1;
       pf[2].y:=pt[2].y-1;
       pf[3].x:=pt[3].x-1;
       pf[3].y:=pt[3].y;
       aSize:=4;
      end;

      procedure PianoWhiteW(vx,vyh:Integer);
      var xm,xp:Integer;
      begin
        xp:= (xPixSize*5 div 14);xm:=-xp;

       pt[0].x:=vx+xp;
       pt[0].y:=0;
       pt[1].x:=vx+xp;
       pt[1].y:=vyh;
       pt[2].x:=vx;
       pt[2].y:=vyh;
       pt[3].x:=vx;
       pt[3].y:=   yPixSize;
       pt[4].x:=vx+xPixSize;
       pt[4].y:=   yPixSize;
       pt[5].x:=vx+xPixSize;
       pt[5].y:=vyh;
       pt[6].x:=vx+xPixSize+xm;
       pt[6].y:=vyh;
       pt[7].x:=vx+xPixSize+xm;
       pt[7].y:=0;
       pf[0].x:=pt[0].x+1;
       pf[0].y:=pt[0].y;
       pf[1].x:=pt[1].x+1;
       pf[1].y:=pt[1].y+1;
       pf[2].x:=pt[2].x+1;
       pf[2].y:=pt[2].y+1;
       pf[3].x:=pt[3].x+1;
       pf[3].y:=pt[3].y-1;

       pf[7].x:=pt[7].x-1;
       pf[7].y:=pt[7].y;
       pf[6].x:=pt[6].x-1;
       pf[6].y:=pt[6].y+1;
       pf[5].x:=pt[5].x-1;
       pf[5].y:=pt[5].y+1;
       pf[4].x:=pt[4].x-1;
       pf[4].y:=pt[4].y-1;
      aSize:=8;
      end;
      procedure PianoWhiteL(vx,vyh:Integer );
      var xm,xp:Integer;
      begin
        xp:= (xPixSize*5 div 14);xm:=-xp;

       pt[0].x:=vx;
       pt[0].y:=0;
       pt[1].x:=vx;
       pt[1].y:=   yPixSize;
       pt[2].x:=vx+xPixSize;
       pt[2].y:=   yPixSize;
       pt[3].x:=vx+xPixSize;
       pt[3].y:=vyh;
       pt[4].x:=vx+xPixSize+xm;
       pt[4].y:=vyh;
       pt[5].x:=vx+xPixSize+xm;
       pt[5].y:=0;
       pf[0].x:=pt[0].x+1;
       pf[0].y:=pt[0].y;
       pf[1].x:=pt[1].x+1;
       pf[1].y:=pt[1].y-1;

       pf[5].x:=pt[5].x-1;
       pf[5].y:=pt[5].y;
       pf[4].x:=pt[4].x-1;
       pf[4].y:=pt[4].y+1;
       pf[3].x:=pt[3].x-1;
       pf[3].y:=pt[3].y+1;
       pf[2].x:=pt[2].x-1;
       pf[2].y:=pt[2].y-1;
      aSize:=6;
      end;
      procedure PianoWhiteR(vx,vyh:Integer);
      var xp:Integer;
      begin
        xp:= (xPixSize*5 div 14);

       pt[0].x:=vx+xp;
       pt[0].y:=0;
       pt[1].x:=vx+xp;
       pt[1].y:=vyh;
       pt[2].x:=vx;
       pt[2].y:=vyh;
       pt[3].x:=vx;
       pt[3].y:=   yPixSize;
       pt[4].x:=vx+xPixSize;
       pt[4].y:=   yPixSize;
       pt[5].x:=vx+xPixSize;
       pt[5].y:=0;
       pf[0].x:=pt[0].x+1;
       pf[0].y:=pt[0].y;
       pf[1].x:=pt[1].x+1;
       pf[1].y:=pt[1].y+1;
       pf[2].x:=pt[2].x+1;
       pf[2].y:=pt[2].y+1;
       pf[3].x:=pt[3].x+1;
       pf[3].y:=pt[3].y-1;

       pf[5].x:=pt[5].x-1;
       pf[5].y:=pt[5].y;
       pf[4].x:=pt[4].x-1;
       pf[4].y:=pt[4].y-1;
       aSize:=6;
      end;
      procedure PianoWhite0(vx,vyh:Integer);
      begin
       pt[0].x:=vx;
       pt[0].y:=0;
       pt[1].x:=vx;
       pt[1].y:=   yPixSize;
       pt[2].x:=vx+xPixSize;
       pt[2].y:=   yPixSize;
       pt[3].x:=vx+xPixSize;
       pt[3].y:=0;

       pf[0].x:=pt[0].x+1;
       pf[0].y:=pt[0].y;
       pf[1].x:=pt[1].x+1;
       pf[1].y:=pt[1].y-1;
       pf[2].x:=pt[2].x-1;
       pf[2].y:=pt[2].y-1;
       pf[3].x:=pt[3].x-1;
       pf[3].y:=pt[3].y;
       aSize:=4;
      end;
var
 voct,ioct,moct,mk,vk,vkk,ik:integer;
  vyh,vx,vc,mc:integer;
 xwidth:Integer;
begin
 yPixSize:=Height-1;
 xwidth:=width -1;
 voct:=((       no+12000) div 12)-1000;
 ioct:=((KeyLeftNo+12000) div 12)-1000;
 moct:=((KeyLeftNo +KeySize +12000) div 12)-1000;
 mk  :=Abs(PianoKeyNoChk( (KeyLeftNo+KeySize +12000) mod 12)); {*鍵盤数*}
 vk  := PianoKeyNoChk((no+12000)  mod 12);
 ik  := PianoKeyNoChk((KeyLeftNo+12000 )mod 12);{* 黒鍵なら負数を返す   *}
 vkk :=Abs(vk);
 ik  :=Abs(ik);

 vc      :=((vkk-ik)+(voct-ioct)*7);
 mc      :=((mk -ik)+(moct-ioct)*7);
 vx      :=  vc   * xwidth div (mc);
 xPixSize:= (vc+1)* xwidth div (mc) -vx;

 vyh:= yPixSize*5 div 9;
 if vx=0 then
 case vk of
 -6..-1: PianoBlack (vx,vyh);
    0,3: PianoWhiteL(vx,vyh);
  1,4,5: PianoWhiteW(vx,vyh);
    2,6: PianoWhite0(vx,vyh);
 end
 else
 case vk of
 -6..-1 :PianoBlack(vx,vyh);
 0,3:    PianoWhiteL(vx,vyh);
 1,4,5:  PianoWhiteW(vx,vyh);
 2,6:    PianoWhiteR(vx,vyh);
 end;
 Result:=aSize;
end;

procedure TuPianoKey.PianoKBPaint(cvs:TCanvas ;no:Integer;c0,cw,cb:Tcolor);
var
 uf:Boolean;
 aSize:integer;
 pt,pf:array [0..12] of TPoint;
begin
  aSize:=outline(no,pt,pf);
 if PianoKeyNoChk( (no+12000)  mod 12) >=0 then  cb:=cw;
   canvas.Pen.Color :=c0;
   Polyline(canvas.handle,pt,aSize);
  uf:=False;
    canvas.Brush.Color :=cb;
    canvas.Pen  .Color :=cb;
  if Assigned(FOnPianoPaint) then
   FOnPianoPaint(Self,pf,no,cb,uf);
  if uf=False then
   begin
     polygon(canvas.handle,pf,aSize);
   end;
end;

procedure TuPianoKey.Paint;
var
 i:Integer;
begin

 for i:= kTop to  kTop+kSize-1 do
  begin
   if i=setNo then
    PianoKBPaint(Canvas,i,ColorWaku,ColorSW,ColorSB)
   else
    PianoKBPaint(Canvas,i,ColorWaku,ColorW,ColorB);
  end;

end;
 procedure TuPianoKey.SetkTop (Value:Integer);
 begin
// if Value>=0 then
  begin
   kTop:=Value;
   Invalidate;
  end;
 end;
 procedure TuPianoKey.SetkSize(Value:Integer);
 begin
 if Value >1 then
 if  kSize<>Value then
  begin
  Invalidate;
   kSize:=Value;
  end;
 end;

 constructor TuPianoKey.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
      kTop:=0;
      kSize:=12;
   width :=100;
   height:=30;
  ColorWaku:=clWindowFrame;
  ColorB   :=clWindowText;
  ColorW   :=clWindow;
  ColorSB  :=clHighlightText;
  ColorSW  :=clHighlight;
  ReEntry:=False;
  ExtID:=0;
 end;
 procedure TuPianoKey.SetColorWaku(Value:TColor);
 begin
  ColorWaku:=Value;
   Invalidate;
 end;

 procedure TuPianoKey.SetColorB   (Value:TColor);
 begin
  ColorB:=Value;
   Invalidate;
 end;
 procedure TuPianoKey.SetColorW   (Value:TColor);
  begin
  ColorW:=Value;
   Invalidate;
 end;
procedure TuPianoKey.SetColorSB  (Value:TColor);
 begin
  ColorSB:=Value;
   Invalidate;
 end;
 procedure TuPianoKey.SetColorSW  (Value:TColor);
  begin
  ColorSW:=Value;
   Invalidate;
 end;
 procedure TuPianoKey.SetSetNo (Value:Integer);
  begin
       if  setNo<>Value then  Invalidate;

  //if  setNo<>Value then
  begin
     setNo:=Value;
       ReEntry:=False;

     if assigned(OnChange) then
     begin
      if not ReEntry  then
       begin
         ReEntry:=True;
         OnChange(Self);
         ReEntry:=False;
       end;
     end;
  end;

 end;
 procedure TuPianoKey.Invalidate ;
 begin
  InvalidateRect(handle,Nil,FALSE);
 end;

procedure TuPianoKey.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var no:integer;
begin

 if Button = mbLeft then
  begin
   fMouseOn:=true;
   no:=XY2scale(x, y);
   if no>= kTop then   SetingKeyNo:=no;

  end else inherited;
end;


procedure TuPianoKey.MouseMove(Shift: TShiftState; X, Y: Integer);
var no:integer;
begin
 if ssLeft	in Shift then begin
      no:=XY2scale(x, y);
   if no>= kTop then  SetingKeyNo:=no
   else    fMouseOn:=False;
 end;
 inherited;

end;

procedure TuPianoKey.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
   fMouseOn:=False;
  inherited;
end;

end.