?? pianokeyboard.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -