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; 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.Finish; begin fEvent.SetEvent; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlSynchronousMessage.WaitFor(const aTimeout: Cardinal): TWaitResult; begin result := fEvent.WaitFor(aTimeout); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlSynchronousMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt); begin inherited Create(aID, aWParam, aLParam); fEvent := TEvent.Create(nil, true, false, ''); 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, ''); 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.