171 lines
4.1 KiB
ObjectPascal
171 lines
4.1 KiB
ObjectPascal
//
|
|
// Robert Rossmair, 2002
|
|
//
|
|
unit MidiOutExampleTuningDlg;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
|
|
Buttons, ExtCtrls, Spin,
|
|
JclMath, JclMidi;
|
|
|
|
type
|
|
TTuningDialog = class(TForm)
|
|
OKBtn: TButton;
|
|
CancelBtn: TButton;
|
|
Bevel1: TBevel;
|
|
MIDIFreq: TEdit;
|
|
FreqHertz: TEdit;
|
|
MIDIFreqLabel: TLabel;
|
|
FreqLabel: TLabel;
|
|
MIDIKey: TSpinEdit;
|
|
MIDIKeyLabel: TLabel;
|
|
NoteLabel: TLabel;
|
|
procedure MIDIKeyChange(Sender: TObject);
|
|
procedure MIDIFreqChange(Sender: TObject);
|
|
procedure FreqHertzChange(Sender: TObject);
|
|
procedure MIDIFreqExit(Sender: TObject);
|
|
procedure FreqHertzExit(Sender: TObject);
|
|
private
|
|
FInMIDIFreqChange: Boolean;
|
|
FInFreqHertzChange: Boolean;
|
|
FChangingFrequency: Boolean;
|
|
FChangingMidiFrequency: Boolean;
|
|
FFrequency: Single;
|
|
FMidiFrequency: Single;
|
|
procedure SetFrequency(Value: Single);
|
|
procedure SetMidiFrequency(Value: Single);
|
|
public
|
|
property Frequency: Single read FFrequency write SetFrequency; // Hertz
|
|
property MidiFrequency: Single read FMidiFrequency write SetMidiFrequency;
|
|
end;
|
|
|
|
var
|
|
TuningDialog: TTuningDialog;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
const
|
|
HalftonesPerOctave = 12;
|
|
MiddleA = 440.0; // Hertz
|
|
MidiMiddleA = 69; // A3 = 440 Hertz
|
|
Digits = 6;
|
|
MIDIFreqMax = 127.99993896;
|
|
FreqHertzMin = 8.17579892;
|
|
FreqHertzMax = 13289.70346552;
|
|
|
|
function Hertz(MIDINote: Extended): Extended;
|
|
begin
|
|
Hertz := TwoToY((MIDINote - MidiMiddleA) / HalftonesPerOctave) * MiddleA;
|
|
end;
|
|
|
|
function MIDINote(Hertz: Extended): Extended;
|
|
begin
|
|
if Hertz < 1.0 then
|
|
MIDINote := Low(Integer)
|
|
else
|
|
MIDINote := LogBase2(Hertz / MiddleA) * HalftonesPerOctave + MidiMiddleA;
|
|
end;
|
|
|
|
procedure TTuningDialog.MIDIKeyChange(Sender: TObject);
|
|
begin
|
|
MIDIFrequency := MIDIKey.Value;
|
|
NoteLabel.Caption := MidiNoteToStr(MIDIKey.Value);
|
|
end;
|
|
|
|
procedure TTuningDialog.MIDIFreqChange(Sender: TObject);
|
|
var
|
|
F: Extended;
|
|
begin
|
|
if FInFreqHertzChange or (MIDIFreq.Text = '') then
|
|
Exit;
|
|
FInMIDIFreqChange := True;
|
|
try
|
|
{$IFDEF COMPILER6_UP}
|
|
if TryStrToFloat(MidiFreq.Text, F) then
|
|
{$ELSE}
|
|
if TextToFloat(PChar(MidiFreq.Text), F, fvExtended) then
|
|
{$ENDIF COMPILER6_UP}
|
|
MidiFrequency := F;
|
|
finally
|
|
FInMIDIFreqChange := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TTuningDialog.FreqHertzChange(Sender: TObject);
|
|
var
|
|
F: Extended;
|
|
begin
|
|
if FInMIDIFreqChange or (FreqHertz.Text = '') then
|
|
Exit;
|
|
FInFreqHertzChange := True;
|
|
try
|
|
{$IFDEF COMPILER6_UP}
|
|
if TryStrToFloat(FreqHertz.Text, F) then
|
|
{$ELSE}
|
|
if TextToFloat(PChar(FreqHertz.Text), F, fvExtended) then
|
|
{$ENDIF COMPILER6_UP}
|
|
Frequency := F;
|
|
finally
|
|
FInFreqHertzChange := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TTuningDialog.SetFrequency(Value: Single);
|
|
begin
|
|
if FChangingFrequency or (Value = Frequency) then
|
|
Exit;
|
|
FChangingFrequency := True;
|
|
try
|
|
if Value < FreqHertzMin then
|
|
Value := FreqHertzMin
|
|
else
|
|
if Value > FreqHertzMax then
|
|
Value := FreqHertzMax;
|
|
FFrequency := Value;
|
|
if not FInFreqHertzChange then
|
|
FreqHertz.Text := FloatToStrF(Value, ffFixed, 9, Digits);
|
|
MidiFrequency := MIDINote(Value);
|
|
finally
|
|
FChangingFrequency := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TTuningDialog.SetMidiFrequency(Value: Single);
|
|
begin
|
|
if FChangingMidiFrequency then
|
|
// or (Value = MidiFrequency) then
|
|
Exit;
|
|
if Value < 0 then
|
|
Value := 0
|
|
else
|
|
if Value > MidiFreqMax then
|
|
Value := MidiFreqMax;
|
|
FChangingMidiFrequency := True;
|
|
try
|
|
FMidiFrequency := Value;
|
|
if not FInMidiFreqChange then
|
|
MIDIFreq.Text := FloatToStrF(Value, ffFixed, 9, Digits);
|
|
Frequency := Hertz(Value);
|
|
finally
|
|
FChangingMidiFrequency := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TTuningDialog.MIDIFreqExit(Sender: TObject);
|
|
begin
|
|
MIDIFreq.Text := FloatToStrF(MidiFrequency, ffFixed, 9, Digits);
|
|
end;
|
|
|
|
procedure TTuningDialog.FreqHertzExit(Sender: TObject);
|
|
begin
|
|
FreqHertz.Text := FloatToStrF(Frequency, ffFixed, 9, Digits);
|
|
end;
|
|
|
|
end.
|