tb0210.pp 1.1 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. { Old file: tbs0249.pp }
  2. { procedure of object cannot be assigned to property. OK 0.99.11 (PFV) }
  3. program TestEvent;
  4. {$mode objfpc}
  5. {$M+}
  6. type
  7. TNotifyEvent = procedure( Sender: TObject ) of object;
  8. THost = class
  9. protected
  10. FOnEvent: TNotifyEvent;
  11. procedure SetOnEvent( Value: TNotifyEvent );
  12. public
  13. constructor Create;
  14. procedure Trigger;
  15. procedure SayHello;
  16. published
  17. property OnEvent: TNotifyEvent read FOnEvent write SetOnEvent;
  18. end;
  19. TDummy = class
  20. procedure HandleEvent( Sender: TObject );
  21. end;
  22. constructor THost.Create;
  23. begin
  24. FOnEvent := nil;
  25. end;
  26. procedure THost.Trigger;
  27. begin
  28. if @FOnEvent <> nil then
  29. FOnEvent( Self )
  30. end;
  31. procedure THost.SetOnEvent( Value: TNotifyEvent );
  32. begin
  33. FOnEvent := Value
  34. end;
  35. procedure THost.SayHello;
  36. begin
  37. Writeln( 'Hello event' )
  38. end;
  39. procedure TDummy.HandleEvent( Sender: TObject );
  40. begin
  41. THost( Sender ).SayHello
  42. end;
  43. var
  44. Host: THost;
  45. Dummy: TDummy;
  46. begin
  47. Dummy := TDummy.Create;
  48. Host := THost.Create;
  49. with Host,Dummy do
  50. OnEvent := @HandleEvent; // this is 57, 27 is ";"
  51. Host.Trigger;
  52. end.