TApplication

Code:

>> Замена штатного Application.ProcessMessages

Хорошо использовать в DLL или бесформенных приложениях,

если внутри цикла возникает необходимость в использовании Application.ProcessMessages.

Зависимости: Windows, Messages

Автор:       ssk,

Copyright:   составлено из кусков кода Borland

***************************************************** }

procedure ProcessMessagesEx;

function IsKeyMsg(var Msg: TMsg): Boolean;

const

   CN_BASE = $BC00;

var

   Wnd: HWND;

begin

   Result := False;

   with Msg do

     if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then

       begin

         Wnd := GetCapture;

         if Wnd = 0 then

           begin

             Wnd := HWnd;

             if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then

               Result := True;

           end

             else

               if (LongWord(GetWindowLong(Wnd, GWL_HINSTANCE)) = HInstance) then

                 if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then

                   Result := True;

       end;

end;

function ProcessMessage(var Msg: TMsg): Boolean;

begin

   Result := False;

   if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

     begin

       Result := True;

       if Msg.Message <> WM_QUIT then

         if not IsKeyMsg(Msg) then

           begin

             TranslateMessage(Msg);

             DispatchMessage(Msg);

           end;

     end;

end;

var

Msg: TMsg;

begin

while ProcessMessage(Msg) do {loop};

end;