Конференция "WinAPI" » WM_MENUCHAR и звук при нажатии ALT
 
fsockopen() [function.fsockopen]: php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution sockets.php on line 83
fsockopen() [function.fsockopen]: unable to connect to www.delphimaster.ru:80 (php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution) sockets.php on line 83
php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution (0) sockets.php on line 85
fsockopen() [function.fsockopen]: php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution sockets.php on line 83
fsockopen() [function.fsockopen]: unable to connect to www.delphimaster.ru:80 (php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution) sockets.php on line 83
php_network_getaddresses: getaddrinfo failed: Temporary failure in name resolution (0) sockets.php on line 85
  • dmk © (10.02.19 19:45) [0]
    Всем привет!
    Подскажите, как убрать системный звук в WinApi если нажата клавиша ALT?
    Пока делаю так:

         case Msg.Msg of

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

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


    Толку ноль. Помогает только убрать TranslateMessage из цикла Application.Run.
    Подскажите пожалуйста как убрать этот звук?
    VCL не используется. Только WinApi.
  • Leonid Troyanovsky © (12.02.19 12:14) [1]

    > dmk ©   (10.02.19 19:45) 

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

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

    И почему не WM_SYSCHAR?

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

    --
    Regards, LVT.
  • dmk © (12.02.19 21:13) [2]
    Обычное 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;
  • dmk © (12.02.19 21:13) [3]
    Далее обработка сообщений:
    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;
  • dmk © (12.02.19 21:15) [4]
    Цикл выборки сообщений из очереди:
    Свой 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;
  • dmk © (12.02.19 21:19) [5]
    В общем если TranslateMessage(AMessage) закомментировать, то все отлично (звука нет),
    но есть некоторые сообщения, которые требуют обработки TranslateMessage.
    В этом и загвоздка. Оказывается TranslateMessage нужна.

    В общем как убрать этот звук или как создать окно чтобы не было системного меню?
    К окну без системного меню сообщения не поступают и нажатый ALT никому не портит жизнь :)
  • Leonid Troyanovsky © (13.02.19 10:41) [6]

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

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

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

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

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

    --
    Regards, LVT.
  • 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;


    Но тперь без VCL и в исходниках VCL нашел такое:
    VK_MENU: Form.Perform(WM_CHANGEUISTATE, MakeLong(UIS_CLEAR, UISF_HIDEACCEL), 0);
    Это как раз происходит после AppEventsMessage.
    А вот обработчика WM_CHANGEUISTATE не нашел пока.
  • dmk © (13.02.19 15:46) [8]
    >А вот обработчика WM_CHANGEUISTATE не нашел пока.
    Это оказывается TControl посылает сообщение в DefWindowProc.
  • dmk © (14.02.19 00:20) [9]
    >Ну, или создавать окно стиля WS_EX_TOOLWINDOW.
    К сожалению это не помогает.
    Звук все равно присутствует, даже если нет системного меню.
  • Leonid Troyanovsky © (16.02.19 05:32) [10]

    > 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.
  • dmk © (16.02.19 23:46) [11]
    >Leonid Troyanovsky ©   (16.02.19 05:32) [10]
    Спасибо! Так работает :)
    Я почему то думал, что сообщения пропускать нельзя.
  • dmk © (01.03.19 20:39) [12]
    >Это оказывается TControl посылает сообщение в DefWindowProc.
    Они хитро сделали. У них переменная, которая перенаправляет на свой обработчик. Они ее адрес подсовывают вместо DefWindowProc в некоторых случаях. Значит также пропускают DefWindowProc.
 
Конференция "WinAPI" » WM_MENUCHAR и звук при нажатии ALT
Есть новые Нет новых   [103732   +61][b:0.001][p:0.002]