unit mixercontroler; interface uses windows,classes,controls,graphics,sysutils,messages,mmsystem,math; type TKnobChanged= procedure (x : word;control : byte) of object; type TMixerPotWatcher = class (TWinControl) private volumecallback : TknobChanged; treblecallback : TknobChanged; basscallback : TknobChanged; procedure PotChanged1(var Message: tmessage);message MM_JOY1MOVE; procedure PotChanged2(var Message: tmessage);message MM_JOY2MOVE; protected public constructor Create(AOwner : Tcomponent); override; destructor Destroy; override; published procedure init (v,t,b : TKnobchanged); end; type TMixerKnob = class (Tcustomcontrol) private vcanv : Tbitmap; hrgn:HRgn; fmax : integer; fposition : integer; lastposition : integer; fbitmap : tbitmap; fbwbitmap : tbitmap; fradius : integer; fstartradius : integer; fbrightness : real; ftype : integer; //0 volume 1 treble 2 bass fstartpos : integer; CurrentControlType : dword; mixer : hmixer; vol,lastvol : integer; function GetMixerKnobID(CompType: DWORD; ControlType: DWord): DWORD; function SetMute(ID: DWord; EnableMute: Boolean): Boolean; function GetMute(ctrl: word): Boolean; procedure mute(ctrl : word;t : boolean); procedure setangles; procedure _setposition(p : integer); procedure _setmax(m : integer); procedure setregion; procedure angledraw(startangle,endangle : integer;startrad : integer;endrad : integer); property radius : integer read fradius write fradius; property position : integer read fposition write _setposition; procedure assignbackground(_bitmap : tbitmap); procedure WMMixer(var Message: tmessage); message MM_MIXM_CONTROL_CHANGE; procedure setvol(level : dword); function getvol : dword; protected public constructor Create(AOwner : Tcomponent); override; destructor Destroy; override; procedure CreateWnd; override; procedure ShowControl(AControl: TControl); procedure PotChanged(x : word;control : byte); published procedure init(t : byte); procedure paint; override; procedure resize; override; property brightness : real read fbrightness write fbrightness; end; procedure Register; const MIXMAX = 65535; const NOTCHES = 100; var NOTCH : real; implementation {$R mixer.res} procedure TMixerKnob.init(t : byte); var bmp : tbitmap; begin ftype:=t; lastposition:=-9999; if ftype=0 then begin fstartpos:=180; CurrentControlType:=MIXERCONTROL_CONTROLTYPE_VOLUME; bmp:=tbitmap.create; bmp.LoadFromResourceName(hinstance,'VOLUME'); assignbackground(bmp); bmp.free; doublebuffered:=true; end; if ftype=1 then begin fstartpos:=0; CurrentControlType:=MIXERCONTROL_CONTROLTYPE_TREBLE; bmp:=tbitmap.create; bmp.LoadFromResourceName(hinstance,'TREBLE'); assignbackground(bmp); bmp.free; doublebuffered:=true; end; if ftype=2 then begin fstartpos:=0; CurrentControlType:=MIXERCONTROL_CONTROLTYPE_BASS; bmp:=tbitmap.create; bmp.LoadFromResourceName(hinstance,'BASS'); assignbackground(bmp); bmp.free; doublebuffered:=true; end; end; function computenotchvol(x : dword;ftype : integer) : integer; var n : integer; y : dword; begin for n:=0 to NOTCHES do begin if (x>=(n*NOTCH)) and (x<=((n+1)*NOTCH)) then begin; y:=n; if (x>((NOTCHES-1)*NOTCH)) then y:=NOTCHES; break; end; end; result:=y; if ftype>0 then begin result:=0-(notches div 2)+y; end; end; procedure TMixerKnob.WMMixer(var Message: tmessage); begin vol:=computenotchvol(getvol,ftype); position:=vol; end; procedure TMixerKnob.PotChanged(x : word;control : byte); begin lastvol:=x; vol:=computenotchvol(x,ftype); if ftype=0 then setvol(round(MIXMAX / NOTCHES)*vol) else begin setvol(x); end; end; function TMixerKnob.GetMixerKnobID(CompType: DWORD; ControlType: DWord): DWORD; var mxl: MIXERLINE; mxc: MIXERCONTROL; mxlc: MIXERLINECONTROLS; begin Result := 0; mxl.cbStruct := SizeOf(mxl); mxl.dwComponentType := CompType; if (mixerGetLineInfo(mixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) = MMSYSERR_NOERROR) then begin mxlc.cbStruct := SizeOf(mxlc); mxlc.dwLineID := mxl.dwLineID; mxlc.dwControlType :=ControlType; mxlc.cControls := mxl.cControls; mxlc.cbmxctrl := sizeof(mxc); mxlc.pamxctrl := @mxc; if (mixerGetLineControls(mixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) = MMSYSERR_NOERROR) then Result := mxc.dwControlID; end; end; function TMixerknob.SetMute(ID: DWord; EnableMute: Boolean): Boolean; var mxcd: TMixerControlDetails; mxcdb: TMixerControlDetailsBoolean; begin with mxcd do begin cbStruct := SizeOf(TMixerControlDetails); dwControlID := ID; cChannels := 1; cMultipleItems := 0; cbDetails := SizeOf(TMixerControlDetailsBoolean); paDetails := @mxcdb; LongBool(mxcdb.fValue) := EnableMute; Result := (mixerSetControlDetails(mixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR); end; end; function TMixerknob.GetMute(ctrl: word): Boolean; var MixerCtrlID : DWord; mxcd: TMixerControlDetails; details : TMixerControlDetailsboolean; res : word; begin result:=false; MixerCtrlID := GetMixerKnobID(ctrl,MIXERCONTROL_CONTROLTYPE_MUTE); with mxcd Do begin fillchar(mxcd,sizeof(mxcd),0); cbStruct := SizeOf(TMixerControlDetails); dwControlID := MixerCtrlID; cChannels :=1; cbDetails := SizeOf(TMixerControlDetailsboolean); paDetails := @details; longbool(details):=false; res:=mixerGetControlDetails(0, @mxcd, MIXER_GETCONTROLDETAILSF_VALUE); if res=0 then if (details.fvalue<>0)then result:=true else result:=false; end; end; procedure TMixerKnob.mute(ctrl : word;t : boolean); var MixerCtrlID: DWord; begin MixerCtrlID := GetMixerKnobID(ctrl,MIXERCONTROL_CONTROLTYPE_MUTE); setmute(MixerCtrlID,t); end; function TMixerKnob.getvol : dword; var MixerCtrlID : integer; mxcd : TMixerControlDetails; details : TMixerControlDetailsunsigned; begin MixerCtrlID := GetMixerKnobID(MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,CurrentControlType); with mxcd Do begin fillchar(mxcd,sizeof(mxcd),0); cbStruct := SizeOf(TMixerControlDetails); dwControlID := MixerCtrlID; cChannels :=1; cbDetails := SizeOf(TMixerControlDetailsUnsigned); paDetails := @details; details.dwvalue:=0; mixerGetControlDetails(0, @mxcd, MIXER_GETCONTROLDETAILSF_VALUE); result:=details.dwvalue; end; end; procedure TMixerKnob.setvol(level : dword); var MixerCtrlID : integer; mxcd : TMixerControlDetails; details : TMixerControlDetailsUnsigned; begin MixerCtrlID := GetMixerKnobID(MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,CurrentControlType); with mxcd Do begin fillchar(mxcd,sizeof(mxcd),0); cbStruct := SizeOf(TMixerControlDetails); dwControlID := MixerCtrlID; cChannels :=1; cbDetails := SizeOf(TMixerControlDetailsUnsigned); paDetails := @details; details.dwvalue:=level; mixerSetControlDetails(0, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE); end; end; constructor TMixerKnob.Create(AOwner : TComponent); begin inherited; vcanv:= Tbitmap.create; width:=100; height:=100; Parent:=(Owner As TWinControl); fstartradius:=11; fposition:=0; fbrightness:=3; fradius:=20; NOTCH:=65535 / NOTCHES; fmax:=NOTCHES; mixeropen(@mixer,0,self.Handle,0,CALLBACK_WINDOW); vol:=computenotchvol(getvol,ftype); position:=vol; end; destructor TMixerKnob.Destroy; begin vcanv.free; inherited Destroy; mixerclose(mixer); end; procedure TMixerKnob.Resize; begin; fstartradius:=0; fradius:=width div 2; vcanv.width:=width; vcanv.height:=height; setregion; inherited; end; procedure TMixerKnob.setregion; begin SetWindowRgn(Handle , 0, False); DeleteObject(hRgn); hrgn:=CreateEllipticRgn(0, 0,width, height); SetWindowRgn(Handle,hrgn, True); end; procedure TMixerKnob.CreateWnd; begin inherited; setregion; end; procedure TMixerKnob._setposition(p : integer); begin if p>fmax then p:=fmax; fposition:=p; setangles; end; procedure TMixerKnob._setmax(m : integer); begin lastposition:=0; fmax:=m; setangles; end; procedure TMixerKnob.angledraw(startangle,endangle : integer;startrad : integer;endrad : integer); var x,y,d,n : real; originx, originy : real; begin if fbitmap=nil then exit; originx:=width div 2; originy:=height div 2; d:=startrad; while (d<=endrad) do begin n:=startangle; while n<endangle do begin n:=n+0.25; x:=d*(cos(degtorad(n-90)))+originx; y:=d*(sin(degtorad(n-90)))+originy; vcanv.canvas.pixels[round(x),round(y)]:=fbitmap.canvas.pixels[round(x),round(y)]; end; d:=d+1; end; end; procedure TMixerKnob.setangles; begin paint; end; procedure TMixerKnob.Paint; var tr : trect; angle : integer; pos : integer; begin inherited; tr.Top:=0; tr.Left:=0; tr.Right:=width; tr.Bottom:=height; tr.Top:=0; tr.Left:=0; tr.Right:=width; tr.Bottom:=height; //if position>0 then angle:=round(((360 / fmax)*position)); //else angle:=0; if angle<>lastposition then begin; pos:=0; end else pos:=lastposition; vcanv.canvas.stretchdraw(tr,fbwbitmap); if angle=0 then vcanv.canvas.stretchdraw(tr,fbwbitmap); //if angle=lastposition then exit; lastposition:=angle; if position>=0 then angledraw(fstartpos,angle+fstartpos,fstartradius,fradius) else begin angledraw(angle+fstartpos,fstartpos,fstartradius,fradius); end; canvas.draw(0,0,vcanv); vcanv.canvas.brush.color:=clblack; vcanv.canvas.font.color:={viewgit}{/viewgit}00C6F7; vcanv.Canvas.font.Name:='Arial'; vcanv.canvas.font.size:=9; vcanv.Canvas.textout((width div 2) - (vcanv.canvas.textwidth(inttostr(position)) div 2), (height div 2) - (vcanv.canvas.textheight(inttostr(position)) div 2), inttostr(position)); vcanv.canvas.pen.color:={viewgit}{/viewgit}00C6F7; vcanv.canvas.pen.width:=4; vcanv.canvas.brush.style:=bsClear; vcanv.canvas.Ellipse(0,0,width-1,height-1); canvas.draw(0,0,vcanv); end; function ConvertBitmapToGrayscale(Bitmap: TBitmap; brightness : real): TBitmap; var i, j: Integer; Grayshade, Red, Green, Blue: byte; PixelColor: Longint; begin with Bitmap do for i := 0 to Width - 1 do for j := 0 to Height - 1 do begin PixelColor := ColorToRGB(Canvas.Pixels[i, j]); Red := byte(PixelColor); Green := byte(PixelColor shr 8); Blue := byte(PixelColor shr 16); //.3 .6 .1 Grayshade := Round((0.1*brightness) * Red + (0.1*brightness) * Green + (0.1*brightness)* Blue); Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade); end; Result := Bitmap; end; procedure TMixerKnob.assignbackground(_bitmap : tbitmap); var tr : trect; begin if fbitmap=nil then fbitmap:=tbitmap.create; if fbwbitmap=nil then fbwbitmap:=tbitmap.create; //fbitmap.assign(_bitmap); tr.Top:=0; tr.Left:=0; tr.Right:=width; tr.Bottom:=height; fbitmap.width:=width; fbitmap.height:=height; fbitmap.canvas.stretchdraw(tr,_bitmap); fbwbitmap.width:=width; fbwbitmap.height:=height; fbwbitmap.canvas.stretchdraw(tr,_bitmap); //fbitmap.assign(_bitmap); fbwbitmap.assign(ConvertBitmapToGrayscale(fbwbitmap,brightness)); invalidate; end; procedure TMixerKnob.ShowControl(AControl: TControl); begin inherited; if not (csDesigning in ComponentState ) then setregion; end; procedure Register; begin RegisterComponents('Samples', [TMixerKnob]); end; procedure TMixerPotWatcher.Potchanged1(var Message: tmessage); begin volumecallback(message.lparamlo,0); treblecallback(message.lparamhi,1); end; procedure TMixerPotWatcher.Potchanged2(var Message: tmessage); begin basscallback(message.lparamlo,2); end; procedure TMixerPotWatcher.init (v,t,b : Tknobchanged); var err : dword; ji : tjoyinfo; begin err:=joygetpos(0,@ji); //if err<>0 then beep; err:=joySetCapture(self.Handle,0,100,true); //if err<>0 then beep; err:=joySetThreshold(0,30); //if err<>0 then beep; err:=joygetpos(1,@ji); //if err<>0 then beep; err:=joySetCapture(self.Handle,1,100,true); //if err<>0 then beep; err:=joySetThreshold(1,30); //if err<>0 then beep; volumecallback:=v; treblecallback:=t; basscallback:=b; end; constructor TMixerPotWatcher.Create(AOwner : Tcomponent); begin inherited; Parent:=(Owner As TWinControl); end; destructor TMixerPotWatcher.Destroy; begin joyreleasecapture(0); joyreleasecapture(1); inherited; end; end.