|
- 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.
|