unit threadedfade; interface uses classes; type TThreadedfade = class (TThread) private { Private declarations } curvol : integer; vol : integer; fnostop : boolean; procedure getvol; procedure setvol; procedure killautoplay; protected procedure Execute; override; public property nostop : boolean read fnostop write fnostop; end; var Fade : TThreadedfade; procedure dofade; implementation uses jukeboxform,mmsystem,main,sysutils,backgroundplay; procedure dofade; begin fade:=TThreadedfade.Create(true); fade.FreeOnTerminate:=true; fade.Resume; end; procedure TThreadedFade.killautoplay; begin autoplaymode:=false; autoplaying:=false; if fnostop=false then mainform.stopclick(nil); end; procedure TThreadedFade.getvol; const MCI_DGV_STATUS_VOLUME = 19; var p : MCI_STATUS_PARMS; begin p.dwCallback := 0; p.dwItem := MCI_DGV_STATUS_VOLUME; mciSendCommand(mainform.MP.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Cardinal(@p)) ; curvol := p.dwReturn; end; procedure TThreadedFade.setvol; var op : integer; p : MCI_DGV_SETAUDIO_PARMS; begin p.dwCallback := 0; p.dwItem := MCI_DGV_SETAUDIO_VOLUME; p.dwValue:=op; p.dwOver := 0; p.lpstrAlgorithm := nil; p.lpstrQuality := nil; p.dwValue := vol; mciSendCommand(mainform.MP.DeviceID, MCI_SETAUDIO, MCI_DGV_SETAUDIO_VALUE or MCI_DGV_SETAUDIO_ITEM, Cardinal(@p)); end; procedure TThreadedfade.Execute; var sv : integer; begin fnostop:=false; synchronize(getvol); sv:=curvol; vol:=curvol; while(vol>0) do begin vol:=vol-1; synchronize(setvol); sleep(10); end; vol := sv; synchronize(setvol); synchronize(killautoplay); end; end.