pianokeyboard.pas

Delphi钢琴源码

    Parent := Self;
    Left := KeyBoardLeft + 5;
    Top := FKeyBoardTop;
    Width := 129;
    Height := 17;
    //Font := Self.Font;
    //Font.Color := clWhite;
    Visible := FShowGroup;
  end;
  GrpsList.AddObject('0', FGroupBox);
end;

procedure TPianoKeyboard.BuildPianokeyBoard;
var
  i, j, k: Integer;
  iGroupWidth: Integer;
  btnTemp: TPianoButton;
  grpTemp: TGroupBox;
begin
  Visible := False;

  iGroupWidth := 7 * (FPianoButton[2].Left - FPianoButton[0].Left);
  Width := FPianoButton[0].Left + FPianoGroup * iGroupWidth + FPianoButton[0].Left;
  SetAutoWidth(FAutoWidth); // Auto Size Form
  // Rebuild it.
  for j := 12 to BtnsList.Count - 1 do
  begin
    BtnsList.Objects[j].Free;
  end;
  BtnsList.Clear;

  for j := 0 to 11 do
  begin
    BtnsList.AddObject(IntToStr(j), FPianoButton[j]);
  end;

  // Build more keys
  for i := 1 to FPianoGroup - 1 do
  begin
    for j := 0 to 11 do
    begin
      k := 12 * i + j;
      btnTemp := TPianoButton.Create(Self);
      with btnTemp do
      begin
        Parent := Self;
        Name := 'FPianoButton' + IntToStr(k);
        Tag := k;
        // Looks
        BevelWidth := TPianoButton(BtnsList.Objects[j]).BevelWidth;
        // Position
        Top := TPianoButton(BtnsList.Objects[j]).Top;
        Left := TPianoButton(BtnsList.Objects[j]).Left + i * iGroupWidth;
      end;
      // Add to Object list
      BtnsList.AddObject(IntToStr(k), btnTemp);
    end;
  end;

  // Set button events
  for i := 0 to BtnsList.Count - 1 do
  begin
    btnTemp := TPianoButton(BtnsList.Objects[i]);
    with btnTemp do
    begin
      OnMouseDown := PianoMouseDown;
      OnMouseMove := PianoMouseMove;
      OnMouseUp := PianoMouseUp;
    end;
  end;
  SetButtonsColor(True, FPianoColor); // Set Buttons Bitmap

  // Rebuild it.
  for i := 1 to GrpsList.Count - 1 do
  begin
    GrpsList.Objects[i].Free;
  end;
  GrpsList.Clear;

  GrpsList.AddObject('0', FGroupBox);
  // Build more groups
  for i := 1 to FPianoGroup - 1 do
  begin
    grpTemp := TGroupBox.Create(Self);
    with grpTemp do
    begin
      Parent := Self;
      Name := 'FGroupBox' + IntToStr(i);
      Top := FGroupBox.Top;
      Left := FGroupBox.Left + i * iGroupWidth;
      Height := FGroupBox.Height;
      Width := FGroupBox.Width;
      Visible := FShowGroup;
    end;
    // Add to object list
    GrpsList.AddObject(IntToStr(i), grpTemp);
  end;
  SetGroupFontColor(FGroupFontColor);
  SetPianoGroupsMap; // Set Groups Caption and visible

  Visible := True;

  // Build Keys Map
  for i := 0 to CMaxKey do
  begin
    NotesList.Add(#0);
  end;
  for i := 0 to CLastKey - 1 do
  begin
    NotesList.Strings[Notes[i].iChar] := IntToStr(Notes[i].iNote);
  end;
end;

procedure TPianoKeyboard.SetButtonColor(bFirst: Boolean; pcColor: TPianoColor; pbButton: TPianoButton);
var
  ind: integer;
begin
  ind := Integer(pcColor) + 1;
  case pbButton.Tag mod 12 of
    0, 5:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'W0');
        FPianoWhiteImgList.GetBitmap(5 * ind + 0, pbButton.BitmapDown);
      end;
    2:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'W1');
        FPianoWhiteImgList.GetBitmap(5 * ind + 1, pbButton.BitmapDown);
      end;
    4, 11:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'W2');
        FPianoWhiteImgList.GetBitmap(5 * ind + 2, pbButton.BitmapDown);
      end;
    7:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'W3');
        FPianoWhiteImgList.GetBitmap(5 * ind + 3, pbButton.BitmapDown);
      end;
    9:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'W4');
        FPianoWhiteImgList.GetBitmap(5 * ind + 4, pbButton.BitmapDown);
      end;
    1, 3, 6, 8, 10:
      begin
        if bFirst then
          pbButton.Bitmap.LoadFromResourceName(HInstance, 'B0');
        FPianoBlackImgList.GetBitmap(ind + 0, pbButton.BitmapDown);
      end;
  end;
end;

procedure TPianoKeyboard.SetButtonsColor(bFirst: Boolean; pcColor: TPianoColor);
var
  i: integer;
begin
  for i := 0 to BtnsList.Count - 1 do
  begin
    SetButtonColor(bFirst, pcColor, TPianoButton(BtnsList.Objects[i]));
  end;
end;

procedure TPianoKeyboard.SetGroupFontColor(const Value: TColor);
var
  i: Integer;
begin
  FGroupFontColor := Value;
  for i := 0 to GrpsList.Count - 1 do
  begin
    TGroupBox(GrpsList.Objects[i]).Font.Color := FGroupFontColor;
  end;
end;

procedure TPianoKeyboard.SetPianoGroupsMap;
var
  i: Integer;
begin
  // Build Groups Map
  for i := 0 to GrpsList.Count - 1 do
  begin
    if (i + FPianoOctave) < CLastGroup then
    begin
      TGroupBox(GrpsList.Objects[i]).Visible := FShowGroup;
      TGroupBox(GrpsList.Objects[i]).Caption := Groups[i + FPianoOctave];
    end else
    begin
      TGroupBox(GrpsList.Objects[i]).Visible := False;
    end;
  end;
end;

constructor TPianoKeyboard.Create(AOwner: TComponent);
begin
  inherited;
  Height := 145;
  Width := 174;
  Color := CColor;
  FGroupFontColor := CFontColor;
  FKeyBoardTop := CKeyBoardTop;
  FKeyBoardLeft := CKeyBoardLeft;
  FPianoGroup := CPianoGroup;
  FPianoOctave := CPianoOctave;
  FPianoColor := pcGreen;
  FAutoWidth := CAutoWidth;
  FShowGroup := CShowGroup;

  FOwner := (AOwner as TWinControl);

  FPianoBlackImgList := TImageList.CreateSize(13, 73);
  FPianoWhiteImgList := TImageList.CreateSize(20, 104);
  GrpsList := TStringList.Create; // Hold Groups description
  BtnsList := TStringList.Create; // Hold Buttons for Piano
  NotesList := TStringList.Create; // Hold Keys Map of note

  InitPianoKeyboard;
  BuildPianokeyBoard;
end;

destructor TPianoKeyboard.Destroy;
begin
  FPianoBlackImgList := nil;
  FPianoWhiteImgList := nil;
  FreeAndNil(GrpsList);
  FreeAndNil(BtnsList);
  FreeAndNil(NotesList);
  inherited;
end;

procedure TPianoKeyboard.SetPianoGroup(const Value: Integer);
begin
  FPianoGroup := Value;
  BuildPianokeyBoard;
end;

procedure TPianoKeyboard.SetPianoColor(const Value: TPianoColor);
begin
  FPianoColor := Value;
  ResetPianoButtons;
  SetButtonsColor(False, FPianoColor);
end;

procedure TPianoKeyboard.SetPianoOctave(const Value: Byte);
begin
  FPianoOctave := Value;
  ResetPianoButtons;
  SetPianoGroupsMap;
end;

procedure TPianoKeyboard.SetKeyBoardLeft(const Value: Integer);
begin
  FKeyBoardLeft := Value;
  SetKeyBoardPos;
end;

procedure TPianoKeyboard.SetKeyBoardTop(const Value: Integer);
begin
  FKeyBoardTop := Value;
  SetKeyBoardPos;
end;

procedure TPianoKeyboard.SetKeyBoardPos;
var
  i: Integer;
  iLeft, iTop: Integer;
begin
  iLeft := FKeyBoardLeft - (FGroupBox.Left - 5);
  iTop := FKeyBoardTop - FGroupBox.Top;
  for i := 0 to BtnsList.Count - 1 do
  begin
    TPianoButton(BtnsList.Objects[i]).Left := TPianoButton(BtnsList.Objects[i]).Left + iLeft;
    TPianoButton(BtnsList.Objects[i]).Top := TPianoButton(BtnsList.Objects[i]).Top + iTop;
  end;
  for i := 0 to GrpsList.Count - 1 do
  begin
    TGroupBox(GrpsList.Objects[i]).Left := TGroupBox(GrpsList.Objects[i]).Left + iLeft;
    TGroupBox(GrpsList.Objects[i]).Top := TGroupBox(GrpsList.Objects[i]).Top + iTop;
  end;
end;

procedure TPianoKeyboard.SetAutoWidth(const Value: Boolean);
begin
  FAutoWidth := Value;
  if FAutoWidth then
    FOwner.Width := Width + 2 * Left;
end;

procedure TPianoKeyboard.SetShowGroup(const Value: Boolean);
begin
  FShowGroup := Value;
  SetPianoGroupsMap;
end;

procedure TPianoKeyboard.ResetPianoButtons;
var
  i: integer;
begin
  for i := 0 to BtnsList.Count - 1 do
  begin
    //SetButtonColor(False, FPianoColor, TPianoButton(BtnsList.Objects[i]));
    if TPianoButton(BtnsList.Objects[i]).State <> bsUP then
    begin
      TPianoButton(BtnsList.Objects[i]).State := bsUp;
    end;
  end;
end;

procedure TPianoKeyboard.DoMidiEvent(Event, data1, data2: Byte; pcColor: TPianoColor);
var
  iButton: Integer;
begin
  iButton := data1 - FPianoOctave * 12;
  case (event and $F0) of
    $90: // Note On
      begin
        if (iButton < BtnsList.Count) and (iButton >= 0) then
        begin
          if data2 <> 0 then
          begin
            if Integer(pcColor) <> -1 then
              DoPianoColor(iButton, pcColor);
            TPianoButton(BtnsList.Objects[iButton]).State := bsDown
          end else
          begin
            TPianoButton(BtnsList.Objects[iButton]).State := bsUp;
          end;
        end;
      end;
    $80: // Note Off
      begin
        if (iButton < BtnsList.Count) and (iButton >= 0) then
        begin
          TPianoButton(BtnsList.Objects[iButton]).State := bsUp;
        end;
      end;
    $B0: // Control change
      begin
        if data1 = $7E then
        begin
          ResetPianoButtons;
        end;
      end;
    $7B: // All notes off
      begin
        ResetPianoButtons;
      end;
  end;
end;

procedure SetMouseOctave(var iOctave: Integer; Shift: TShiftState);
begin
  if ssShift in Shift then Inc(iOctave);
  if ssCtrl in Shift then Dec(iOctave);
end;

procedure TPianoKeyboard.PianoMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  iOctave, iNote, iSpeed: Integer;
  ABtn: TPianoButton;
begin
//  if Assigned(FOnPianoMouseDown) then
//    FOnPianoMouseDown(Sender, Button, Shift, X, Y);

  if not (Sender is TPianoButton) then Exit;
  ABtn := Sender as TPianoButton;

  iOctave := FPianoOctave + ABtn.Tag div 12;
  SetMouseOctave(iOctave, Shift);
  iNote := ABtn.Tag mod 12;
  iSpeed := 64;
  ABtn.State := bsDown;

  if Assigned(FOnKeyboard) then
    FOnKeyboard($90, iOctave * 12 + iNote, iSpeed);
end;

procedure TPianoKeyboard.PianoMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
//  if Assigned(FOnPianoMouseMove) then
//    FOnPianoMouseMove(Sender, Shift, X, Y);
end;

procedure TPianoKeyboard.PianoMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  iOctave, iNote, iSpeed: Integer;
  ABtn: TPianoButton;
begin
//  if Assigned(FOnPianoMouseUp) then
//    FOnPianoMouseUp(Sender, Button, Shift, X, Y);

  if not (Sender is TPianoButton) then Exit;
  ABtn := Sender as TPianoButton;

  iOctave := FPianoOctave + ABtn.Tag div 12;
  SetMouseOctave(iOctave, Shift);
  iNote := ABtn.Tag mod 12;
  iSpeed := 64;
  ABtn.State := bsUp;

  if Assigned(FOnKeyboard) then
    FOnKeyboard($80, iOctave * 12 + iNote, iSpeed);
end;

procedure TPianoKeyboard.DoPianoColor(iNote: Byte; pcColor: TPianoColor);
begin
  if iNote >= BtnsList.Count then Exit;
  SetButtonColor(False, pcColor, TPianoButton(BtnsList.Objects[iNote]));
end;

procedure TPianoKeyboard.DoPianoShortCut(var Msg: TWMKey;
  var Handled: Boolean);
const
  KD31 = $40000000;
begin
  case Msg.Msg of
    CN_KEYDOWN:
      begin
        // this code is very useful to hanlde the system keydelay and keyrepeat.
        if (Msg.KeyData and KD31) <> 0 then
          Handled := True;
      end;
  end;
end;

procedure TPianoKeyboard.DoPianoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if NotesList[Key] = #0 then Exit;
  PianoMouseDown(BtnsList.Objects[StrToInt(NotesList.Strings[Key])], mbLeft, Shift, -1, -1);
end;

procedure TPianoKeyboard.DoPianoKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if NotesList[Key] = #0 then Exit;
  PianoMouseUp(BtnsList.Objects[StrToInt(NotesList.Strings[Key])], mbLeft, Shift, -1, -1);
end;

procedure Register;
begin
  RegisterComponents('Piano Suite', [TPianoKeyboard]);
end;

end.