GLS.BaseClasses.pas 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. //
  2. // The multimedia graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.BaseClasses;
  5. (* Base classes *)
  6. interface
  7. uses
  8. System.Classes,
  9. System.SysUtils,
  10. GLS.Strings,
  11. GLS.PersistentClasses;
  12. type
  13. TGLProgressTimes = packed record
  14. DeltaTime, NewTime: Double;
  15. SqrDeltaTime, InvSqrDeltaTime: Single;
  16. end;
  17. (* Progression event for time-base animations/simulations.
  18. deltaTime is the time delta since last progress and newTime is the new
  19. time after the progress event is completed. *)
  20. TGLProgressEvent = procedure(Sender: TObject; const DeltaTime, NewTime: Double) of object;
  21. IGLNotifyAble = interface(IInterface)
  22. ['{00079A6C-D46E-4126-86EE-F9E2951B4593}']
  23. procedure NotifyChange(Sender: TObject);
  24. end;
  25. IGLProgessAble = interface(IInterface)
  26. ['{95E44548-B0FE-4607-98D0-CA51169AF8B5}']
  27. procedure DoProgress(const progressTime: TGLProgressTimes);
  28. end;
  29. // An abstract class describing the "update" interface.
  30. TGLUpdateAbleObject = class(TGLInterfacedPersistent, IGLNotifyAble)
  31. private
  32. FOwner: TPersistent;
  33. FUpdating: Integer;
  34. FOnNotifyChange: TNotifyEvent;
  35. protected
  36. function GetOwner: TPersistent; override; final;
  37. public
  38. constructor Create(AOwner: TPersistent); virtual;
  39. procedure NotifyChange(Sender: TObject); virtual;
  40. procedure Notification(Sender: TObject; Operation: TOperation); virtual;
  41. property Updating: Integer read FUpdating;
  42. procedure BeginUpdate; inline;
  43. procedure EndUpdate; inline;
  44. property Owner: TPersistent read FOwner;
  45. property OnNotifyChange: TNotifyEvent read FOnNotifyChange write FOnNotifyChange;
  46. end;
  47. // A base class describing the "cadenceing" interface.
  48. TGLCadenceAbleComponent = class(TComponent, IGLProgessAble)
  49. public
  50. procedure DoProgress(const progressTime: TGLProgressTimes); virtual;
  51. end;
  52. // A base class describing the "update" interface.
  53. TGLUpdateAbleComponent = class(TGLCadenceAbleComponent, IGLNotifyAble)
  54. public
  55. procedure NotifyChange(Sender: TObject); virtual;
  56. end;
  57. TGLNotifyCollection = class(TOwnedCollection)
  58. strict private
  59. FOnNotifyChange: TNotifyEvent;
  60. strict protected
  61. procedure Update(item: TCollectionItem); override;
  62. public
  63. constructor Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
  64. property OnNotifyChange: TNotifyEvent read FOnNotifyChange write FOnNotifyChange;
  65. end;
  66. //-------------------------------------------------------------------------
  67. implementation
  68. //-------------------------------------------------------------------------
  69. //---------------------- TGLUpdateAbleObject -----------------------------------
  70. constructor TGLUpdateAbleObject.Create(AOwner: TPersistent);
  71. begin
  72. inherited Create;
  73. FOwner := AOwner;
  74. end;
  75. procedure TGLUpdateAbleObject.NotifyChange(Sender: TObject);
  76. begin
  77. if FUpdating = 0 then
  78. begin
  79. if Assigned(FOwner) then
  80. begin
  81. if FOwner is TGLUpdateAbleObject then
  82. TGLUpdateAbleObject(FOwner).NotifyChange(Self)
  83. else if FOwner is TGLUpdateAbleComponent then
  84. TGLUpdateAbleComponent(FOwner).NotifyChange(Self);
  85. end;
  86. if Assigned(FOnNotifyChange) then
  87. FOnNotifyChange(Self);
  88. end;
  89. end;
  90. procedure TGLUpdateAbleObject.Notification(Sender: TObject; Operation: TOperation);
  91. begin
  92. end;
  93. function TGLUpdateAbleObject.GetOwner: TPersistent;
  94. begin
  95. Result := FOwner;
  96. end;
  97. procedure TGLUpdateAbleObject.BeginUpdate;
  98. begin
  99. Inc(FUpdating);
  100. end;
  101. procedure TGLUpdateAbleObject.EndUpdate;
  102. begin
  103. Dec(FUpdating);
  104. if FUpdating <= 0 then
  105. begin
  106. Assert(FUpdating = 0);
  107. NotifyChange(Self);
  108. end;
  109. end;
  110. // ------------------
  111. // ------------------ TGLCadenceAbleComponent ------------------
  112. // ------------------
  113. procedure TGLCadenceAbleComponent.DoProgress(const progressTime: TGLProgressTimes);
  114. begin
  115. // nothing
  116. end;
  117. // ------------------
  118. // ------------------ TGLUpdateAbleObject ------------------
  119. // ------------------
  120. procedure TGLUpdateAbleComponent.NotifyChange(Sender: TObject);
  121. begin
  122. if Assigned(Owner) then
  123. if (Owner is TGLUpdateAbleComponent) then
  124. (Owner as TGLUpdateAbleComponent).NotifyChange(Self);
  125. end;
  126. // ------------------
  127. // ------------------ TGLNotifyCollection ------------------
  128. // ------------------
  129. constructor TGLNotifyCollection.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
  130. begin
  131. inherited Create(AOwner, AItemClass);
  132. if Assigned(AOwner) and (AOwner is TGLUpdateAbleComponent) then
  133. FOnNotifyChange := TGLUpdateAbleComponent(AOwner).NotifyChange;
  134. end;
  135. procedure TGLNotifyCollection.Update(Item: TCollectionItem);
  136. begin
  137. inherited;
  138. if Assigned(FOnNotifyChange) then
  139. FOnNotifyChange(Self);
  140. end;
  141. end.