Всем привет!
Подскажите, как убрать системный звук в WinApi если нажата клавиша ALT?
Пока делаю так:


Толку ноль. Помогает только убрать TranslateMessage из цикла Application.Run.
Подскажите пожалуйста как убрать этот звук?
VCL не используется. Только WinApi.

> dmk ©   (10.02.19 19:45) 

> Толку ноль. Помогает только убрать TranslateMessage из цикла
> Application.Run.

Расскажи, где в WinAPI Application, что нажимается вместе с Alt,
есть ли меню у окна и/или другие ускорители.

И почему не WM_SYSCHAR?

Пока видна только ошибка в 17 строке.

--
Regards, LVT.

Обычное WinApi-окно. VCL вообще не используется.

constructor TRenderForm.Create(Application: TApp64);
var
 W, H: Integer;

begin
 inherited Create;

 FApp := Application;
 FWnd := Self;

 if (not FClassRegistered) then
 begin
   FClassName := ClassName;

   //Заполняем класс
   FWndClassEx.cbSize := SizeOf(FWndClassEx);
   FWndClassEx.style := WS_TILED;
   FWndClassEx.lpfnWndProc := @WndProc;
   FWndClassEx.cbClsExtra := 0;
   FWndClassEx.cbWndExtra := 0;
   FWndClassEx.hInstance := HInstance;
   FWndClassEx.hIcon := LoadIcon(hInstance, PChar(FApp.Name));
   FWndClassEx.hCursor := LoadCursor(HInstance, IDC_ARROW);
   FWndClassEx.hbrBackground := 0;
   FWndClassEx.lpszMenuName := nil;
   FWndClassEx.lpszClassName := PChar(FClassName);
   FWndClassEx.hIconSm := 0;

   //Регистрируем класс
   if (Winapi.Windows.RegisterClassEx(FWndClassEx) <> 0) then FClassRegistered := True else
     raise Exception.Create(Format('TWindow64A: Класс не зарегестрирован. Ошибка: %d',[GetLastError()]));
 end;

 FStyle := WS_TILEDWINDOW;
 FStyleEx := (WS_EX_APPWINDOW); // or WS_EX_TOOLWINDOW or WS_EX_TOPMOST);

 //Размеры рамки окна
 FBX := GetSystemMetrics(SM_CXFRAME);
 FBY := GetSystemMetrics(SM_CYFRAME);

 //Размер: половина разрешения окна
 W := (FApp.ScreenX shr 1);
 H := (FApp.ScreenY shr 1);

 FClientRect.Left := 0;
 FClientRect.Top := 0;
 FClientRect.Width := W;
 FClientRect.Height := H;

 //Расчет окна по желаемой клиентской области
 FWindowRect := RectByClientArea(0, 0, W, H, True);

 //Создаем окно
 with FWindowRect do
   FHandle := Winapi.Windows.CreateWindowEx(FStyleEx, FWndClassEx.lpszClassName,
                                                      FWndClassEx.lpszClassName, FStyle,
                                                      Left, Top, Width, Height, 0, 0, HInstance, nil);
 if (FHandle <> 0) then
 begin
   CreateParams;
   PostMessage(Handle, WM_SHOWWINDOW, NativeUInt(True), 0);
 end
 else raise Exception.Create(Format(ClassName + ': Окно не создано. Ошибка: %d', [GetLastError()]));
end;

destructor TRenderForm.Destroy;
begin
 inherited Destroy;
end;

procedure TRenderForm.Free;
begin
 inherited Free;

 if FClassRegistered then
   FClassRegistered := not Winapi.Windows.UnregisterClass(FWndClassEx.lpszClassName, FWndClassEx.hInstance);

 FWnd := nil;
 FApp := nil;

 PostQuitMessage(0);
end;

procedure TRenderForm.CreateParams;
begin
 //Сброс управляющего слова XMM-регистров по умолчанию
 ResetMXCSR;

 //Переменные
 FParent := GetParent(FHandle);
 FClientDC := GetDC(Handle);
 FWindowDC := GetWindowDC(FHandle);
 FOverlay := False;
 FActive := False;
 FNumMessages := 0;

 //Заголовок
 Caption := FApp.Name;
end;

function TRenderForm.ExcludeStates: Boolean;
begin
 Result := FMouseLook;
end;

class function TRenderForm.WndProc(Wnd: HWND; Msg: NativeInt; WParam: WParam; LParam: LParam): LResult;
var
 LMsg: TMessage;

begin
 LMsg.Msg := Msg;
 LMsg.WParam := WParam;
 LMsg.LParam := LParam;
 LMsg.Result := S_FALSE;

 //Внутренняя обработка сообщений
 if (FWnd <> nil) then FWnd.Process(LMsg);

 //Наследованная обработка сообщений (inherited)
 Result := DefWindowProc(Wnd, LMsg.Msg, LMsg.WParam, LMsg.LParam);
end;


Далее обработка сообщений:
procedure TRenderForm.Process(var Msg: TMessage);
begin
 Msg.Result := S_FALSE;

 case Msg.Msg of

   //-------------------------------------------------------
   // Клавиатурные сообщения (256-265)
   //-------------------------------------------------------

   WM_KEYFIRST..WM_KEYLAST:
   begin
     case Msg.Msg of

     WM_KEYDOWN, WM_SYSKEYDOWN:
     begin
       if Assigned(@FOnKeyDown) then FOnKeyDown(Msg.WParamLo);
       Msg.Result := S_OK;
     end;

     WM_KEYUP, WM_SYSKEYUP:
     begin
       if Assigned(@FOnKeyUp) then FOnKeyUp(Msg.WParamLo);
       Msg.Result := S_OK;
     end;

     WM_SYSCHAR, WM_SYSDEADCHAR: Msg.Result := S_OK;

     end;//case
   end;//WM_KEYFIRST..WM_KEYLAST:

   //-----------------------------------------------------------
   // Сообщения мыши (512-526)
   //-----------------------------------------------------------

   WM_MOUSEFIRST..WM_MOUSELAST:
   begin
     case Msg.Msg of

       WM_LBUTTONDOWN:
       begin
         if Assigned(@FOnMouseDown) then FOnMouseDown(self);
         Msg.Result := S_OK;
       end;

       WM_LBUTTONUP:
       begin
         if Assigned(@FOnMouseUp) then FOnMouseUp(self);
         Msg.Result := S_OK;
       end;

       WM_RBUTTONDOWN:
       begin
         if Assigned(@FOnMouseDown) then FOnMouseDown(self);
         Msg.Result := S_OK;
       end;

       WM_RBUTTONUP:
       begin
         if Assigned(@FOnMouseUp) then FOnMouseUp(self);
         Msg.Result := S_OK;
       end;

       WM_MOUSEWHEEL:
       begin
         if Assigned(@FOnMouseWheel) then FOnMouseWheel(self, Msg.WParam);
         Msg.Result := S_OK;
       end;

       WM_MOUSEMOVE:
       begin
         //Координаты курсора в клиентской области
         FClientMouse.X := Msg.LParamLo;
         FClientMouse.Y := Msg.LParamHi;

         //Экранные координаты курсора
         FMouse := ClientToScreen(FClientMouse);

         //Наследованный вызов
         if Assigned(@FOnMouseMove) then FOnMouseMove(self);

         //Трансляция сообщений
         if Overlay then FControls.MessageToChild(Msg);
         Msg.Result := S_OK;
       end;

     end;//case
   end;//WM_MOUSEFIRST..WM_MOUSELAST:

   //---------------------------------------------------------------
   // Сообщения NonClient-area (129-173)
   //---------------------------------------------------------------

   WM_NCCREATE .. WM_NCXBUTTONDBLCLK:
   begin
     case Msg.Msg of

       WM_NCMOUSELEAVE:
       begin
         Msg.Result := S_OK;
       end;

       WM_NCCALCSIZE:
       begin
         Msg.Result := S_OK;
       end;

       WM_NCPAINT:
       begin
         Msg.Result := S_OK;
       end;

       WM_NCHITTEST:
       begin
         if Overlay then
           FControls.MessageToChild(Msg); //Отправка сообщений контролам TWindow64

         Msg.Result := S_OK;
       end;

     end;//case
   end;//WM_NCCREATE .. WM_NCXBUTTONDBLCLK:

   //---------------------------------------------------
   // Сообщения окну (0-128)
   //---------------------------------------------------

   WM_NULL .. WM_SETICON:
   begin
     case Msg.Msg of

       WM_PAINT: Msg.Result := S_OK; //MSDN: An application returns zero if it processes this message.
       WM_ERASEBKGND: Msg.Result := S_FALSE; //MSDN: An application should return nonzero if it erases the background;

       WM_ACTIVATE:
       begin
         if Msg.WParamLo = (WA_ACTIVE) then FActive := True else
         if Msg.WParamLo = (WA_CLICKACTIVE) then FActive := True else
         if Msg.WParamLo = (WA_INACTIVE) then FActive := False;

         Msg.Result := S_OK;
       end;

       WM_SHOWWINDOW:
       begin
         SetWindow(Boolean(Msg.WParam));
         if Assigned(@FOnShow) then FOnShow;
         Msg.Result := S_OK;
       end;

       WM_GETMINMAXINFO:
       begin
         WMGetMinMaxInfo(TWMGetMinMaxInfo(Msg));
         Msg.Result := S_OK;
       end;

       WM_SIZE:
       begin
         if Assigned(@FOnResize) then FOnResize(self);
         Msg.Result := S_OK;
       end;

       WM_MOVE:
       begin
         UpdateWindowSize;
         Msg.Result := S_OK;
       end;

       WM_SETFOCUS:
       begin
         Msg.Result := S_OK;
       end;

       WM_SETCURSOR:
       begin
         if (not ExcludeStates) then
         begin
           if (Msg.LParamLo <> HTCLIENT) then
             SetCursor(CursorByArea(Msg.LParamLo)) else
             SetCursor(FCursor);
         end;

         Msg.Result := S_OK;
       end;

       WM_DISPLAYCHANGE:
       begin
         Msg.Result := S_OK;
       end;
     end;//case
   end;//WM_NULL .. WM_SETICON:

   //---------------------------------------------------
   // Другие сообщения
   //---------------------------------------------------
   else
   begin
     case Msg.Msg of

       WM_MENUCHAR:
       begin
         //Msg.Result := MakeLResult(0, MNC_CLOSE);
         Msg.Result := S_OK;
       end;

       WM_MENUSELECT:
       begin
         //Msg.LParam := 0;
         //Msg.WParamHi := $FFFF;
         Msg.Result := S_OK;
       end;

       WM_MOVING:
       begin
         if Assigned(@FDoRender) then FOnUpdateWindow;
         Msg.Result := S_OK;
       end;

       WM_RENDER:
       begin
         if Assigned(@FDoRender) then FDoRender;
         Msg.Result := S_OK;
       end;

       WM_PROGRESS:
       begin
         if Assigned(@FOnProgress) then FOnProgress(Msg);
         Msg.Result := S_OK;
       end;

       WM_SYSCOMMAND:
       begin
         FWnd.ProcessSysCommand(Msg.WParam);
         Msg.Result := S_OK;
       end;

       WM_ENTERSIZEMOVE:
       begin
         Caption := MSG_MOVING;
         Msg.Result := S_OK;
       end;

       WM_EXITSIZEMOVE:
       begin
         Caption := MSG_CAPTION;
         Msg.Result := S_OK;
       end;

       WM_CAPTURECHANGED:
       begin
         Msg.Result := S_OK;
       end;

       else
       begin
         if Assigned(@FOnMessage) then
         begin
           if MessageInList(Msg.Msg) then FOnMessage(Msg);
         end;
       end;//else
     end;//else Другие сообщения
   end;//case
 end;//case
end;

Цикл выборки сообщений из очереди:
Свой Application типа :)
procedure TApp64.Run;
var
 AMessage: tagMSG;
 bMessage, bAppDone: Boolean;

begin
 if (FMainForm <> nil) then
 begin
   bAppDone := False;

   while (not bAppDone) do
   begin
     repeat
       bMessage := PeekMessage(AMessage, TRenderForm(FMainForm).Handle, 0, 0, PM_REMOVE);

       if bMessage then
       begin
         TranslateMessage(AMessage);
         DispatchMessage(AMessage);
       end;

       bAppDone := (AMessage.message = WM_QUIT) or (TRenderForm(FMainForm).Handle = 0);

     until (not bMessage) or bAppDone;

     //-----------------------------------
     // Секция OnIdle
     //-----------------------------------

     if (not bAppDone) then
     begin
       TRenderForm(FMainForm).OnIdle;
     end;
   end;//while
 end;//if
end;


В общем если TranslateMessage(AMessage) закомментировать, то все отлично (звука нет),
но есть некоторые сообщения, которые требуют обработки TranslateMessage.
В этом и загвоздка. Оказывается TranslateMessage нужна.

В общем как убрать этот звук или как создать окно чтобы не было системного меню?
К окну без системного меню сообщения не поступают и нажатый ALT никому не портит жизнь :)

> dmk ©   (12.02.19 21:19) [5]

> В общем как убрать этот звук

AFAIK, звук вызывает обработчик по умолчанию при нажатии
некорректного ускорителя/шортката.
Т.е., стратегия такая: убедившись, что нажатие "ненужное"
не вызывать DefWindowProc.

Искать ненужное следует, IMHO, в районе WM_SYSCHAR.

Ну, или создавать окно стиля WS_EX_TOOLWINDOW.

--
Regards, LVT.

У меня раньше такая конструкция работала:
procedure TTestForm.AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
begin
 //Во избежание системного звука
 //считаем стстемные клавиши обработанными
 if (Msg.message = WM_SYSCHAR) then Handled := True;
end;

Но тперь без VCL и в исходниках VCL нашел такое:
VK_MENU: Form.Perform(WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEACCEL), 0);
Это как раз происходит после AppEventsMessage.
А вот обработчика WM_CHANGEUISTATE не нашел пока.

>А вот обработчика WM_CHANGEUISTATE не нашел пока.
Это оказывается TControl посылает сообщение в DefWindowProc.

>Ну, или создавать окно стиля WS_EX_TOOLWINDOW.
К сожалению это не помогает.
Звук все равно присутствует, даже если нет системного меню.

> dmk ©   (13.02.19 14:38) [7]

> У меня раньше такая конструкция работала:

> procedure TTestForm.AppEventsMessage(var Msg: tagMSG; var
> Handled: Boolean);
> begin
>   //Во избежание системного звука
>   //считаем стстемные клавиши обработанными
>   if (Msg.message = WM_SYSCHAR) then Handled := True;
> end;

Ну и вставь себе в WndProc:

if (LMsg.Msg  <> WM_SYSCHAR) then
  Result := DefWindowProc(Wnd, LMsg.Msg, LMsg.WParam, LMsg.LParam);

--
Regards, LVT.

>Leonid Troyanovsky ©   (16.02.19 05:32) [10]
Спасибо! Так работает :)
Я почему то думал, что сообщения пропускать нельзя.

>Это оказывается TControl посылает сообщение в DefWindowProc.
Они хитро сделали. У них переменная, которая перенаправляет на свой обработчик. Они ее адрес подсовывают вместо DefWindowProc в некоторых случаях. Значит также пропускают DefWindowProc.