program Volume;
{Ein wirklich wohlberlegter Steller! 16bit, fr Windows 3, COVOX+SB16}
{$A+,B-,G+,K+}
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D Lautst„rke-Steller}
{$R volume}
uses WinProcs,WinTypes,Win31,MMSystem;
const
{Rechtecke fr PtInRect()}
R_SysMenu: TRect= (left: 0;top: 0;right:13;bottom:13);
R_Reduce: TRect= (left:50;top:50;right:64;bottom:64);
R_TopText: TRect= (left:16;top: 2;right:62;bottom:13);
R_BottomText: TRect= (left: 2;top:51;right:47;bottom:62);
{Konstanten fr Windows 3.1 (unerheblich fr Windows95)}
IconOffset=14;
{IcongrӇe 36, nicht 32, gibt Versatz von 14!}
FrameSize=1;
BitmapSize=64;
WindowSize=BitmapSize+2*FrameSize;
BorderMute=38;
BorderOver=88;
{64x64, dazu 2x Fensterrahmen; FEST FšR Windows 3.1 und VGA/Herkules}
HelpFileName='LPTDAC.HLP';
ReadMeExName='NOTEPAD LPTDAC.TXT';
{Startwerte}
IcoShift: Integer=0;
OtherFlags: Integer=0;
OF_Active=1;
OF_Mute=2;
OF_Over=4;
HookChar: Char='V';
{weiterer Schalter: "Auto-UnMute" beim Bewegen des Schiebers?}
{Sp„ter: merken in WIN.INI: Position des Fensters, der Lautst„rke?,
des Vordergrund-Status'}
MasterVol: Integer=-1; {AUX-Kanal zur Lautst„rke-Steuerung}
type
Tkeycode=record
rept: Integer;
scan: Byte;
flgs: Byte;
end;
LongRec=record
lo,hi: Word;
end;
function LimitI(I:Integer):Integer;
begin
if I<-16 then I:=-16;
if I>16 then I:=16;
LimitI:=I;
end;
function ShiftFromPoint(P:TPoint):Integer;
begin
ShiftFromPoint:=LimitI((P.x-P.y) div 2);
end;
procedure FindMasterVol;
var
AVol: LongRec;
AC: TAuxCaps;
I,K: Integer;
begin
for I:=0 to Integer(auxGetNumDevs)-1 do begin
auxGetDevCaps(I,@AC,sizeof(AC));
if AC.dwSupport and AUXCAPS_Volume <>0 then begin
for K:=0 to lstrlen(AC.szPName)-6 do begin
if lstrcmpi(AC.szPName+K,'Master')=0 then begin
MasterVol:=I; {gefunden!}
auxGetVolume(I,@AVol);
IcoShift:=Integer(AVol.Lo shr 11)-16;
if AVol.Lo=$FFFF then IcoShift:=16;
exit;
end;
end;
end;
end;
end;
procedure OutMasterVol;
var
AVol:LongRec;
begin
if MasterVol<>-1 then begin
AVol.Lo:=0;
if OtherFlags and OF_Mute =0
then begin
AVol.Lo:=Word(IcoShift+16) shl 11;
if IcoShift=16 then AVol.Lo:=$FFFF;
end;
AVol.Hi:=AVol.Lo;
auxSetVolume(MasterVol,LongInt(AVol));
end;
end;
function AboutProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
begin
AboutProc:=false;
case Msg of
WM_InitDialog: AboutProc:=true;
WM_Command: case wParam of
ID_OK,ID_Cancel: EndDialog(Wnd,0);
9: if WinHelp(GetParent(Wnd),HelpFileName,HELP_Context,200)
then EndDialog(Wnd,0);
10: if WinExec(ReadMeExName,SW_Show)>=32
then EndDialog(Wnd,0);
end;
end;
end;
var
{Statische Variablen fr die Laufzeit des Hauptfensters}
oldbm: HBitmap;
oldf: HFont;
oldc: TColorRef;
MemDC: HDC; {Persistenter Bitmap-DC, folgende Eigenschaften:
* Gesetzte 64x64-Bitmap, * Small Font, *Hintergrundfarbe grau}
icons: array[1..8] of HIcon;
{1: Antwort auf QueryDragIcon, 2..5: Hintergrundbild, 6: Thumb (Steller)
7: aktive MUTE-Anzeige, 8=aktive šberlauf-Anzeige}
StrTitle: array[0..9]of Char;
function WindowProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt;
export;
var
pt: TPoint absolute lParam;
keycode: Tkeycode absolute lParam;
lPar: LongRec absolute lParam;
PS: TPaintStruct; {32 Bytes}
S: array[0..sizeof(PS)-1] of Char absolute PS;
WP: TWindowPlacement absolute PS;
R1: TRect; {zum Aufheben von WindowPlacement}
CallDef: Boolean; {DefWindowProc() rufen?}
I: Integer;
W: Word;
ADC: HDC absolute W; {Flchtiger DC}
procedure NewbmDisp(Change:Integer);
{Bit 0: neue Schieberstellung, Bit1: neue MUTE-Stellung, Bit2: OVL ge„ndert,
Bit 3: Activate ge„ndert --> Bit 4..10: Neue Icons 2..8;
Bit 11: Neuer Text oben; Bit 12: Neuer Text unten; Bit 13: WindowText}
var
S: array[0..19]of Char; {Fenstertext u.„.}
Zahl: array[0..9]of Char; {enth„lt Zahl mit Vorzeichen und Komma}
TwoSP: record
titel,zahl:PChar;
end;
I: Integer; {String-L„nge}
oobk: TColorRef;
oota: Word absolute oobk;
begin
{Ver„nderungs-Bits setzen}
if Change and 1 <>0 then Change:=Change or $3FF0; {alles!}
if Change and 2 <>0 then begin
if OtherFlags and OF_Mute <>0
then Change:=Change or $3300 {hellgrne Fl„che, TextU und Th.}
else Change:=Change or $3110; {dunkelgrne Fl„che, TextU und Thumb}
end;
if Change and 4 <>0 then begin
if OtherFlags and OF_Over <>0
then Change:=Change or $0400 {hellrote Fl„che}
else Change:=Change or $0180; {graue Fl„che und Thumb}
end;
if Change and 8 <>0 then Change:=Change or $0900; {TextO und Thumb}
if Change and $0010 <>0 then DrawIcon(MemDC,0,0,Icons[2]);
if Change and $0020 <>0 then DrawIcon(MemDC,32,0,Icons[3]);
if Change and $0040 <>0 then DrawIcon(MemDC,0,32,Icons[4]);
if Change and $0080 <>0 then DrawIcon(MemDC,32,32,Icons[5]);
TwoSP.titel:=@StrTitle;
TwoSP.zahl:=@Zahl;
I:=IcoShift div 2 * 3;
lstrcpy(S,'+%d.0');
if IcoShift<0 then begin {weil das dusselige wvsprintf() kein %+d kann}
S[0]:='-';
I:=-I;
end;
if IcoShift=0 then S[0]:=#177; {Plusminus}
if Odd(IcoShift) then begin
Inc(I);
S[4]:='5'; {Floatpoint-von-Hand!}
end;
wvsprintf(Zahl,S,I);
I:=wvsprintf(S,'%s dB',TwoSP.zahl);
if OtherFlags and OF_Mute <>0 then begin
lStrCpy(S,'(Mute)');
I:=6;
if Change and $0200 <>0 then DrawIcon(MemDC,0,0,Icons[7]);
end;
if OtherFlags and OF_Over <>0 then begin
if Change and $0400 <>0 then DrawIcon(MemDC,32,32,Icons[8]);
end;
if Change and $0800 <>0 then begin {TextO}
if OtherFlags and OF_Active <>0 then oobk:=SetBkColor(MemDC,$00808000);
ExtTextOut(MemDC,R_TopText.Left+2,R_TopText.Top-1,
ETO_Clipped or ETO_Opaque,@R_TopText,
TwoSP.titel,lstrlen(TwoSP.titel),nil);
if OtherFlags and OF_Active <>0 then SetBkColor(MemDC,oobk);
end;
if Change and $1000 <>0 then begin {TextU}
oota:=SetTextAlign(MemDC,TA_Right);
ExtTextOut(MemDC,R_BottomText.Right-2,R_BottomText.Top-1,
ETO_Clipped or ETO_Opaque,@R_BottomText,S,I,nil);
SetTextAlign(MemDC,oota);
end;
if Change and $6000 =$2000 then begin
if OtherFlags and OF_Mute <>0
then wvsprintf(S,'%s (Mute)',TwoSP)
else wvsprintf(S,'%s (%sdB)',TwoSP);
SetWindowText(Wnd,S);
end;
if Change and $0100 <>0 then DrawIcon(MemDC,
16+IcoShift,16-IcoShift,Icons[6]);
InvalidateRect(Wnd,nil,false); {Fenster per WM_Paint malen lassen}
end;
procedure SetIcoShift(I:Integer; fRedraw:Boolean);
begin
if I<>IcoShift then begin
IcoShift:=I; {setzen}
OutMasterVol;
NewbmDisp(1);
if fRedraw then UpdateWindow(Wnd);
end;
end;
procedure NewShift(P:TPoint);
begin
SetIcoShift(ShiftFromPoint(P),true);
end;
function TrackMouse(R:PRect; Flags:Word):Boolean;
{R wird invertiert, solange Maus innerhalb..., Flag-Bits:
0: rechte Maustaste, 1: LS-Regler mitlaufen lassen, 2: bei ButtonUp
Fenster (wieder) zum Icon machen, 3: beim Ikonisieren Aktivierung
NICHT abgeben}
var
Msg:TMsg;
Pressed:Boolean;
procedure FlipRect;
var
DC: HDC;
begin
DC:=GetDC(Wnd);
InvertRect(DC,R^);
ReleaseDC(Wnd,DC);
end;
begin
Pressed:=true;
if R<>nil then FlipRect;
SetCapture(Wnd);
repeat
if PeekMessage(Msg,0,WM_MouseFirst,WM_MouseLast,PM_Remove) then begin
case Msg.message of
WM_LButtonUp: if Flags and 1 =0 then break; {raus! (L)}
WM_RButtonUp: if Flags and 1 <>0 then break; {raus! (R)}
WM_MouseMove: begin
if Flags and 2 <>0 then NewShift(TPoint(Msg.lParam));
if R<>nil then begin
if PtInRect(R^,TPoint(Msg.lParam)) xor Pressed then begin
FlipRect;
Pressed:=not Pressed;
end;
end;
end;
end;
end;
until false;
ReleaseCapture;
if Pressed and (R<>nil) then FlipRect; {Rechteck zurck!}
if R<>nil then TrackMouse:=PtInRect(R^,TPoint(Msg.lParam));
if Flags and 4 <>0 then begin
WP.showCmd:=SW_Minimize;
if Flags and 8 <>0 then WP.showCmd:=SW_ShowMinNoActive;
ShowWindow(Wnd,WP.showCmd); {Steuerung wieder abgeben!}
{SetWindowPlacement wrde ohne dieses ShowWindow das Fenster
erst restaurieren... komisch manchmal, das Windows}
WP.rcNormalPosition:=R1; {alte (Non-Popup-)Position wiederherstellen}
WP.Flags:=WPF_SetMinPosition; {keine neue Pos. berechnen lassen!}
SetWindowPlacement(Wnd,@WP);
end;
end;
function MouseTrack(param:Integer):Boolean;
{Routine "teilt" Client-Bereich in drei 45ø-schr„g abgegrenzte Sektoren
ein, in der verschiedene Aktionen laufen. Bei param=0 erfolgt keine
Aktion im Mittelsektor, sondern die Funktion beschr„nkt sich auf Rckgabe
von TRUE. Der Sektor rechs unten soll sp„ter die Aboutbox oder Hilfe
zur Anzeige bringen.}
begin
MouseTrack:=false;
if pt.x+pt.y<BorderMute then begin
OtherFlags:=OtherFlags xor OF_Mute;
OutMasterVol;
NewBmDisp(2);
end else if pt.x+pt.y>BorderOver then begin
OtherFlags:=OtherFlags xor OF_Over;
NewBmDisp(4);
end else if param<>0 then begin
NewShift(Pt);
TrackMouse(nil,param);
end else MouseTrack:=true;
end;
begin
WindowProc:=0;
CallDef:=false;
case Msg of
WM_Create: begin
{Strings und Men vorbereiten, Resourcen laden}
LoadString(Seg(HInstance),1,StrTitle,sizeof(StrTitle));
W:=GetSystemMenu(Wnd,false);
DeleteMenu(W,SC_Size,0);
DeleteMenu(W,SC_Zoom,0);
LoadString(Seg(HInstance),22,S,sizeof(S));
InsertMenu(W,0,MF_ByPosition,22,S);
LoadString(Seg(HInstance),23,S,sizeof(S));
InsertMenu(W,1,MF_ByPosition,23,S);
for I:=1 to 8 do
Icons[I]:=LoadIcon(Seg(HInstance),MakeIntResource(I));
{MemDC erstellen und mit geeigneten Vorgaben belegen}
ADC:=GetDC(Wnd);
MemDC:=CreateCompatibleDC(ADC);
oldbm:=SelectObject(MemDC,CreateCompatibleBitmap(ADC,
BitmapSize,BitmapSize));
oldf:=SelectObject(MemDC,CreateFont(8,0,0,0,0,0,0,0,0,0,
0,0,0,'MS Sans Serif'));
oldc:=SetBkColor(MemDC,$00C0C0C0);
ReleaseDC(Wnd,ADC);
NewbmDisp(1); {Bitmap komplett erstellen}
end;
WM_NCHitTest: begin
ScreenToClient(Wnd,Pt);
if PtInRect(R_SysMenu,Pt) then WindowProc:=HTSysMenu
else if PtInRect(R_Reduce,Pt) then WindowProc:=HTReduce
else if PtInRect(R_TopText,Pt) then WindowProc:=HTCaption
else WindowProc:=HTClient;
end;
WM_Paint: begin
GetClientRect(Wnd,R1); {32-36/2=32-18=14}
R1.left:=(BitmapSize-R1.right) div 2; {Zentrieren}
R1.top:=(BitmapSize-R1.bottom) div 2;
BeginPaint(Wnd,PS);
BitBlt(ps.hdc,0,0,R1.right,R1.bottom,MemDC,R1.left,R1.top,SrcCopy);
EndPaint(Wnd,PS);
end;
WM_QueryDragIcon: begin
WindowProc:=Icons[1];
end;
WM_Activate: begin
OtherFlags:=OtherFlags and not OF_Active;
if wParam<>0 then OtherFlags:=OtherFlags or OF_Active;
NewBmDisp(8);
end;
WM_MouseActivate: begin
if (lPar.Hi=WM_RButtonDown) and IsIconic(Wnd)
then WindowProc:=MA_NoActivate
else CallDef:=true;
end;
WM_LButtonDown: MouseTrack(2);
WM_RButtonDown: if not IsIconic(Wnd) then MouseTrack(3);
{ohne den Test: Probleme bei ge”ffnetem Systemmen!!}
WM_SysKeyDown,WM_KeyDown: begin
if keycode.flgs and $20 =0 then begin
{nur ohne ALT-Taste arbeiten!}
I:=0;
case wParam of {Virtuelle Tastencodes prfen}
VK_Space: begin {schaltet MUTE}
OtherFlags:=OtherFlags xor OF_Mute;
OutMasterVol;
NewBmDisp(2);
end;
VK_Escape: ShowWindow(Wnd,SW_Minimize); {Fenster zum Icon und zurck}
VK_Tab: if IsIconic(Wnd) then ShowWindow(Wnd,SW_ShowNoActivate)
else ShowWindow(Wnd,SW_ShowMinNoActive);
VK_Left,VK_Down: I:=-1; {1.5dB 'runter}
VK_Right,VK_Up: I:=1; {1.5dB 'rauf}
VK_Next: I:=-4; {6dB 'runter}
VK_Prior: I:=4; {6dB 'rauf}
end;
if I<>0 then begin
I:=LimitI(IcoShift+I*keycode.rept); {Wiederholungen und alte Pos.'drauf}
SetIcoShift(I,false);
end;
end;
CallDef:=true; {Alten Handler rufen}
end;
WM_SysChar: begin
{Klingeln bei SPC (ohne ALT) verhindern}
if (wParam<>VK_Space) and (wParam<>VK_Tab)
or (keycode.flgs and $20 <>0)
then CallDef:=true;
end;
WM_InitMenuPopup: if lPar.Hi<>0 then begin {Systemmen-Init}
lPar.Lo:=MF_Unchecked;
if GetWindowLong(Wnd,GWL_ExStyle) and WS_EX_TopMost <>0
then lPar.Lo:=MF_Checked;
CheckMenuItem(wParam,22,lPar.Lo);
end;
WM_SysCommand: case wParam of
22: begin
lPar.Hi:=HWND_NoTopmost;
if GetWindowLong(Wnd,GWL_ExStyle) and WS_EX_TopMost =0
then lPar.Hi:=HWND_Topmost;
SetWindowPos(Wnd,lPar.Hi,0,0,0,0,SWP_NoMove or SWP_NoSize);
end;
23: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@AboutProc);
else CallDef:=true;
end;
WM_NCLButtonDown: begin
if not IsIconic(Wnd) then begin
case wParam of
HTReduce: begin
if TrackMouse(@R_Reduce,0)
then SendMessage(Wnd,WM_SysCommand,SC_Minimize,lParam);
end
else CallDef:=true;
end;
end else CallDef:=true;
end;
WM_NCRButtonDown, WM_NCRButtonDblClk: begin
{Unter Windows95 máte, da das Icon im SysTray so piepslich ist (und am
Bildschirmrand klebt), der Mauszeiger zum groáen Fenster bewegt werden.
(Die Funktion, deren Name mir permanent entf„llt, hieá unter X so sch”n:
XWarpPointer(); hier heiát sie SetCursorPos())}
if IsIconic(Wnd) then begin
ScreenToClient(Wnd,Pt); {zum Client-Bereich...}
Inc(Pt.X,IconOffset); {zum Bitmap-Bereich umrechnen}
Inc(Pt.Y,IconOffset);
if MouseTrack(0) then begin
{Mute und Over sofort erledigen! -2 wegen Fensterrand}
WP.length:=sizeof(WP);
GetWindowPlacement(Wnd,@WP);
I:=7; if Wnd=GetActiveWindow then I:=$F; {wenn es bereis aktiv war}
R1:=WP.rcNormalPosition; {retten zum Wiederherstellen}
WP.rcNormalPosition.left:=WP.ptMinPosition.X-IconOffset-FrameSize;
WP.rcNormalPosition.top:=WP.ptMinPosition.Y-IconOffset-FrameSize;
WP.rcNormalPosition.right:=WP.rcNormalPosition.left+WindowSize;
WP.rcNormalPosition.bottom:=WP.rcNormalPosition.top+WindowSize;
WP.showCmd:=SW_ShowNoActivate;
SetWindowPlacement(Wnd,@WP); {SWP verarbeitet auch ShowCmd}
{GetWindowPlacement() liefert keine Info ob Fenster aktiv oder nicht!}
UpdateWindow(Wnd);
NewShift(Pt);
{wrde auch bei fehlender Koordinatentransformation nicht falsch rechnen!}
TrackMouse(nil,I);
end;
end;
end;
WM_Destroy: begin
{MemDC aufr„umen, geladene Ressourcen l”schen, Hilfe schlieáen und Ende}
SetBkColor(MemDC,oldc);
DeleteObject(SelectObject(MemDC,oldf));
DeleteObject(SelectObject(MemDC,oldbm));
DeleteDC(MemDC);
for I:=1 to 8 do DestroyIcon(Icons[I]);
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
PostQuitMessage(0);
end;
else CallDef:=true;
end;
if CallDef then WindowProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;
var
Hook: HHook;
gWndVol: HWnd;
function HookProc(code:Integer; wParam:Word; lParam:LongInt):LongInt; far;
var
keycode: TKeyCode absolute lParam;
begin
asm push ds; push si; push di; mov ax,seg @data; mov ds,ax end;
if (wParam=Word(HookChar)) {Taste OK?}
and (keycode.flgs and $20 <>0) {ALT gedrckt?}
and (GetKeyState(VK_Control)<>0) {CONTROL gedrckt?}
then begin
HookProc:=LongInt(SendMessage(gWndVol,WM_SysCommand,SC_Restore,0){ShowWindow(gWndVol,SW_Restore)});
SetFocus(gWndVol);
end else HookProc:=CallNextHookEx(Hook,code,wParam,lParam);
asm pop di; pop si; pop ds end;
end;
const
wc:TWndClass=(
style: CS_ByteAlignClient or CS_SaveBits;
lpfnWndProc: @WindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackGround:0;
lpszMenuName: nil;
lpszClassName:'LS');
var
Msg: TMsg;
begin
if HPrevInst<>0 then begin
ShowWindow(FindWindow('LS',nil),SW_Restore);
exit;
end;
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
FindMasterVol;
Hook:=SetWindowsHookEx(WH_Keyboard,HookProc,Hinstance,0);
gWndVol:=CreateWindow('LS','',
WS_PopupWindow or WS_MinimizeBox or WS_Visible,
32,100,WindowSize,WindowSize,
0,0,Seg(HInstance),nil);
ShowWindow(gWndVol,CmdShow);
while GetMessage(Msg,0,0,0) do begin
TranslateMessage(Msg); {sonst geht kein ALT+SPC}
DispatchMessage(Msg);
end;
UnhookWindowsHookEx(Hook);
end.
| Detected encoding: UTF-8 | 0
|