/components/rtticontrols/examples/example3.pas

http://github.com/graemeg/lazarus · Pascal · 144 lines · 92 code · 26 blank · 26 comment · 7 complexity · cd86993adb72f382d1883b08e63c077c MD5 · raw file

  1. {
  2. *****************************************************************************
  3. See the file COPYING.modifiedLGPL.txt, included in this distribution,
  4. for details about the license.
  5. *****************************************************************************
  6. Author: Mattias Gaertner
  7. Abstract:
  8. Example for RTTI controls.
  9. Demonstrates how to write your own property editors to access readonly
  10. properties.
  11. }
  12. unit Example3;
  13. {$mode objfpc}{$H+}
  14. interface
  15. uses
  16. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, RTTICtrls,
  17. StdCtrls, PropEdits;
  18. type
  19. { TBall - a class with some readonly properties and a procedure to set the
  20. properties. }
  21. TBall = class(TPersistent)
  22. private
  23. FX: integer;
  24. FY: integer;
  25. FSize: word;
  26. public
  27. procedure SetBall(const NewX, NewY: integer; const NewSize: word);
  28. published
  29. // published readonly properties
  30. property X: integer read FX;
  31. property Y: integer read FY;
  32. property Size: word read FSize;
  33. end;
  34. { TBallPropertyEditor - a property editor for the TBall properties }
  35. TBallPropertyEditor = class(TIntegerPropertyEditor)
  36. public
  37. procedure SetValue(const NewValue: string); override;
  38. end;
  39. { TForm1 }
  40. TForm1 = class(TForm)
  41. SizeTIEdit: TTIEdit;
  42. XLabel: TLabel;
  43. YLabel: TLabel;
  44. SizeLabel: TLabel;
  45. XTIEdit: TTIEdit;
  46. YTIEdit: TTIEdit;
  47. procedure Form1Create(Sender: TObject);
  48. procedure Form1Destroy(Sender: TObject);
  49. procedure Form1Paint(Sender: TObject);
  50. private
  51. { private declarations }
  52. public
  53. { public declarations }
  54. Ball1: TBall;
  55. end;
  56. var
  57. Form1: TForm1;
  58. implementation
  59. {$R example3.lfm}
  60. { TBall }
  61. procedure TBall.SetBall(const NewX, NewY: integer; const NewSize: word);
  62. begin
  63. if (FX=NewX) and (FY=NewY) and (FSize=NewSize) then exit;
  64. FX:=NewX;
  65. FY:=NewY;
  66. FSize:=NewSize;
  67. Form1.Invalidate;
  68. end;
  69. { TForm1 }
  70. procedure TForm1.Form1Create(Sender: TObject);
  71. begin
  72. Ball1:=TBall.Create;
  73. Ball1.SetBall(200,100,20);
  74. XTIEdit.Link.SetObjectAndProperty(Ball1,'X');
  75. YTIEdit.Link.SetObjectAndProperty(Ball1,'Y');
  76. SizeTIEdit.Link.SetObjectAndProperty(Ball1,'Size');
  77. end;
  78. procedure TForm1.Form1Destroy(Sender: TObject);
  79. begin
  80. // unlink properties
  81. XTIEdit.Link.TIObject:=nil;
  82. YTIEdit.Link.TIObject:=nil;
  83. SizeTIEdit.Link.TIObject:=nil;
  84. Ball1.Free;
  85. end;
  86. procedure TForm1.Form1Paint(Sender: TObject);
  87. begin
  88. with Canvas do begin
  89. Brush.Color:=clBlue;
  90. Ellipse(Ball1.X-Ball1.Size,Ball1.Y-Ball1.Size,
  91. Ball1.X+Ball1.Size,Ball1.Y+Ball1.Size);
  92. end;
  93. end;
  94. { TBallPropertyEditor }
  95. procedure TBallPropertyEditor.SetValue(const NewValue: string);
  96. var
  97. L: integer;
  98. Ball: TBall;
  99. X: integer;
  100. Y: integer;
  101. Size: word;
  102. PropName: String;
  103. begin
  104. L := StrToIntDef(NewValue,0);
  105. Ball:=GetComponent(0) as TBall;
  106. PropName:=GetName;
  107. if CompareText(PropName,'X')=0 then X:=L else X:=Ball.X;
  108. if CompareText(PropName,'Y')=0 then Y:=L else Y:=Ball.Y;
  109. if CompareText(PropName,'Size')=0 then Size:=Word(L) else Size:=Ball.Size;
  110. Ball.SetBall(X,Y,Size);
  111. end;
  112. initialization
  113. RegisterPropertyEditor(TypeInfo(integer),TBall,'X',TBallPropertyEditor);
  114. RegisterPropertyEditor(TypeInfo(integer),TBall,'Y',TBallPropertyEditor);
  115. RegisterPropertyEditor(TypeInfo(word),TBall,'Size',TBallPropertyEditor);
  116. end.