unit frmTrackBar;
{$mode objfpc}{$H+}
// https://forum.lazarus.freepascal.org/index.php/topic,46606.0.html?PHPSESSID=70njdrempm7i7uc0r6t25vg7l5
// Similar problem in C#
// https://www.oipapio.com/question-1739276
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
ExtCtrls;
type
TVolumeChanger = (vcNone, vcText, vcTrack, vcTrackResize);
{ TForm1 }
TForm1 = class(TForm)
LabeledEdit1: TLabeledEdit;
TrackBar1: TTrackBar;
procedure FormShow(Sender: TObject);
procedure LabeledEdit1Change(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar1Resize(Sender: TObject);
private
procedure SetVolume(AValue: Real);
private
FVolume : Real;
FVolumeChanger : TVolumeChanger;
procedure UpdateTrackBarFreq(aTrackBar : TTrackBar; aGraduation : integer = 10);
property Volume : Real read FVolume write SetVolume;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
Windows;
procedure TForm1.FormShow(Sender: TObject);
begin
TrackBar1.Min := 0;
TrackBar1.Max := TrackBar1.Width;
TrackBar1.OnChange(TrackBar1);
UpdateTrackBarFreq(TrackBar1);
end;
procedure TForm1.LabeledEdit1Change(Sender: TObject);
var
lVolume : real;
begin
if FVolumeChanger <> vcNone then
Exit;
FVolumeChanger := vcText;
if TryStrToFloat(LabeledEdit1.Text, lVolume) then
Volume := lVolume;
FVolumeChanger := vcNone;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
if FVolumeChanger <> vcNone then
Exit;
FVolumeChanger := vcTrack;
Volume := TrackBar1.Position / TrackBar1.Frequency;
LabeledEdit1.Text := Format('%.2g', [Volume]);
FVolumeChanger := vcNone;
end;
procedure TForm1.TrackBar1Resize(Sender: TObject);
var
lOldVolume : real;
begin
if FVolumeChanger <> vcNone then
Exit;
lOldVolume := Volume;
FVolumeChanger := vcTrackResize;
TrackBar1.Max := TrackBar1.Width;
UpdateTrackBarFreq(TrackBar1);
TrackBar1.Position := Trunc(FVolume * TrackBar1.Frequency);
FVolumeChanger := vcNone;
end;
procedure TForm1.SetVolume(AValue: Real);
begin
if FVolume=AValue then
Exit;
FVolume:=AValue;
TrackBar1.Position := Trunc(FVolume * TrackBar1.Frequency);
end;
procedure TForm1.UpdateTrackBarFreq(aTrackBar : TTrackBar; aGraduation : integer = 10);
var
lFreq : integer;
begin
lFreq := (aTrackBar.Max - aTrackBar.Min) div (aGraduation-1);
TrackBar1.max := lFreq * 10;
TrackBar1.Frequency:=lFreq;
end;