Looping without causing app to freeze

问题

I would like to write a loop that checks the value of a variable has changed. There's no event that fires to tell me the value has changed. The application doesn't support multi threading. How to achieve this without causing app to freeze ?

The aim is this:

Application starts
...
loop
  Check variable value
  If changed then
    exit
  if timedOut then 
    exit

While loop causes application to freeze.

Thank you.

* Edit * This is what I'm after (this code is written by Remy Lebeau):

const
  APPWM_COM_EVENT_DONE = WM_APP + 1;
  APPWM_COM_EVENT_TIMEOUT = WM_APP + 2;

type
  MyClass = class
  private
  MsgWnd: HWND;
  procedure COMEventHandler(parameters);
  procedure WndProc(var Message: TMessage);
public
  constructor Create;
  destructor Destroy; override;
  procedure DoIt;
end;

constructor MyClass.Create;
begin
  inherited;
  MsgWnd := AllocateHWnd(WndProc);
end

destructor MyClass.Destroy;
begin
   KillTimer(MsgWnd, 1);
   DeallocateHWnd(MsgWnd);
   inherited;
end;

procedure MyClass.COMEventHandler(parameters);
begin
  KillTimer(MsgWnd, 1);
  PostMessage(MsgWnd, APPWM_COM_EVENT_DONE, 0, 0);
end;

procedure MyTimer(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime:   DWORD); stdcall;
begin
  KillTimer(hWnd, idEvent);
  PostMessage(hWnd, APPWM_COM_EVENT_TIMEOUT, 0, 0);
end;

procedure MyClass.WndProc(var Message: TMessage);
begin
  case Message.Msg of
   APPWM_COM_EVENT_DONE:
   begin
      // Event fired, all good
    end;

    APPWM_COM_EVENT_TIMEOUT:
    begin
      // Event timed out
    end;

  else
  begin
    Message.Result := DefWindowProc(MsgWnd, Message.Msg, Message.WParam, Message.LParam);
   end;
 end;
end;

procedure MyClass.DoIt;
begin
  SetTimer(MsgWnd, 1, 1000 * 1000, @MyTimer);
  // invoke COM function that will eventually trigger the COM event...
 end;

How to call DoIt and wait for either Event to fire or timeout without causing the application to freeze ? Tried using while do loop but that prevented WndProc from running. Thank you

回答1:

Answer depends on your application demands. There are 2 easy solutions with prons and cons each: 1. Put Timer to application and check value by timeout. Dignity - it is the most easy way for GUI application (Windows messages loop already exists), drawback on other side - there will be delta time of detecting value have been changed. 2. Handle Application.OnIdle event. Disadvantage of this approach - yor checking procedure will be runned if nobody click on GUI elements.

Professional way to solve your solution - wrap your variable by complex object, for example:

Trigger = class
private
  FOnChanged: TNotifyEvent;
public
  procedure Emit;
  property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;


procedure Trigger.Emit;
  if Assined(FOnChanged) then 
    FOnChanged(Self)
end;

Cause of your application has not threads we can implement Trigger without mutexes/critical sections, on another side you can handle changing as soon as event producer will raise Emit

Good approach if you don't want use multithreading is split your ligic on multiple state machines based on coroutines.

Example based on AIO framework https://github.com/Purik/AIO

AIO framework create itself events loop, scheduling multiple state machines in parallel without threads:

program TriggerExample;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  SyncObjs,
  Gevent,
  Greenlets;

const
  WAIT_TMEOUT_MSEC = 1000;

var
  ChangedEvent: TGevent;
  Value: Boolean = False;


// Part of application that raise change events randomly
procedure EventsProducer;
begin
  while True do
  begin
    Greenlets.GreenSleep(100+Random(10000));
    Value := True;
    ChangedEvent.SetEvent;
  end;
end;


begin

  ChangedEvent := TGevent.Create(False, False);
  // run fake event producer inside other state machine
  TSymmetric.Spawn(EventsProducer);

  // Loop
  while True do
  begin
    if ChangedEvent.WaitFor(WAIT_TMEOUT_MSEC) = wrSignaled then
    begin
      WriteLn('Value was changed');
      Value := False
    end
    else
    begin
      WriteLn('Exit by timeout');
    end;

  end;

end.

来源：https://stackoverflow.com/questions/51360867/looping-without-causing-app-to-freeze

标签

Delphi

while-loop

freeze