utils/uutlMessages.pas

unit uutlMessages;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit enthält verschiedene Klassen, die Messages definieren,
                die zwischen utlMessageThreads ausgetauscht werden können }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, syncobjs;

const
  //General
  MSG_CALLBACK                = $00010001;  //TutlCallbackMsg

  MSG_SYNC_CALLBACK           = $00010002;  //TutlSyncCallbackMsg

  //User
  MSG_USER                    = $F0000000;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMessage = class(TObject)
  protected
    fID: Cardinal;
    fWParam: PtrInt;
    fLParam: PtrInt;
    fArgs: TObject;
    fOwnsObjects: Boolean;
  public
    property ID: Cardinal read fID;
    property WParam: PtrInt read fWParam;
    property LParam: PtrInt read fLParam;
    property Args: TObject read fArgs;
    property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects;

    constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt); overload;
    constructor Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean = true); overload;
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlSynchronousMessage = class(TutlMessage)
  private
    fEvent: TEvent;
    fFreeOnFinish: Boolean;
    fLock: Integer;
    procedure Lock;
    procedure Unlock;
  public
    procedure Finish;
    function WaitFor(const aTimeout: Cardinal): TWaitResult;
    constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt); overload;
    constructor Create(const {%H-}aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean = true); overload;
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlCallbackMsg = class(TutlMessage)
  public
    procedure ExecuteCallback; virtual;
    constructor Create; overload;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlSyncCallbackMsg = class(TutlSynchronousMessage)
  public
    procedure ExecuteCallback; virtual;
    constructor Create; overload;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMessage///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
begin
  inherited Create;
  fID          := aID;
  fWParam      := aWParam;
  fLParam      := aLParam;
  fArgs        := nil;
  fOwnsObjects := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMessage.Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean);
begin
  inherited Create;
  fID          := aID;
  fWParam      := 0;
  fLParam      := 0;
  fArgs        := aArgs;
  fOwnsObjects := aOwnsObjects;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMessage.Destroy;
begin
  if Assigned(fArgs) and fOwnsObjects then
    FreeAndNil(fArgs);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSynchronousMessage//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSynchronousMessage.Lock;
begin
  repeat until (InterLockedExchange(fLock, 1) = 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSynchronousMessage.Unlock;
begin
  InterLockedExchange(fLock, 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSynchronousMessage.Finish;
begin
  fEvent.SetEvent;
  Lock;
  if fFreeOnFinish then
    Free
  else
    Unlock;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlSynchronousMessage.WaitFor(const aTimeout: Cardinal): TWaitResult;
begin
  Lock;
  try
    result := fEvent.WaitFor(aTimeout);
    fFreeOnFinish := (result <> wrSignaled);
  finally
    Unlock;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSynchronousMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
begin
  inherited Create(aID, aWParam, aLParam);
  fEvent        := TEvent.Create(nil, true, false, '');
  fFreeOnFinish := false;
  fLock         := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSynchronousMessage.Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean);
begin
  inherited Create(ID, aArgs, aOwnsObjects);
  fEvent        := TEvent.Create(nil, true, false, '');
  fFreeOnFinish := false;
  fLock         := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlSynchronousMessage.Destroy;
begin
  fEvent.SetEvent;
  FreeAndNil(fEvent);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackMsg///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCallbackMsg.ExecuteCallback;
begin
  //DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCallbackMsg.Create;
begin
  inherited Create(MSG_CALLBACK, 0, 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlSyncCallbackMsg///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlSyncCallbackMsg.ExecuteCallback;
begin
  //DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlSyncCallbackMsg.Create;
begin
  inherited Create(MSG_SYNC_CALLBACK, 0, 0);
end;

end.