/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
- {
- *****************************************************************************
- See the file COPYING.modifiedLGPL.txt, included in this distribution,
- for details about the license.
- *****************************************************************************
- Author: Mattias Gaertner
- Abstract:
- Example for RTTI controls.
- Demonstrates how to write your own property editors to access readonly
- properties.
- }
- unit Example3;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, RTTICtrls,
- StdCtrls, PropEdits;
- type
- { TBall - a class with some readonly properties and a procedure to set the
- properties. }
- TBall = class(TPersistent)
- private
- FX: integer;
- FY: integer;
- FSize: word;
- public
- procedure SetBall(const NewX, NewY: integer; const NewSize: word);
- published
- // published readonly properties
- property X: integer read FX;
- property Y: integer read FY;
- property Size: word read FSize;
- end;
-
- { TBallPropertyEditor - a property editor for the TBall properties }
-
- TBallPropertyEditor = class(TIntegerPropertyEditor)
- public
- procedure SetValue(const NewValue: string); override;
- end;
-
- { TForm1 }
- TForm1 = class(TForm)
- SizeTIEdit: TTIEdit;
- XLabel: TLabel;
- YLabel: TLabel;
- SizeLabel: TLabel;
- XTIEdit: TTIEdit;
- YTIEdit: TTIEdit;
- procedure Form1Create(Sender: TObject);
- procedure Form1Destroy(Sender: TObject);
- procedure Form1Paint(Sender: TObject);
- private
- { private declarations }
- public
- { public declarations }
- Ball1: TBall;
- end;
- var
- Form1: TForm1;
- implementation
- {$R example3.lfm}
- { TBall }
- procedure TBall.SetBall(const NewX, NewY: integer; const NewSize: word);
- begin
- if (FX=NewX) and (FY=NewY) and (FSize=NewSize) then exit;
- FX:=NewX;
- FY:=NewY;
- FSize:=NewSize;
- Form1.Invalidate;
- end;
- { TForm1 }
- procedure TForm1.Form1Create(Sender: TObject);
- begin
- Ball1:=TBall.Create;
- Ball1.SetBall(200,100,20);
-
- XTIEdit.Link.SetObjectAndProperty(Ball1,'X');
- YTIEdit.Link.SetObjectAndProperty(Ball1,'Y');
- SizeTIEdit.Link.SetObjectAndProperty(Ball1,'Size');
- end;
- procedure TForm1.Form1Destroy(Sender: TObject);
- begin
- // unlink properties
- XTIEdit.Link.TIObject:=nil;
- YTIEdit.Link.TIObject:=nil;
- SizeTIEdit.Link.TIObject:=nil;
- Ball1.Free;
- end;
- procedure TForm1.Form1Paint(Sender: TObject);
- begin
- with Canvas do begin
- Brush.Color:=clBlue;
- Ellipse(Ball1.X-Ball1.Size,Ball1.Y-Ball1.Size,
- Ball1.X+Ball1.Size,Ball1.Y+Ball1.Size);
- end;
- end;
- { TBallPropertyEditor }
- procedure TBallPropertyEditor.SetValue(const NewValue: string);
- var
- L: integer;
- Ball: TBall;
- X: integer;
- Y: integer;
- Size: word;
- PropName: String;
- begin
- L := StrToIntDef(NewValue,0);
- Ball:=GetComponent(0) as TBall;
- PropName:=GetName;
- if CompareText(PropName,'X')=0 then X:=L else X:=Ball.X;
- if CompareText(PropName,'Y')=0 then Y:=L else Y:=Ball.Y;
- if CompareText(PropName,'Size')=0 then Size:=Word(L) else Size:=Ball.Size;
- Ball.SetBall(X,Y,Size);
- end;
- initialization
- RegisterPropertyEditor(TypeInfo(integer),TBall,'X',TBallPropertyEditor);
- RegisterPropertyEditor(TypeInfo(integer),TBall,'Y',TBallPropertyEditor);
- RegisterPropertyEditor(TypeInfo(word),TBall,'Size',TBallPropertyEditor);
- end.