uses 
  Windows, 
  SysUtils, 
  Classes, 
  Forms, 
  Controls, 
  ComCtrls; 
 
type 
  TDoUpdate = class(TThread) 
    procedure execute; override; 
    procedure DoGet; 
  end; 
 
  TForm1 = class(TForm) 
    TrackBar1: TTrackBar; // Master 
    TrackBar2: TTrackBar; // Wave 
    TrackBar3: TTrackBar; // Midi 
    TrackBar4: TTrackBar; // CD 
    procedure FormCreate(Sender: TObject); 
    procedure TrackBar1Change(Sender: TObject); 
    procedure TrackBar2Change(Sender: TObject); 
    procedure TrackBar3Change(Sender: TObject); 
    procedure TrackBar4Change(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses mmsystem; 
 
var 
  master_mc, wave_mc, midi_mc, cd_mc: tagMIXERCONTROLA; 
  master_ok, wave_ok, midi_ok, cd_ok: MMResult; 
  DoUpdate: TDoUpdate; 
 
function GetControl(var TMC: tagMIXERCONTROLA; Who: DWord): MMResult; 
var 
  TML: tagMIXERLINEA; 
  TMCS: tagMIXERLINECONTROLSA; 
begin 
  ZeroMemory(@TML, SizeOf(TML)); 
  TML.cbStruct := SizeOf(TML); 
  TML.dwComponentType := Who; 
  Result := mixerGetLineInfo(0, @TML, MIXER_GETLINEINFOF_COMPONENTTYPE); 
  if Result = MMSYSERR_NOERROR then begin 
    ZeroMemory(@TMCS, SizeOf(TMCS)); 
    TMCS.cbStruct := SizeOf(TMCS); 
    TMCS.dwLineID := TML.dwLineID; 
    TMCS.cControls := 1; 
    TMCS.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME; 
    TMCS.cbmxctrl := SizeOf(TMC); 
    TMCS.pamxctrl := @TMC; 
    Result := mixerGetLineControls(0, @TMCS, 
      MIXER_GETLINECONTROLSF_ONEBYTYPE); 
  end; 
end; 
 
procedure SetVolume(TMC: tagMIXERCONTROLA; MM: MMResult; Value: Word); 
var 
  TCD: tMixerControlDetails; 
  TCDU: tMIXERCONTROLDETAILS_UNSIGNED; 
begin 
  if MM = MMSYSERR_NOERROR then begin 
    TCDU.dwValue := Value; 
    with TCD do begin 
      cbStruct := SizeOf(TCD); 
      dwControlID := TMC.dwControlID; 
      cChannels := 1; 
      cMultipleItems := 0; 
      cbDetails := SizeOf(TCDU); 
      paDetails := @TCDU; 
    end; 
    MM := mixerSetControlDetails(0, @TCD, MIXER_SETCONTROLDETAILSF_VALUE); 
  end; 
  if MM <> MMSYSERR_NOERROR then 
    raise Exception.Create('"SetVolume" fehlgeschlagen'); 
end; 
 
function GetVolume(TMC: tagMIXERCONTROLA; MM: MMResult): DWord; 
var 
  TCD: tMixerControlDetails; 
  TCDU: tMIXERCONTROLDETAILS_UNSIGNED; 
begin 
  if MM = MMSYSERR_NOERROR then begin 
    with TCD do begin 
      cbStruct := SizeOf(TCD); 
      dwControlID := TMC.dwControlID; 
      cChannels := 1; 
      cMultipleItems := 0; 
      cbDetails := SizeOf(TCDU); 
      paDetails := @TCDU; 
    end; 
    MM := mixerGetControlDetails(0, @TCD, MIXER_GETCONTROLDETAILSF_VALUE); 
    Result := TCDU.dwValue; 
  end else Result := 0; 
  if MM <> MMSYSERR_NOERROR then 
    raise Exception.Create('"GetVolume" fehlgeschlagen'); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
// --- kann im Objektinspektor eingestellt werden ---- 
  trackbar1.max := 65535; 
  trackbar2.max := 65535; 
  trackbar3.max := 65535; 
  trackbar4.max := 65535; 
  trackbar1.frequency := 10921; 
  trackbar2.frequency := 10921; 
  trackbar3.frequency := 10921; 
  trackbar4.frequency := 10921; 
// ----------------------------------------------------- 
  master_ok := GetControl(master_mc, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS); 
  midi_ok := GetControl(midi_mc, MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER); 
  wave_ok := GetControl(wave_mc, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT); 
  cd_ok := GetControl(cd_mc, MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC); 
  DoUpdate := TDoUpdate.create(false); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  DoUpdate.free; 
end; 
 
procedure TForm1.TrackBar1Change(Sender: TObject); 
begin 
  setvolume(master_mc, master_ok, TrackBar1.position); 
end; 
 
procedure TForm1.TrackBar2Change(Sender: TObject); 
begin 
  setvolume(wave_mc, wave_ok, TrackBar2.position); 
end; 
 
procedure TForm1.TrackBar3Change(Sender: TObject); 
begin 
  setvolume(midi_mc, midi_ok, TrackBar3.position); 
end; 
 
procedure TForm1.TrackBar4Change(Sender: TObject); 
begin 
  setvolume(cd_mc, cd_ok, TrackBar4.position); 
end; 
 
procedure TDoUpdate.DoGet; 
begin 
  with Form1 do begin 
    trackbar1.position := getvolume(master_mc, master_ok); 
    trackbar2.position := getvolume(wave_mc, wave_ok); 
    trackbar3.position := getvolume(midi_mc, midi_ok); 
    trackbar4.position := getvolume(cd_mc, cd_ok); 
  end; 
end; 
 
procedure TDoUpdate.Execute; 
begin 
  while not terminated do 
    Synchronize(DoGet); 
end;