unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj,
ActiveX, MMDeviceApi, ComCtrls, ExtCtrls, IniFiles;
const
CLSID_TaskbarList: TGUID = '{56fdf344-fd6d-11d0-958a-006097c9a090}';
IID_ITaskbarList: TGUID = '{56FDF342-FD6D-11d0-958A-006097C9A090}';
IID_ITaskbarList2: TGUID = '{602D4995-B13A-429b-A66E-1935E44F4317}';
IID_ITaskbarList3: TGUID = '{ea1afb91-9e28-4b86-90e9-9e9f8a5eefaf}';
type
TBPF = (TBPF_NOPROGRESS = 0,
TBPF_INDETERMINATE = 1,
TBPF_NORMAL = 2,
TBPF_ERROR = 4,
TBPF_PAUSED = 8);
TBATF = (TBATF_USEMDITHUMBNAIL = 1,
TBATF_USEMDILIVEPREVIEW = 2);
ITaskbarList = interface(IUnknown)
['{56FDF342-FD6D-11d0-958A-006097C9A090}']
function HrInit : HResult; stdcall;
function AddTab(hWndOwner : HWND) : HResult; stdcall;
function DeleteTab(hWndOwner : HWND) : HResult; stdcall;
function ActivateTab(hWndOwner : HWND) : HResult; stdcall;
function SetActiveAlt(hWndOwner : HWND) : HResult; stdcall;
end; { ITaskbarList }
ITaskbarList2 = interface(ITaskbarList)
['{602D4995-B13A-429b-A66E-1935E44F4317}']
function MarkFullscreenWindow(wnd : HWND; fFullscreen : bool) : HResult; stdcall;
end;
ITaskbarList3 = interface (ITaskbarList2)
['{ea1afb91-9e28-4b86-90e9-9e9f8a5eefaf}']
function SetProgressValue (hWnd: HWND; ullCompleted: int64; ullTotal: int64): HResult; stdcall;
function SetProgressState (hWnd: HWND; tbpFlags: TBPF): HResult; stdcall;
function RegisterTab (hwndTab: HWND; hwndMDI: HWND): HResult; stdcall;
function UnregisterTab (hwndTab: HWND): HResult; stdcall;
function SetTabOrder (hwndTab: HWND; hwndInsertBefore: HWND): HResult; stdcall;
function SetTabActive (hwndTab: HWND; hwndMDI: HWND; tbatFlags: TBATF): HResult; stdcall;
function ThumbBarAddButtons (hWnd: HWND; cButtons: integer; pButtons: pointer): HResult; stdcall;
function ThumbBarUpdateButtons (hWnd: HWND; cButtons: cardinal; pButtons: pointer): HResult; stdcall;
function ThumbBarSetImageList (hWnd: HWND; himl: pointer): HResult; stdcall;
function SetOverlayIcon (hWnd: HWND; hIcon: HICON; pszDescription: PWideChar): HResult; stdcall;
function SetThumbnailTooltip (hWnd: HWND; pszTip: PWideChar): HResult; stdcall;
function SetThumbnailClip (hWnd: HWND; prcClip: PRect): HResult; stdcall;
end;
type
TForm1 = class(TForm)
imgRegler1: TImage;
Label1: TLabel;
imgLeft: TImage;
imgRight: TImage;
lbMaster: TLabel;
cbMasterMute: TCheckBox;
lbLeft: TLabel;
lbRight: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Led1: TImage;
Label5: TLabel;
Panel1: TPanel;
WheelLabel: TLabel;
procedure FormCreate(Sender: TObject);
procedure cbMasterMuteClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure SetMasterVolume;
procedure SetChannelsVolume;
procedure SetChannelsFlagVolume;
procedure imgLeftClick(Sender: TObject);
procedure Label5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WheelLabelClick(Sender: TObject);
private
{ Private-Deklarationen }
FTaskBarList : ITaskbarList3;
SetPosition : Boolean;
procedure OnMove(var Msg: TWMMove); message WM_MOVE;
public
{ Public-Deklarationen }
end;
type
TepVolEvents = Procedure(f:byte) of object;
var
Form1: TForm1;
endpointVolume : IAudioEndpointVolume = nil;
deviceEnumerator : IMMDeviceEnumerator;
defaultDevice : IMMDevice;
pProps : IPropertyStore;
epVolEvents : TepVolEvents;
VolumeLevel : Single;
OldVolume : Single;
OldLeft, OldRight : Single;
vLeft, vRight : Single;
wheel : Integer;
reg1, reg2, reg3 : Boolean;
IFile : TIniFile;
ProgDir : String;
PosX, PosY : Integer;
implementation
{$R *.dfm}
function IsMouseOver(Control: TControl): Boolean;
var
p: TPoint;
begin
if GetCursorPos(p) then
begin
p := Control.ScreenToClient(p);
Result := (p.X >= 0) and (p.X = 0) and (p.Y <= Control.Height) {AND Control.Visible};
end
else Result := False;
end;
var
ChannelCnt : Cardinal;
ChannelLeft,ChannelRight : Single;
VolMaster : Single;
VolMute : Bool;
Percent : Integer;
ChannelFlag : Boolean;
procedure TForm1.OnMove(var Msg: TWMMove);
begin
inherited;
if SetPosition then
begin
PosX := Form1.Left;
PosY := Form1.Top;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
begin
SetPosition := False;
ProgDir := ExtractFilePath(ParamStr(0));
IFile := TIniFile.Create(ProgDir + 'mastervolume.ini');
PosX := IFile.ReadInteger('Position', 'Left', 240);
PosY := IFile.ReadInteger('Position', 'Top', 240);
IFile.Free;
FTaskBarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList3;
ChannelFlag := False;
Form1.DoubleBuffered := True;
wheel := 2;
CoCreateInstance(CLASS_IMMDeviceEnumerator, nil, CLSCTX_INPROC_SERVER, IID_IMMDeviceEnumerator, deviceEnumerator);
end;
procedure TForm1.cbMasterMuteClick(Sender: TObject);
begin
if cbMasterMute.Checked then
begin
OldLeft := vLeft;
OldRight := vRight;
if endpointVolume = nil then Exit;
VolumeLevel := 0;
endpointVolume.SetMasterVolumeLevelScalar(VolumeLevel, nil);
FTaskBarList.SetProgressState(Application.handle, TBPF_Indeterminate);
end
else
begin
if endpointVolume = nil then Exit;
if not ChannelFlag then
begin // not ChannelFlag
VolumeLevel := OldVolume;
endpointVolume.SetMasterVolumeLevelScalar(VolumeLevel, nil);
end
else SetChannelsFlagVolume; // ChannelFlag
FormShow(self);
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form1.Left := PosX;
Form1.Top := PosY;
if deviceEnumerator = nil then begin ShowMessage('NIL'); Exit; end;
deviceEnumerator.GetDefaultAudioEndpoint(eRender, eConsole, defaultDevice);
if defaultDevice <> nil then defaultDevice.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, endpointVolume);
endpointVolume.GetChannelCount(ChannelCnt);
endpointVolume.GetMasterVolumeLevelScalar(VolMaster);
VolumeLevel := VolMaster;
imgRegler1.Top := 20 + (200 - Round(VolumeLevel * 200));
endpointVolume.GetChannelVolumeLevelScalar(0,ChannelLeft);
endpointVolume.GetChannelVolumeLevelScalar(1,ChannelRight);
vLeft := ChannelLeft;
vRight := ChannelRight;
endpointVolume.GetMute(VolMute);
if VolMute=True then cbMasterMute.Checked := True else cbMasterMute.Checked := False;
lbMaster.Caption := Format('%1.3f', [VolMaster]);
imgLeft.Top := 20 + (200 - Round(vLeft * 200));
imgRight.Top := 20 + (200 - Round(vRight * 200));
lbLeft.Caption := Format('%1.3f', [vLeft * 1]);
lbRight.Caption := Format('%1.3f', [vRight * 1]);
OldLeft := vLeft;
OldRight := vRight;
if vLeft <> vRight then ChannelFlag := True else ChannelFlag := False;
if lbLeft.Caption <> lbRight.Caption then Led1.Visible := True else Led1.Visible := False;
Percent := Round(VolumeLevel * 100);
// FTaskBarList.SetProgressState(Application.handle, TBPF_Normal);
case Round(VolumeLevel * 1000) of
0 .. 749 : FTaskBarList.SetProgressState(Application.handle, TBPF_Normal);
750 .. 1001 : FTaskBarList.SetProgressState(Application.handle, TBPF_Error);
end; // end case of
FTaskBarList.SetProgressValue(Application.handle, Percent, 100);
SetPosition := True;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
reg1 := ((X > 7) and (X < 53));
reg2 := ((X > 67) and (X < 93));
reg3 := ((X > 103) and (X < 129));
end;
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
if reg1 then
begin
if imgRegler1.Top > 20 then imgRegler1.Top := imgRegler1.Top - wheel;
VolumeLevel := ( (200 - (imgRegler1.Top - 20)) / 200);
SetMasterVolume;
end;
if ((reg2) or (reg3)) then
begin
if reg2 then
if imgLeft.Top > 20 then imgLeft.Top := imgLeft.Top - wheel;
if reg3 then
if imgRight.Top > 20 then imgRight.Top := imgRight.Top - wheel;
vLeft := ( (200 - (imgLeft.Top - 20)) / 200);
vRight := ( (200 - (imgRight.Top - 20)) / 200);
SetChannelsVolume;
end;
end;
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
if reg1 then
begin
if imgRegler1.Top < 220 then imgRegler1.Top := imgRegler1.Top + wheel;
VolumeLevel := ( (200 - (imgRegler1.Top - 20)) / 200);
SetMasterVolume;
end;
if reg2 or reg3 then
begin
if reg2 then
if imgLeft.Top < 220 then imgLeft.Top := imgLeft.Top + wheel;
if reg3 then
if imgRight.Top < 220 then imgRight.Top := imgRight.Top + wheel;
vLeft := ( (200 - (imgLeft.Top - 20)) / 200);
vRight := ( (200 - (imgRight.Top - 20)) / 200);
SetChannelsVolume;
end;
end;
procedure TForm1.SetMasterVolume;
begin
if endpointVolume = nil then Exit;
cbMasterMute.Checked := False;
OldVolume := VolumeLevel;
OldLeft := vLeft;
OldRight := vRight;
endpointVolume.SetMasterVolumeLevelScalar(VolumeLevel, nil);
lbMaster.Caption := Format('%1.3f', [VolumeLevel]);
FormShow(Self);
end;
procedure TForm1.SetChannelsVolume;
begin
if endpointVolume = nil then Exit;
endpointVolume.SetChannelVolumeLevelScalar(0, vLeft, nil);
endpointVolume.SetChannelVolumeLevelScalar(1, vRight, nil);
lbLeft.Caption := Format('%1.3f', [vLeft * 1]);
lbRight.Caption := Format('%1.3f', [vRight * 1]);
SetMasterVolume;
end;
procedure TForm1.SetChannelsFlagVolume;
begin
if endpointVolume = nil then Exit;
endpointVolume.SetChannelVolumeLevelScalar(0, OldLeft, nil);
endpointVolume.SetChannelVolumeLevelScalar(1, OldRight, nil);
lbLeft.Caption := Format('%1.3f', [OldLeft * 1]);
lbRight.Caption := Format('%1.3f', [OldRight * 1]);
//SetMasterVolume;
end;
procedure TForm1.imgLeftClick(Sender: TObject);
begin
vLeft := VolumeLevel;
vRight := VolumeLevel;
SetChannelsVolume;
imgLeft.Top := imgRegler1.Top;
imgRight.Top := imgRegler1.Top;
FormShow(Self);
end;
procedure TForm1.Label5Click(Sender: TObject);
begin
ShowMessage('Copyright : M.Huwert, 2010, markus_huwert@yahoo.de');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
PosX := Form1.Left;
PosY := Form1.Top;
IFile := TIniFile.Create(ProgDir + 'mastervolume.ini');
IFile.WriteInteger('Position', 'Left', PosX);
IFile.WriteInteger('Position', 'Top', PosY);
IFile.Free;
end;
procedure TForm1.WheelLabelClick(Sender: TObject);
begin
if wheel = 4 then wheel := 1
else if wheel = 2 then wheel := 4
else if wheel = 1 then wheel := 2;
WheelLabel.Caption := IntToStr(wheel);
end;
end.