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.
