Замена Application.ProcessMessages

Previous  Top  Next

    
 

 

 

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

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

 

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

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

 

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

Автор:       ssk, ucad@pisem.net, ICQ:166758074, Харьков

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

Дата:        7 сентября 2004 г.

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

 

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;

 

 

 

©Drkb::00411

Взято с Vingrad.ru http://forum.vingrad.ru