[deutsch] [english] PHP version

Source file: /~heha/hs/lptdac.zip[Download]/VOLUME.PAS

Show line numbers
program Volume;
{Ein wirklich wohlüberlegter Steller! 16bit, für 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 für 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 für Windows 3.1 (unerheblich für 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 für 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;		{Flüchtiger 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	{hellgrüne Fläche, TextU und Th.}
    else Change:=Change or $3110;	{dunkelgrüne 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 zurück!}
   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 würde 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 Rückgabe
 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 prüfen}
      VK_Space: begin		{schaltet MUTE}
       OtherFlags:=OtherFlags xor OF_Mute;
       OutMasterVol;
       NewBmDisp(2);
      end;
      VK_Escape: ShowWindow(Wnd,SW_Minimize); {Fenster zum Icon und zurück}
      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);
{würde 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 gedrückt?}
  and (GetKeyState(VK_Control)<>0)	{CONTROL gedrückt?}
  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: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded
Assume file is OEM (CP437) encoded