Show DummyClasses.pas syntax highlighted
{
This units demostrates the power and flexibility of StrangePersistentClasses
It does not provide any functionality. See code in DefineIniProperties() for details.
Da Stranger (datarget@mail.ru) October '2006
}
unit DummyClasses;
interface
{$Warnings Off}
{$I GLScene.inc}
uses
//VCL
Classes, Types, SysUtils, Graphics, Forms, StdCtrls,
//GLScene
VectorTypes, VectorGeometry, GLTexture, GLMisc, GLParticleFX, GLCrossPlatform,
//Strange components
StrangeIniFiles, StrangeTypesAndConstants, StrangeMathUtilities,
StrangeIniObjects, StrangePersistentClasses, StrangeStringUtilities;
type
TDummyInternalClass = class(TStrangeIniPrefixSuffixPriPubObject, IStrangeIniPersistentItem)
private
FIndex: Integer;
FAnotherInteger: Integer;
Neibours: array of TDummyInternalClass;
protected
property AnotherInteger: Integer read FAnotherInteger;
public
EyeColor: TGLColor;
Button: TButton;
constructor Create;
destructor Destroy; override;
procedure DefineIniProperties(const Properties: TStrangeIniPropertyList); override;
function GetIniPersistentID: string;
procedure AddNeibour(const Instance: TDummyInternalClass);
end;
TDummyClass = class(TStrangeIniPriPubObject, IStrangeIniPersistentOwner)
private
FOwner: TForm;
FFavoriteChild: TDummyInternalClass;
FStringgg: string;
FDaInteger: Integer;
FSomeVector: TVector3f;
FSomeRecord: TRect;
FSet: TFontStyles;
FStringMatrix: array of array of string;
FSomeCoordinates: TGLCoordinates;
FBool: Boolean;
FEnum: TFontStyle;
{$IFDEF STRANGE_INIFILE_SUPPORT}
FLifeColors: TPFXLifeColors; //a collection
{$ENDIF STRANGE_INIFILE_SUPPORT}
function GetCustomProperty: TVector3f;
procedure SetCustomProperty(const Value: TVector3f);
function GetCustomProperty2: TFontStyle;
procedure SetCustomProperty2(const Value: TFontStyle);
function GetCustomProperty3: TFontStyles;
procedure SetCustomProperty3(const Value: TFontStyles);
function GetCustomProperty4: string;
procedure SetCustomProperty4(const Value: string);
function CreateOwnedClass: TDummyInternalClass;
protected
property Stringgg: string read FStringgg;
property CustomProperty: TVector3f read GetCustomProperty write SetCustomProperty;
property CustomProperty2: TFontStyle read GetCustomProperty2 write SetCustomProperty2;
property CustomProperty3: TFontStyles read GetCustomProperty3 write SetCustomProperty3;
property CustomProperty4: string read GetCustomProperty4 write SetCustomProperty4;
function GetIniPersistentItem(const AName: string; const AClassType: TClass): TObject; virtual;
public
OwnedClass: TDummyInternalClass; //an owned class that can be nil
ASingleValue: Single;
InternalClasses: array of TDummyInternalClass;
Memo: TMemo; // a reference
procedure InitValues1;
procedure InitValues2;
constructor Create(const AOwner: TForm);
destructor Destroy; override;
procedure DefineIniProperties(const Properties: TStrangeIniPropertyList); override;
function ResolveReferences(const ReferenceOwner: TObject; const Reset: Boolean = False): Boolean; override;
end;
implementation
{ TDummyClass }
constructor TDummyClass.Create(const AOwner: TForm);
var
I: Integer;
begin
FOwner := AOwner;
SetLength(InternalClasses, 5);
for I := 0 to 4 do
begin
InternalClasses[I] := TDummyInternalClass.Create; //they don't know their parent :(
InternalClasses[I].FIndex := I;
end;
FSomeCoordinates := TGLCoordinates.CreateInitialized(nil, ZHmgVector);
{$IFDEF STRANGE_INIFILE_SUPPORT}
FLifeColors := TPFXLifeColors.Create(nil);
{$ENDIF STRANGE_INIFILE_SUPPORT}
FFavoriteChild := InternalClasses[0];
end;
function TDummyClass.CreateOWnedClass: TDummyInternalClass;
begin
if OwnedClass = nil then
OwnedClass := TDummyInternalClass.Create;
Result := OwnedClass;
end;
procedure TDummyClass.DefineIniProperties(const Properties: TStrangeIniPropertyList);
begin
inherited;
//private properties
//notice that we can pass a pointer to a read-only protected property Stringgg!!!
Properties.Add('FFavoriteChild', @FFavoriteChild, TypeInfo(TDummyInternalClass), False).SetPropertyType(iptClassReference).SetReferenceOptions(TDummyClass, TDummyInternalClass);
Properties.Add('StringggProperty', @Stringgg, TypeInfo(string), False);
Properties.Add('CustomProperty', nil, nil, False, nil, ippVector3f).SetCustomPropertyType(cptVector3f, @TDummyClass.SetCustomProperty, @TDummyClass.GetCustomProperty).Update;
Properties.Add('CustomProperty2', nil, TypeInfo(TFontStyle), False).SetCustomPropertyType(cptEnumeration, @TDummyClass.SetCustomProperty2, @TDummyClass.GetCustomProperty2);
Properties.Add('CustomProperty3', nil, TypeInfo(TFontStyles), False).SetCustomPropertyType(cptSet, @TDummyClass.SetCustomProperty3, @TDummyClass.GetCustomProperty3);
Properties.Add('CustomProperty4', nil, TypeInfo(string), False).SetCustomPropertyType(cptString, @TDummyClass.SetCustomProperty4, @TDummyClass.GetCustomProperty4);
Properties.Add('FDaInteger', @FDaInteger, TypeInfo(Integer), False);
Properties.Add('FSomeVector', @FSomeVector, nil, False).AdditionalProperties.Preset := ippVector3f;
Properties.Add('FSomeRecord', @FSomeRecord, nil, False).SetRecordProperties(SizeOf(TRect));
Properties.Add('FSet', @FSet, TypeInfo(TFontStyles), False);
Properties.Add('FStringMatrix', @FStringMatrix, nil, False).SetAdditionalProperties(iatMatrix, aetString, assArraySafe, 5000);
Properties.Add('FSomeCoordinates', FSomeCoordinates.AsAddress, nil, False).AdditionalProperties.Preset := ippVector3f;
Properties.Add('FBool', @FBool, TypeInfo(Boolean), False);
Properties.Add('FEnum', @FEnum, TypeInfo(TFontStyle), False);
{$IFDEF STRANGE_INIFILE_SUPPORT}
Properties.Add('FLifeColors', @FLifeColors, TypeInfo(TPFXLifeColors), False).SetPropertyType(iptClassInstanceNewSection, TPFXLifeColor);
{$ENDIF STRANGE_INIFILE_SUPPORT}
//public properties
Properties.Add('ASingleValue', @ASingleValue, TypeInfo(Single), True);
Properties.Add('Memo', @Memo, TypeInfo(TMemo), True).SetPropertyType(iptClassReference).SetReferenceOptions(TForm, TMemo);
Properties.Add('OwnedClass', @OwnedClass, TypeInfo(TDummyInternalClass), True).SetPropertyType(iptClassInstanceNewSection, TDummyInternalClass, @TDummyClass.CreateOwnedClass).Update;
Properties.Add('InternalClasses', @InternalClasses, nil, True).SetPropertyType(iptClassInstanceOldSection, TDummyInternalClass);
if Properties.InputSettings.Operation = sioLoad then
begin
Properties.Update; //read the properties to fill in the Unresolved objects list
ResolveReferences(FOwner); //resolve Memo
Assert(ResolveReferences(Self), 'No unresolved stuff should be left at this point'); //resolve Favorite child
end;
end;
destructor TDummyClass.Destroy;
var
I: Integer;
begin
inherited;
FSomeCoordinates.Destroy;
{$IFDEF STRANGE_INIFILE_SUPPORT}
FLifeColors.Destroy;
{$ENDIF STRANGE_INIFILE_SUPPORT}
for I := 0 to 4 do
InternalClasses[I].Destroy;
OwnedClass.Free;
end;
function TDummyClass.GetCustomProperty: TVector3f;
begin
Result := ZVector;
end;
function TDummyClass.GetCustomProperty2: TFontStyle;
begin
Result := fsStrikeOut;
end;
function TDummyClass.GetCustomProperty3: TFontStyles;
begin
Result := [fsStrikeOut];
end;
function TDummyClass.GetCustomProperty4: string;
begin
Result := 'I suck!'
end;
function TDummyClass.GetIniPersistentItem(const AName: string;
const AClassType: TClass): TObject;
begin
if AClassType.InheritsFrom(TDummyInternalClass) then
Result := InternalClasses[StrToInt(AName)]
else
Result := nil;
end;
procedure TDummyClass.InitValues1;
var
I, J: Integer;
begin
FStringgg := Char(Random(100)) + Char(Random(100)) + 'aaaaaaa';
FDaInteger := 123123;
FSomeVector := Vector3fMake(0.5, 10, 0.99);
ASingleValue := random * 45.15648;
FSomeRecord := Rect(1, 2, 2, 3);
FSet := [fsBold, fsItalic];
FFavoriteChild := InternalClasses[2];
FBool := True;
FEnum := fsBold;
{$IFDEF STRANGE_INIFILE_SUPPORT}
FLifeColors.Add.ColorOuter.AsWinColor := RGB(255, 12, 65);
{$ENDIF STRANGE_INIFILE_SUPPORT}
CreateOwnedClass;
SetLength(FStringMatrix, 5, 6);
for I := 0 to 4 do
for J := 0 to 5 do
FStringMatrix[I, J] := IntToStr(Round(Random * 100));
// InitValues for internal classes
for I := 0 to 4 do
with InternalClasses[I] do
begin
if I <> 0 then
InternalClasses[I].AddNeibour(InternalClasses[I - 1]);
if I <> 4 then
InternalClasses[I].AddNeibour(InternalClasses[I + 1]);
EyeColor.SetColor(0.1, 0.2, 0.3, 0.5);
FAnotherInteger := Round(random * 100);
end;
end;
procedure TDummyClass.InitValues2;
var
I, J: Integer;
begin
FStringgg := 'bb' + Char(Random(100)) + Char(Random(100));
FDaInteger := 32;
FSomeVector := XYZVector;
ASingleValue := random * 0.01;
FSomeRecord := Rect(10, 9, 2, 300);
FSet := [fsStrikeOut];
FFavoriteChild := InternalClasses[4];
FBool := False;
FEnum := fsUnderline;
{$IFDEF STRANGE_INIFILE_SUPPORT}
FLifeColors.Add.LifeTime := 5;
{$ENDIF STRANGE_INIFILE_SUPPORT}
SetLength(FStringMatrix, 14, 9);
for I := 0 to 13 do
for J := 0 to 8 do
FStringMatrix[I, J] := IntToStr(Round(Random * 1000000));
// InitValues for internal classes
for I := 0 to 4 do
with InternalClasses[I] do
begin
if I <> 4 then
InternalClasses[I].AddNeibour(InternalClasses[I + 1]);
EyeColor.SetColor(0.9, 0.9, 0.9, 0.1);
FAnotherInteger := random(5);
end;
end;
function TDummyClass.ResolveReferences(const ReferenceOwner: TObject;
const Reset: Boolean): Boolean;
var
I: Integer;
begin
Result := inherited ResolveReferences(ReferenceOwner, Reset);
//Notice that we first call the function and only after "and" it to the Result
//If the order were different, there was a change that the procedure wouldn't
//be called at all
//When ReferenceOwner is TForm, Button is resolved
//When ReferenceOwner is TDummyClass, Neighbors are resolved
for I := 0 to 4 do
Result := InternalClasses[I].ResolveReferences(ReferenceOwner, Reset) and Result;
end;
procedure TDummyClass.SetCustomProperty(const Value: TVector3f);
begin
if VectorEquals(Value, XVector) then
Beep;
end;
procedure TDummyClass.SetCustomProperty2(const Value: TFontStyle);
begin
if Value = fsUnderline then
Beep;
end;
procedure TDummyClass.SetCustomProperty3(const Value: TFontStyles);
begin
if Value = [fsUnderline] then
Beep;
end;
procedure TDummyClass.SetCustomProperty4(const Value: string);
begin
if Value = 'You suck!' then
Beep;
end;
{ TDummyInternalClass }
procedure TDummyInternalClass.AddNeibour(
const Instance: TDummyInternalClass);
begin
SetLength(Neibours, Length(Neibours) + 1);
Neibours[Length(Neibours) - 1] := Instance;
end;
constructor TDummyInternalClass.Create;
begin
EyeColor := TGLColor.Create(nil);
end;
procedure TDummyInternalClass.DefineIniProperties(
const Properties: TStrangeIniPropertyList);
begin
inherited;
//notice that we can pass a pointer to a read-only property!!!
Properties.Add('AnotherIntegerProperty', @AnotherInteger, TypeInfo(Integer), False);
Properties.Add('EyeColor', @EyeColor.Color, nil, True).AdditionalProperties.Preset := ippGLColor4;
Properties.Add('Neibour', @Neibours, nil, True).SetAdditionalProperties(iatArray, aetObjectReference, assArraySafe).SetReferenceOptions(TDummyClass, TDummyInternalClass);
Properties.Add('Button', @Button, TypeInfo(TButton), True).SetPropertyType(iptClassReference).SetReferenceOptions(TForm, TButton);
end;
destructor TDummyInternalClass.Destroy;
begin
inherited;
EyeColor.Destroy;
end;
function TDummyInternalClass.GetIniPersistentID: string;
begin
Result := IntToStr(FIndex);
end;
end.
See more files for this project here