/components/rtticontrols/examples/example3.pas

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