Nelze vybrat více než 25 témat Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.

172 řádky
7.2 KiB

  1. unit uutlMessages;
  2. { Package: Utils
  3. Prefix: utl - UTiLs
  4. Beschreibung: diese Unit enthält verschiedene Klassen, die Messages definieren,
  5. die zwischen utlMessageThreads ausgetauscht werden können }
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. Classes, SysUtils, syncobjs;
  10. const
  11. //General
  12. MSG_CALLBACK = $00010001; //TutlCallbackMsg
  13. MSG_SYNC_CALLBACK = $00010002; //TutlSyncCallbackMsg
  14. //User
  15. MSG_USER = $F0000000;
  16. type
  17. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  18. TutlMessage = class(TObject)
  19. protected
  20. fID: Cardinal;
  21. fWParam: PtrInt;
  22. fLParam: PtrInt;
  23. fArgs: TObject;
  24. fOwnsObjects: Boolean;
  25. public
  26. property ID: Cardinal read fID;
  27. property WParam: PtrInt read fWParam;
  28. property LParam: PtrInt read fLParam;
  29. property Args: TObject read fArgs;
  30. property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects;
  31. constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt); overload;
  32. constructor Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean = true); overload;
  33. destructor Destroy; override;
  34. end;
  35. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  36. TutlSynchronousMessage = class(TutlMessage)
  37. private
  38. fEvent: TEvent;
  39. public
  40. procedure Finish;
  41. function WaitFor(const aTimeout: Cardinal): TWaitResult;
  42. constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt); overload;
  43. constructor Create(const {%H-}aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean = true); overload;
  44. destructor Destroy; override;
  45. end;
  46. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  47. TutlCallbackMsg = class(TutlMessage)
  48. public
  49. procedure ExecuteCallback; virtual;
  50. constructor Create; overload;
  51. end;
  52. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  53. TutlSyncCallbackMsg = class(TutlSynchronousMessage)
  54. public
  55. procedure ExecuteCallback; virtual;
  56. constructor Create; overload;
  57. end;
  58. implementation
  59. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  60. //TutlMessage///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  61. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  62. constructor TutlMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
  63. begin
  64. inherited Create;
  65. fID := aID;
  66. fWParam := aWParam;
  67. fLParam := aLParam;
  68. fArgs := nil;
  69. fOwnsObjects := true;
  70. end;
  71. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  72. constructor TutlMessage.Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean);
  73. begin
  74. inherited Create;
  75. fID := aID;
  76. fWParam := 0;
  77. fLParam := 0;
  78. fArgs := aArgs;
  79. fOwnsObjects := aOwnsObjects;
  80. end;
  81. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  82. destructor TutlMessage.Destroy;
  83. begin
  84. if Assigned(fArgs) and fOwnsObjects then
  85. FreeAndNil(fArgs);
  86. inherited Destroy;
  87. end;
  88. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  89. //TutlSynchronousMessage//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  90. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  91. procedure TutlSynchronousMessage.Finish;
  92. begin
  93. fEvent.SetEvent;
  94. end;
  95. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  96. function TutlSynchronousMessage.WaitFor(const aTimeout: Cardinal): TWaitResult;
  97. begin
  98. result := fEvent.WaitFor(aTimeout);
  99. end;
  100. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  101. constructor TutlSynchronousMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
  102. begin
  103. inherited Create(aID, aWParam, aLParam);
  104. fEvent := TEvent.Create(nil, true, false, '');
  105. end;
  106. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  107. constructor TutlSynchronousMessage.Create(const aID: Cardinal; const aArgs: TObject; const aOwnsObjects: Boolean);
  108. begin
  109. inherited Create(ID, aArgs, aOwnsObjects);
  110. fEvent := TEvent.Create(nil, true, false, '');
  111. end;
  112. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  113. destructor TutlSynchronousMessage.Destroy;
  114. begin
  115. fEvent.SetEvent;
  116. FreeAndNil(fEvent);
  117. inherited Destroy;
  118. end;
  119. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  120. //TutlCallbackMsg///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  121. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  122. procedure TutlCallbackMsg.ExecuteCallback;
  123. begin
  124. //DUMMY
  125. end;
  126. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  127. constructor TutlCallbackMsg.Create;
  128. begin
  129. inherited Create(MSG_CALLBACK, 0, 0);
  130. end;
  131. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  132. //TutlSyncCallbackMsg///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  133. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  134. procedure TutlSyncCallbackMsg.ExecuteCallback;
  135. begin
  136. //DUMMY
  137. end;
  138. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  139. constructor TutlSyncCallbackMsg.Create;
  140. begin
  141. inherited Create(MSG_SYNC_CALLBACK, 0, 0);
  142. end;
  143. end.