home *** CD-ROM | disk | FTP | other *** search
- unit Proptest;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- DsgnIntf,
- Forms, Dialogs;
-
- type
- TA = class(TPersistent)
- protected
- FText : string;
- published
- property Text : string read FText write FText;
- end;
-
- TB = class(TPersistent)
- protected
- FA : TA;
- FArr : Array[0..9] of integer;
- procedure SetA(AA : TA);
- procedure SetArr(Index, AVal : integer);
- function GetArr(Index : integer) : Integer;
- procedure DefineProperties(Filer: TFiler); override;
- procedure WriteArr(Writer: TWriter);
- procedure ReadArr(Reader: TReader);
- public
- constructor Create;
- destructor Destroy; override;
- property Arr[Index : integer] : integer read GetArr write SetArr;
- published
- property A : TA read FA write SetA;
- end;
-
- type
- TPropTest = class(TWinControl)
- protected
- FB : TB;
- procedure SetB(AB : TB);
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- published
- property B : TB read FB write SetB;
- end;
-
- TBProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
- procedure Register;
-
- implementation
-
- uses
- ubdialog;
-
- {========================================}
- procedure Register;
- begin
- RegisterComponents('Tests', [TPropTest]);
- RegisterPropertyEditor(TypeInfo(TB),nil,'',TBProperty);
- end;
-
- {========================================}
- constructor TPropTest.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FB := TB.Create;
- end;
-
- {========================================}
- destructor TPropTest.Destroy;
- begin
- FB.Free;
- Inherited Destroy;
- end;
-
-
- {========================================}
- procedure TPropTest.SetB(AB : TB);
- begin
- FB.Assign(AB);
- end;
-
- {========================================}
- {========================================}
- constructor TB.Create;
- var
- i : integer;
- begin
- for i := 0 to 9 do
- Arr[i] := i;
- FA := TA.Create;
- end;
-
- {========================================}
- destructor TB.Destroy;
- begin
- FA.Free;
- Inherited Destroy;
- end;
-
- {========================================}
- procedure TB.SetA(AA : TA);
- begin
- FA.Assign(AA);
- end;
-
- {========================================}
- procedure TB.SetArr(Index, AVal : integer);
- begin
- FArr[Index] := AVal;
- end;
-
- {========================================}
- function TB.GetArr(Index : integer) : Integer;
- begin
- result := FArr[Index];
- end;
-
- {========================================}
- procedure TB.DefineProperties(Filer: TFiler);
- begin
- Filer.DefineProperty('Arr', ReadArr, WriteArr, True);
- end;
-
- {========================================}
- procedure TB.WriteArr(Writer: TWriter);
- var
- i : integer;
- begin
- for i := 0 to 9 do
- Writer.WriteInteger(Arr[i]);
- end;
-
- {========================================}
- procedure TB.ReadArr(Reader: TReader);
- var
- i : integer;
- begin
- for i := 0 to 9 do
- Arr[i] := Reader.ReadInteger;
- end;
-
- {========================================}
- {========================================}
- procedure TBProperty.Edit;
- var
- BDialog: TBDialog;
- begin
- BDialog := TBDialog.Create(Application);
- try
- BDialog.B := TB(GetOrdValue);
- BDialog.ShowModal;
- finally
- BDialog.Free;
- end;
- end;
-
- {========================================}
- function TBProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paDialog, paReadOnly];
- end;
-
-
- end.
-