unit ULObju;
{ TULObj = Ancestor of all objects ULxxObju .TULxxObj, that deal with
  ULxxType .TULxxRecs (see ULREC.LST). All these descendants are known by
  ULFObju .TULFObj object, i.e. any TULxxObj MUST be created ONLY by
  TULxxObj.Add method. The Add method of any TULxxObj object instance
  calls overriden TULFObj.CreateObj method, because the instance of TULFObj
  object must be the top owner of all TULxxObj object instances). }
interface
{$I define.pas}
uses
  SysUtils, Math, Classes,
  {$IFNDEF CONSOLE}
  Messages, Dialogs, Controls, Forms,
  {$ENDIF}
  PropUtl, Fileu, Stru, UlanType, ULRecTyp, ULRecUtl, MyType,
  WinUtl, BinHex, TypInfo,                            {dateu}

  ULObjDes
  {$IFNDEF CONSOLE}
  {$IFDEF DEBUG}
  ,DebugFrm
  {$ENDIF}
  {$ENDIF}
  {v0.18}
  ,Clipbrd
  {/v0.18}
  ;
{$IFDEF DEBUG}
  { $DEFINE DEBLOAD}
{$ENDIF}
type
{Exceptions}
  EULObj = class(Exception);
  EEmptyCurULObj = class(Exception);
   { CurULObj variable was not set to valid ULObj e.g. before calling
     TBrowseForm.Create. }
  EEmptyFldDescs = class(Exception);
    { Used in ULObjDes.pas }
  EULBrowse = class(Exception);
{/Exceptions}

  TULObj = class;
  TULObjFields = class;

  TULObjField = class(TObject)
  private
    {FRTIndex: integer;{ index of the field in FULObj properties array (RTTI) }
    FObjFields: TULObjFields;
      { Owner }
    FFldDesc: TULObjFldDesc;
      { this field's common (for class) properties description object }
    FOnGetUsrValue: TOnGetSetUsrValue;
    FOnSetUsrValue: TOnGetSetUsrValue;
  protected
    function GetValue: string;
    procedure SetValue(const AValue: string);
    function GetUsrValue: string;
    procedure SetUsrValue(const AUsrValue: string);
  public
    constructor Create(AOwner: TULObjFields; const AName: string); reintroduce;
    {property RTIndex: integer read FRTIndex;}
    property Value: string read GetValue write SetValue;
    property UsrValue: string read GetUsrValue write SetUsrValue;
    property ObjFields: TULObjFields read FObjFields;
    property FldDesc: TULObjFldDesc read FFldDesc;
    property OnGetUsrValue: TOnGetSetUsrValue read FOnGetUsrValue write FOnGetUsrValue;
    property OnSetUsrValue: TOnGetSetUsrValue read FOnSetUsrValue write FOnSetUsrValue;
  end;

  TULObjFields = class(TList)
  private
    FObj: TULObj;
  protected
    function GetField(Index: integer): TULObjField;
    procedure ClearFields;
  public
    constructor Create(AOwner: TULObj; const AFieldNameList: string); reintroduce;
    destructor Destroy; override;
    property Fields[Index: integer]: TULObjField read GetField; default;
    property Obj: TULObj read FObj;
  end;

  TULObj = class(TComponent)
    { Can hold any ULxRec - child records (in Components and
      FChildList array); top owner must have always RecID = ULFID
      (and this one must be created by TULFObj.Create or TULFObj.Load). }
  private
    FRec: PULRec;
      { Pointer to allocated TULxxRec }
    FRecSize: longint;
      { Amount of memory allocated for Rec; can be larger then RecLen. }
    FData: TStream;
      { Contains eventual non ULRec child data (e.g. acquisition data) - only
        allowed <> nil for ChildType = ctData;
        for ChildType = ctULRec the child data are in Components/FChildList
        array; FData implemented as Memory stream by default (or FileStream with
        AFileName = RecName if rfHasRecName and rfFileDataStream flags are set);
        can be overriden in virtual DataStreamInit method;
        NOT ALLOWED TO HAVE BOTH non empty - FData and Components/FChildList;

        Can be also assigned any opened stream to Data property. Then old FData
        is freed and FData is assigned new pointer. }
    FFileName: TFileName;
      { Filename used to load the record from/save the record to
        (NOT THE NAME FOR FData STREAM) }
    FChildList: TList;
      { For keeping list of Childs (as Components, but eventually sorted) }
    FObjDesc: TULObjDesc;
      { Information common to all instances of this TULxxObj type. }
    FUsers: TList;
      { List of (usually visual) objects that have instantiated pointer to this
        object. TULObj sends cmULObjUpdated, cmULObjCanDestroy and cmULObjDestroyed
        WM_APPMESSAGE messages to all User objects (lParam = ULObj). User
        objects on the other hand send messages to ULObj: cmULObjUserCreated and
        cmULObjUserDestroyed, with lParam = pointer to the user object. }
    FActiveChildIndex: integer;
       { Used together with ActiveChild property and ChildWithFlagFirst,Next
         methods for TTable like scanning through Childs array, usings Flags
         filter. }
    {$IFNDEF CONSOLE}
    FNotifyingCM: integer;
       { Currently being dispatched command in UsersNotify (prevent recursion) }
    {$ENDIF}
     {$IFDEF ULSTRING}
       { Sum of fields len of all FRec^ fields, equals to RecLen for records
         that have no longstring fields. Every longstring is stored to file
         as 4 bytes holding info about length of string that is stored in
         the following bytes. Is calculated runtime just before saving to
         stream during CountChildLen call - calculated just once during the
         save operation, then used this FRec.Info.FieldsLen value. Set back to zero
         after saving, so that it gets correctly recalculated during next save
         call if string value changed. }
     {$ENDIF}
    FFields: TULObjFields;
      { Dont dereference FFields, they only gets created by calling
        GetFields, i.e. by accessing Fields property }
    FDoChangeLockCount: integer;
      { How many times was DoChangeLock method called without calling DoChangeUnlock }
    FChangedCount: integer;
      { How many times was DoChange method called between DoChangeLock and DoChangeUnlock }
    FState : integer;
      { see osXXXX ulobject (runtime) states }
    {v0.14}
    FMainUser: TObject;
      { if non nil, then the FMainUser exists whole the
        time this ULObj exists (does not have to be in FUsers list). }
    {/v0.14}
  protected
    function GetRecID: TULRecID;
    procedure SetRecID(ARecID: TULRecID);
    function GetRecLen: TULRecLen;
    procedure SetRecLen(ARecLen: TULRecLen);
    function GetFlags: TULRecFlags;
    procedure SetFlags(AFlags: TULRecFlags);
    function GetOptions: TULRecOptions;
    procedure SetOptions(AOptions: TULRecOptions);
    function GetCreateTime: TDateTime;
    procedure SetCreateTime(ATime: TDateTime);
    function GetChangeTime: TDateTime;
    procedure SetChangeTime(ATime: TDateTime);
    function GetFileName:TFileName;
    procedure SetFileName(const AFileName: TFileName);
    procedure SetRecSize(ASize: longint);
      { Makes sure, that Rec^ has at least ASize allocated bytes (realloc). }
    function GetDataLen:longint;
      { Returns count of bytes that will be used to store all childs data
        to stream, i.e. CountChildLen for ChildType = ctULRec, Data.Size for
        ChildType = ctData, and 0 for ChildType = ctNone. }
    procedure SetDataLen(ADataLen:longint);
      { Updates FRec^.Info.DataLen field, eventually also Data.Size
        (for ChildType = ctData). }
    function GetChildType: TULRecChildType;
      { Returns what type of child data allowed for this RecID:
        ctNone, ctData, or ctULRec. }
    procedure DataStreamInit;virtual;
      { Initializes FData to TMemoryStream; can be overriden. }
    function CountChildLen:longint;
      { Calculates size needed for all TULRecs in Components/FChildList array
        to store them to stream. Ignores childs with rfTemporary flag set. }
    function GetMinRecLen: TULRecLen; virtual;
      { Override in descendants to return size of TxxxxRec,
        this size (or bigger if such loaded from file) will be
        used to set to RecLen (i.e. if from file was
        loaded smaller size - previous version size,
        the record will be made bigger - converting to new version size. }
    function CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj; virtual;
      { Creates TULxxObj descendants according to ARecID; abstract method,
        overriden in ULFObju.TULFObj ONLY. All other ULxx objects will
        call only this one (for object creation) through Add method. }
    function AddObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
      { Called by Add method with AOwner set to Self. Tries to find top owner
        ULFID object and call its' CreateObj method. }
    function GetChildCount: TULRecCount;
      { Returns ComponentCount }
    function GetChild(Index: integer): TULObj;
      { Returns pointer to objects from Childs.Items list at Index position }
    function GetChildList: TList;
      { Returns FChildList }
    {procedure UpdateChildCount; - not used anymore.
      { Sets FRec^.Info.RecCount field value to ComponentCount;
       called before saving to stream, just for data consistency checking
       purposes. }
    function NumToSortStr(ANum:Extended):string;
      { For use in overriden GetSortStr methods. }
    procedure DoOnCreate;
      { Called from Create and Load constructors just after inherited
        Create; creates private objects, sets default values. }
    function GetRecName: TULRecName;
      { Returns empty string if the record has not rfHasRecName flag set,
        otherwise returns value of the first field of the record
        (must have shortstring format) }
    function BrowseObj(AObj: TULObj): integer; virtual;
      { overriden in TULFObj to browse child records of AObj }
    function EditObj(AObj: TULObj{v0.16}; Modal:boolean{/v0.16}): integer; virtual;

    procedure AddRef;
      { called upon creation of instance; assigns FObjDesc, inc(ObjDesc.RefCount) }
    procedure DelRef;
      { called upon destroying of instance, dec(ObjDesc.RefCount) }
    function GetULRecDesc: PULRecDesc; virtual;
      { returns pointer to description of properties common to all instances
        this type; returns nil by default, overriden in descendants.
        Used just to assign it to ULObjDesc, that is using it. }
    function GetData:TStream;
      { returns stream that contain additional data (if rfNoULRecChild flag
        set) }
    procedure SetData(AStream: TStream);
    {$IFNDEF CONSOLE}
    procedure WMAppMessage(var Msg:TMessage);message WM_APPMESSAGE;
    {$ENDIF}
    function GetActiveChild: TULObj;
    procedure CountFieldsLen(recursive:boolean);
      { Should be called upon every change of longstring field; recursive=true
        when called before savetofile }
    {procedure ClearFieldsLen;}
    function GetFieldsLen: integer;
    function GetRecIDStr: TULRecIDStr;
    function GetFields: TULObjFields;
    function GetFieldCount: integer;

    function DoChangeLocked:boolean;
      { returns true if calling DoChange method was blocked by DoChangeLock }
    {v0.09}
    function GetState(os:TULObjStateFlag): boolean;
    procedure SetState(os:TULObjStateFlag; OnOff: boolean);
    function GetModified:boolean;
      { returns true if this object or any of it's child has osModified state
        flag set. osModified is cleared after loading from file or after
        saving to file, set by modifying any property. }{ulrectyp}
    procedure SetModified(OnOff: boolean);
      { if OnOff = true then set osModified state of the object to true,
        if OnOff = false clears osModified state of the object and all
        it's childs }
    function GetReadOnly: boolean;
    procedure SetReadOnly(OnOff: boolean);
    {/v0.09}
    {v0.13}
    function GetRelFileName: TFileName;
    {/v0.13}
    {v0.14}
    function GetRootFileName: TFileName;
      { returns name of the file in which the object is stored
        (if this is as child objects, looks for ULF object and
        returns its FileName) }
    function GetRootFileDir: TFileName;
      { ruturns just directory part of the RootFileNAme }
    {/v0.14}
    {v0.18}
    function GetTopOwner: TULObj;
    {$IFNDEF CONSOLE}
    function CopyToClipboard: boolean;{called through Assign}
    function ObjCopyToClipboard(o: TULObj): boolean; virtual;
    function CopyFromClipboard: boolean;{called through Assign}
    function ObjCopyFromClipboard(o: TULObj): boolean; virtual;
    {$ENDIF}
    {/v0.18}
  public
    procedure DoChangeLock;
      { call before more updates of childs are going to be made,  tcomponent
        prevents sending cmULObjUpdated message through the child owner
        many times. When updating is finished, call DoChangeUnlock. }
    procedure DoChangeUnlock;
      { Call after DoChangeLock and after child updates. If some child
        was really changed, cmULObjUpdated will be send for owner object. }

    procedure SetResult(AObjResult: TULObjResult; const msg: string);
    procedure UserRegister(AULObjUser: TObject);
      { Called from WMAppMessage if cmULObjUserRegister came, updates FUsers }
    procedure UserUnregister(AULObjUser: TObject);
      { Called from WMAppMessage if cmULObjUserUnregister came, updates FUsers }
    destructor Destroy; override;
    procedure BeforeDestruction;override;
    constructor Create(AOwner: TComponent; ARecID:TULRecID); reintroduce;
      { Create new ULObj with default values for given ARecID
        (override in descendants); if AOwner = nil, then ARecID must be ULFID. }
    constructor Load(const AFileName: TFileName);
      { Creates childs from given file - this instance will have ULFID
        and will hold other ULObjs loaded from the file in Components/FChildList array. }
    procedure LoadFromFile(const AFileName: TFileName);
      { Create child(s) ULObjs using data stored the file AFileName, opens
        TFileStream and calls LoadFromStream. }
    procedure SaveToFile(const AFileName: TFileName);
      { Save itself and all childs to AFileName; if AFileName = '' then
        FFileName used, if even this = '' then raise exception EEmptyFileName.
        If the FileName contains .ASC extension, then the file will be converted
        in ASCII (all objects). }
    procedure SaveToStream(AStream: TStream; var so: TStreamOptions);
      { Copies all its TULxxRec properties to the AStream, if has childs,
        calls also their SaveToStream. }
    procedure LoadRecFromStream(AStream: TStream; var so: TStreamOptions);
      { Loads record's fields from AStream, the Head of the record is already
        read. Called from LoadFromStream. }
    function LoadFromStream(AStream: TStream; var so: TStreamOptions; var AObj: TULObj):boolean;
      { Tries to create new child object by loading from stream, returns
        false if no data in the stream, raises exception if some error occurs }
    procedure Assign(Source: TPersistent); override;
      { copies Source's record data, childs, to itself; works also with clipboard }
    {v0.18}
    procedure AssignTo(Dest: TPersistent); override;
      { for assigning to clipboard }
    {/v0.18}
    procedure CheckRecSize(ASize: longint);
      { checks if RecSize is >= ASize, if not, exception EInvalidRecSize
        raised; Used before accessing fields in Rec^ }
    function Rec:PULRec;
      { returns pointer to record; it should never be used for changing
        values of the object properties. }
    function Add(ARecID: TULRecID): TULObj;
      { Use only this public method for creating of new instances of TULObj
        descendants (and add them to Components/FChildList array).
        Calls AddObj(Self, ARecID). }
    function FindOrAdd(ARecID: TULRecID; ARecName: TULRecName): TULObj;
      { Tries to find ARecID record in Child records, if found, return pointer
        to the objects, if not found, add it and return the pointer to the
        new object }
    function IsFlagSet(rf:TULRecFlags):boolean;
      { returns (rf ans Flags) = rf }
    procedure SetFlag(rf:TULRecFlags; OnOff:boolean);
      { performs for OnOff = true: Flags := Flags or rf;
                 for OnOff = false: Flags := Flags and (not rf); }
    function FindObj(ARecID:TULRecID; fo:TULRecFindOptions; const ARecName: string;
      var AObj:TULObj):boolean;
    {v0.20}
    function OwnsObj(AObj:TULObj): boolean;
      { owns directly or indirectly the AObj? }
    {/v0.20}
      { Find object in TULObj objects tree using specified parameters, see foXXXX }
    function GetSortStr: string; virtual;
      { used to implement sorted child arrays - if owner has rfChildSorted
        flag set, than new child added will be tested for it's GetSortStr
        value and inserted according its value (see ULFObju .TULFObj.CreateObj)
        should be overriden by in TULxxObj objects that are supposed to be
        sorted (peak, baseline records) }
    function GetSortNum:Extended; virtual;
      { as getsortstr, used instaed of GetSortStr if rfSortedByNumber flag set }
    function Browse: integer;
      { Call browser for Child records }
    function Edit: integer;
      { Call edit window for properties }
    {v0.16}
    function EditModal: integer;
    {/v0.16}
    function GetULRecDescOf(ARecID: TULRecID): PULRecDesc; virtual;
      { returns pointer to description of properties comman to all instances
        of record with recid = ARecID; overriden in TULFObj. }
    {$IFNDEF CONSOLE}
    function IsValidInput(AForm: TForm):boolean; virtual;
      { Called when object's properies were modified in edit form in
        corresponding edit controls (names of the controls are the same
        as the names of the properties, only 'Edit' is appended).
        Should return false (eventually pop up error message) if invalid input
        value found in some input control. }
    {$ENDIF}
    procedure Clear;
      { Frees all childs. }
    procedure Sort;
      { sort ChildList (if rfChildSorted flag set) }

    function CanDestroy:boolean;
      { Ask users if the object can destroy itself (they have pointer to it) }
    function UsersNotify(cm: word): integer;
      { Send WM_APPMESSAGE message to all users in FUsers list, supported:
        cmULObjUpdated (users should reflect changes made in ULObj properties),
        cmULObjDestroyed (users should invalidate their pointer to the ULObj) }
    procedure UsersUpdate;
      { Just shortcut for UsersNotify(cmULObjUpdated); called from DoChange
        (some property value or child changed). }
    procedure DoChange;
      { Should be called after any change of any property value or child
        value/count change, calls UsersUpdate = UsersNotify(cmULObjUpdated)
        and also Owner.DoChange }
    function ChildWithFlagFirst(AFlags: TULRecFlags): boolean;
      { returns true and set ActiveChild to the first child record that has
        all AFlags set; result = false if no such child found (used in ulbrowu.pas) }
    function ChildWithFlagNext(AFlags: TULRecFlags): boolean;
      { Returns true and set ActiveChild to the next child that has
        all AFlags set; result = false if no such child found
        (used in ulbrowu.pas) }
    function ChildWithFlagCount(AFlags: TULRecFlags): integer;

    procedure ToggleSelectChild(Index: integer; Shift: TShiftState);
      { Perform action as a response to mouse click on the child with index =
        Index }
    procedure ChildsDelete(ARecID: TULRecID; AFlags: TULRecFlags);
      { Delete all childs that have (RecID = ARecID) and (Flags and AFlags) = AFlags;
        if ARecID = 0 or AFlags = 0 that this property is not checked }
    function FindField(const AName: string): TULObjField;
      { raises exception if not found }
    {v0.13}
    function HasField(const AName: string; var AField: TULObjField): boolean;
      { as FindField, but not an error if not found }
    {/v0.13}
    {v0.14}
    procedure FillULEnumNames(AFieldIndex: integer; Items: TStrings);
      { for Field[AFieldIndex] (must be FldDesc.IsULEnum,
        FldDesc.ValuesSource must be also set), fill Items for TComboBox }
    function HasChildWithFieldUsrValue(const AFieldName: string; const AFieldUsrValue: string;
      var AChild: TULObj): boolean;
      { returns true if has some child ulobj record that has field of name AFieldName
        and the field has UsrValue = AFieldUsrValue }
    {/v0.14}
    {v0.18}
    function IsChildRecID(ARecID: TULRecID): boolean;
    {/v0.18}

    property Childs[Index: integer]: TULObj read GetChild; default;
    property ObjDesc: TULObjDesc read FObjDesc write FObjDesc;
    property ULRecDesc: PULRecDesc read GetULRecDesc;
      { Used only during create to get info for ObjDesc. Should not be
        used directly, use ObjDesc instead. }
    property ChildCount: TULRecCount read GetChildCount;
    property ChildList: TList read GetChildList;
    property RecSize: longint read FRecSize write SetRecSize;
    property RecLen: TULRecLen read GetRecLen write SetRecLen;
    property FileName: TFileName read GetFileName write SetFileName;
    property ChildType: TULRecChildType read GetChildType;
    property RecID: TULRecID read GetRecID write SetRecID;
    property RecName: TULRecName read GetRecName;
    property Data: TStream read GetData write SetData;
    property DataLen: longint read GetDataLen write SetDataLen;
    property ActiveChild: TULObj read GetActiveChild;
    property FieldsLen: integer read GetFieldsLen;
    property RecIDStr: TULRecIDStr read GetRecIDStr;
    property Fields: TULObjFields read GetFields;
    property FieldCount:integer read GetFieldCount;
    {v0.09}
    property Modified: boolean read GetModified write SetModified;
    property ReadOnly: boolean read GetReadOnly write SetReadOnly;
    {/v0.09}
    {v0.13}
    property RelFileName: TFileName read GetRelFileName;
    {/v0.13}
    {v0.14}
    property MainUser: TObject read FMainUser write FMainUser;
    property RootFileName: TFileName read GetRootFileName;
    property RootFileDir: TFileName read GetRootFileDir;
    {/v0.14}
    {v0.18}
    property TopOwner: TULObj read GetTopOwner;
    {/v0.18}
  published
    property Flags: TULRecFlags read GetFlags write SetFlags;
    property Options: TULRecOptions read GetOptions write SetOptions;
    property CreateTime: TDateTime read GetCreateTime write SetCreateTime;
    property ChangeTime: TDateTime read GetChangeTime write SetChangeTime;
  end;

{procedure Test;}

const
  CurULObj: TULObj = nil;
    { Set to object that should be acted upon e.g. in next browsing (ulbrowu.pas)
      or editing }
implementation

{TULObjField}
function TULObjField.GetValue: string;
var v: AnsiString;
begin
  if ClassGetPropStr(FObjFields.Obj, FFldDesc.RTIndex{ + FULObj.ObjDesc.FirstPropIndex}, v) then
    Result := v
  else
    Result := '';
end;

function TULObjField.GetUsrValue: string;
var
  d, l: integer;
  {v0.13}
  dt: TDateTime;
  {/v0.13}
begin
  if Assigned(OnGetUsrValue) then
    Result := OnGetUsrValue(GetValue)
  else begin
    Result := GetValue;
    if FFldDesc.UserCoef <> 0 then begin
      d := FFldDesc.NumDec;
      l := FFldDesc.BrowseWidth;
      if l = 0 then
        l := 10;
      if d <> 0 then begin
        Result := FloatToStrF(StrToFloat({v0.13}{/v0.13 FixDecSep}(Result))/FFldDesc.UserCoef, ffFixed, l, d);
      end else begin
        Result := FloatToStr(StrToFloat({v0.13}{/v0.13 FixDecSep}(Result))/FFldDesc.UserCoef);
      end;
    end{v0.13}
    else if FldDesc.IsFileDateTime then begin
      if Result <> '' then begin
        l := StrToInt(Result);
        if l <> 0 then begin
          dt := FileDateToDateTime(l);
          Result := DateTimeToStr(dt);
        end else
          Result := '';
      end;
    end;
    {/v0.13};
  end;
end;

procedure TULObjField.SetValue(const AValue: string);
{var uv: string;}
begin
  {uv := GetValue;
  if uv <> AValue then}
   { this check prevents unnecessary conversions that could round the results
     too much, ??? }
  begin
    {v0.13 FixDecSep was wrong here - was changing even string fields}
    if FFldDesc.TypeKind = tkFloat then begin
      if ClassSetPropStr(FObjFields.Obj, FFldDesc.RTIndex, FixDecSep(AValue)) = 0 then;
    end else begin
      if ClassSetPropStr(FObjFields.Obj, FFldDesc.RTIndex, AValue) = 0 then;
    end;
    {/v0.13
    if ClassSetPropStr(FObjFields.Obj, FFldDesc.RTIndex, FixDecSep(AValue)) = 0 then;}
  end;
end;

procedure TULObjField.SetUsrValue(const AUsrValue: string);
var
  s: string;
  {v0.13}
  dt: TDateTime;
  {/v0.13}
begin
  {v0.09}
  if FFldDesc.UserCoef <> 0 then begin
    s := FloatToStr(StrToFloat({v0.13}{/v0.13 FixDecSep}(AUsrValue))* FFldDesc.UserCoef);
    if Assigned(OnSetUsrValue) then begin
      SetValue(OnSetUsrValue(s))
    end else begin
      SetValue(s);
    end;
  end else
  {/v0.09}
  begin
    s := AUsrValue;
    {v0.13}
    if (s <> '') and FFldDesc.IsFileDateTime then begin
      dt := StrToDateTime(s);
      s := IntToStr(DateTimeToFileDate(dt));
    end;
    {/v0.13}
    if Assigned(OnSetUsrValue) then begin
      SetValue(OnSetUsrValue(s))
    end else begin
      SetValue(s);
    end;
  end;
end;

constructor TULObjField.Create(AOwner: TULObjFields; const AName: string );
var
  i: integer;
begin
  inherited Create;
  if AOwner = nil then
    raise EULObj.Create('TULObjField.Create: nil AOwner');
  FObjFields := AOwner;
  i := GetPropIndex(FObjFields.Obj, AName);
  if i < 0 then begin
    FObjFields.Obj.SetResult(orFieldNotFound, AName)
  end else begin
    with FObjFields.Obj.ObjDesc do begin
      FFldDesc := Fields[i - FirstPropIndex];
    end;
  end;
end;
{TULObjField}

{TULObjFields}
function TULObjFields.GetField(Index: integer): TULObjField;
begin
  Result := TULObjField(Items[Index]);
end;

constructor TULObjFields.Create(AOwner: TULObj; const AFieldNameList: string);
var
  fl:string;
  n: shortstring;
  v: AnsiString;
  i: integer;
  f: TULObjField;
const
  Delim = ',';
begin
  inherited Create;
  if AFieldNameList <> '' then
    fl := Delim + AFieldNameList + Delim
  else
    fl := '';
  FObj := AOwner;
  i := FObj.ObjDesc.FirstPropIndex;
  while ClassGetPropNameAndValue(AOwner, i, n, v) do begin
    if (fl = '') or (pos(Delim+n+Delim, fl) > 0) then begin
      f := TULObjField.Create(Self, n);
      Add(f);
    end;
    inc(i);
  end;
end;

procedure TULObjFields.ClearFields;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    Fields[i].Free;
  Clear;
end;

destructor TULObjFields.Destroy;
begin
  ClearFields;
  inherited;
end;
{/TULObjFields}

{TULObj}
procedure TULObj.CheckRecSize(ASize:longint);
begin
  if FRec = nil then
    SetResult(orEmptyRec, 'EmptyRec');
  if FRecSize < ASize then
    SetResult(orInvalidRecSize, 'InvalidRecSize ' + IntToStr(FRecSize) + ' x '
    + IntToStr(ASize));
end;

function TULObj.GetRecID: TULRecID;
begin
  CheckRecSize(ULRecSize);
  GetRecID := FRec^.Head.RecID;
end;

procedure TULObj.SetRecID(ARecID: TULRecID);
begin
  CheckRecSize(ULRecSize);
  FRec^.Head.RecID := ARecID;
  if ARecID = ULFID then
    SetFlag(rfChildAllowed, true);
end;

function TULObj.GetRecLen: TULRecLen;
begin
  CheckRecSize(ULRecSize);
  GetRecLen := FRec^.Head.RecLen;
end;

procedure TULObj.SetRecLen(ARecLen: TULRecLen);
begin
  RecSize := ARecLen;
    { will eventually increase FRecSize to ARecLen, otherwise
      FRecSize unchanged }
  FRec^.Head.RecLen := ARecLen;
end;

function TULObj.GetFlags: TULRecFlags;
begin
  CheckRecSize(ULRecSize);
  GetFlags := FRec^.Info.Flags;
end;

procedure TULObj.SetFlags(AFlags: TULRecFlags);
begin
  CheckRecSize(ULRecSize);
  FRec^.Info.Flags := AFlags;
end;

function TULObj.GetOptions: TULRecOptions;
begin
  CheckRecSize(ULRecSize);
  GetOptions := FRec^.Info.Options;
end;

procedure TULObj.SetOptions(AOptions: TULRecOptions);
begin
  CheckRecSize(ULRecSize);
  FRec^.Info.Options := AOptions;
end;

function TULObj.GetCreateTime: TDateTime;
begin
  CheckRecSize(ULRecSize);
  GetCreateTime := FRec^.Info.CreateTime;
end;

procedure TULObj.SetCreateTime(ATime: TDateTime);
begin
  CheckRecSize(ULRecSize);
  FRec^.Info.CreateTime := ATime;
end;

function TULObj.GetChangeTime: TDateTime;
begin
  CheckRecSize(ULRecSize);
  GetChangeTime := FRec^.Info.ChangeTime;
end;

procedure TULObj.SetChangeTime(ATime: TDateTime);
begin
  CheckRecSize(ULRecSize);
  FRec^.Info.ChangeTime := ATime;
end;

procedure TULObj.DoOnCreate;
begin
  FChildList := TList.Create;
  RecLen := GetMinRecLen;
  CountFieldsLen(false);
  Flags := rfDefault;
  CreateTime := Now;
  ChangeTime := Now;
end;

constructor TULObj.Create(AOwner: TComponent; ARecID:TULRecID);
begin
  inherited Create(AOwner);
  DoOnCreate;
  RecID := ARecID;
  if AOwner = nil then begin
    if RecID <> ULFID then begin
      SetResult(orMustHaveOwner, 'Must have owner ' + RecIDStr);
    end;
  end;
  AddRef;
end;

constructor TULObj.Load(const AFileName: TFileName);
      { creates all from given file }
begin
  inherited Create(nil);
  DoOnCreate;
  RecID := ULFID;
  AddRef;
  LoadFromFile(AFileName);
end;

function TULObj.GetMinRecLen: TULRecLen;
begin
  GetMinRecLen := ULRecSize;
end;

procedure TULObj.LoadFromFile(const AFileName: TFileName);
  { create ULObj childs using data stored the file AFileName,
    opens stream and calls LoadRecFromStream }
var
  s: TFileStream;
  o: TULObj;
  e: string;
  so: TStreamOptions;
begin
  if AFileName <> '' then
    FileName := AFileName;
  if FileName = '' then
    SetResult(orEmptyFileName, 'LoadFromFile');
  e := UpperCase(ExtractFileExt(FileName));
  FillChar(so, sizeof(so), 0);
  if e = AscExt then
    so.Flags := sfAscii;
  s := nil;
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromFile ' + AFileName + ' begin');
  {$ENDIF}
  try
    s := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyWrite);
    repeat
    until not LoadFromStream(s, so, o);
  finally
    s.Free;
  end;
  {v0.09}
  Modified := false;
  {/v0.09}
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromFile ' + AFileName + ' end');
  {$ENDIF}
end;

function TULObj.LoadFromStream(AStream: TStream; var so: TStreamOptions;
  var AObj: TULObj):boolean;
var
  head: TULRecHead;
  {v0.18}
  l:longint;
  {/v0.18}

  procedure LoadAsciiHead;
  var
    s, ul: shortstring;
    i: integer;
    r: TULRecID;
  begin
    if so.Head <> '' then begin
      s := so.Head;
      so.Head := '';
    end else begin
      if not StreamReadln(AStream, s) then
        SetResult(orInvalidAscFormat, 'Invalid ASC format. Line ' + IntToStr(so.Line));
      inc(so.Line);
    end;
    i := pos(AscBeginTag, s);
    if i = 0 then
      SetResult(orInvalidAscFormat, 'Invalid ASC format - "' + AscBeginTag +
        '" missing. Line ' + IntToStr(so.Line));
    ul := Trim(Copy(s, 1, i - 1));
    r := StrToULRecID(ul);{ulrecutl}
    AObj := Add(r);
    so.IndentLevel := so.IndentLevel + '  ';
  end;

begin
  LoadFromStream := false;
  AObj := nil;
  if AStream.Position = AStream.Size then
    exit;
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromStream begin pos=' + IntToStr(AStream.Position));
  {$ENDIF}
  if (so.Flags and sfAscii) <> 0 then begin
    LoadAsciiHead;
  end else begin
    {v0.18}
    l := AStream.Read(head, sizeof(head));
    if (l <> sizeof(head)) or (head.RecID = 0) then begin
      exit;
    end;
    {/v0.18
    AStream.ReadBuffer(head, sizeof(head));}
    {$IFDEF DEBLOAD}
      DebLog('ULObj.LoadFromStream head: ID=' + ULRecIDToStr(head.RecID) +
        ' RecLen=' + IntToStr(head.RecLen));
    {$ENDIF}
    AObj := Add(head.RecID);
    AObj.RecSize := head.RecLen;
      { Makes sure that FRec has allocated enough mem for the record from file }
    AObj.Rec^.Head := head;
      { Rec^.Head.RecLen must be set to head.RecLen, for the case the
        record size in the file is different (dif. file version) then the
        default one set during Add }
  end;
  AObj.LoadRecFromStream(AStream, so);
  if (so.Flags and sfAscii) = 0 then begin
    if AObj.GetMinRecLen <> head.RecLen then begin
      AObj.SetRecLen(AObj.GetMinRecLen);
        { set back the default record size (eventual additional record fields from
          different file version not usable by current version, eventually
          missing fields set to default values) }
      {$IFDEF DEBLOAD}
        DebLog('ULObj.LoadFromStream reset default RecLen=' + IntToStr(AObj.GetMinRecLen) +
          ', in File was RecLen=' + IntToStr(head.RecLen));
      {$ENDIF}
    end;
  end;
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromStream end pos=' + IntToStr(AStream.Position));
  {$ENDIF}
  LoadFromStream := true;
end;

procedure TULObj.LoadRecFromStream(AStream: TStream; var so: TStreamOptions);
  { loads record data from AStream }
var
  endpos: longint;
  o: TULObj;

  procedure ReadAsciiRec;
  var
    s, pn, pv: shortstring;
    i: integer;
  begin
    repeat
      if StreamReadLn(AStream, s) then begin
        inc(so.Line);
        if so.IsInData then begin
          if AscEndTag = trim(s) then begin
            so.IsInData := false;
          end else begin
            s := Trim(s);
            s := HexToString(s);
            Data.WriteBuffer(s[1], length(s));
          end;
        end else begin
          if pos('Data' + AscBeginTag, s) > 0 then begin
            so.IsInData := true;
            Data.Position := 0;
          end else if pos(AscBeginTag, s) > 0 then begin
            so.Head := s;
            LoadFromStream(AStream, so, o);
          end else if trim(s) = AscEndTag then begin
            SetLength(so.IndentLevel, length(so.IndentLevel) - 2);
            break;
          end else begin
            s := LTrim(s);
            i := pos(AscValDelimiter, s);
            if i = 0 then begin
              SetResult(orInvalidAscFormat, 'Invalid Asc format: "' +
                AscValDelimiter + '" missing. Line ' + IntToStr(so.Line));
            end else begin
              pn := copy(s, 1, i - 1);
              pv := copy(s, i + 1, 255);
              if ClassSetPropStr(Self, pn, pv) > 0 then;
            end;
          end;
        end;
      end else begin
        SetResult(orInvalidAscFormat, 'Invalid Asc format: "' +
          AscEndTag + '" missing. Line ' +
          IntToStr(so.Line));
      end;
    until false;
  end;

begin
  if RecID = ULFID then
    SetResult(orULFCantLoadRecFromStream, 'ULF can not LoadRecFromStream');
  if (so.Flags and sfAscii) <> 0 then begin
    ReadAsciiRec;
  end else begin
    {AStream.ReadBuffer(FRec^.Info, FRec^.Head.RecLen - sizeof(FRec^.Head));}
    AStream.ReadBuffer(FRec^.Info, sizeof(FRec^.Info));
    FRec^.Info.FieldsLen := ClassReadPropsFromStream(Self, FObjDesc.FirstPropIndex,
      FRec^.Info.FieldsLen - sizeof(TULRecHead) - sizeof(TULRecInfo), AStream)
      + sizeof(TULRecHead) + sizeof(TULRecInfo);

    case GetChildType of
      ctData: begin
        if FRec^.Info.DataLen > 0 then
          Data.CopyFrom(AStream, FRec^.Info.DataLen);
      end;
      ctULRec: begin
        endpos := AStream.Position + FRec^.Info.DataLen;
        while AStream.Position < endpos do begin
          if not LoadFromStream(AStream, so, o) then
            SetResult(orInvalidULRecDataLen, 'LoadRecFromStream');
        end;
      end;
    end;
  end;
end;

procedure TULObj.SaveToFile(const AFileName: TFileName);
  { save itself (if not RecID = ULFID) and all childs to AFileName;
    if AFileName = '' then FFileName used, if even this = '' then
    raise exception EEmptyFileName }
var
  AStream: TFileStream;
  tmp: TFileName;
  e: string;
  so: TStreamOptions;
begin
  if AFileName <> '' then
    FileName := AFileName;
  if FileName = '' then
    SetResult(orEmptyFileName, 'SaveToFile');
  e := UpperCase(ExtractFileExt(FileName));
  FillChar(so, sizeof(so), 0);
  if e = AscExt then
    so.Flags := sfAscii;
  AStream := nil;
  tmp := ReplaceExt(FileName, TmpExt, true);
  if FileExists(tmp) then
    DeleteFile(tmp);
  CountFieldsLen(true);
  try
    try
      AStream := TFileStream.Create(tmp, fmCreate or fmShareExclusive);
        { if exists, opens in write mode }
      SaveToStream(AStream, so);
    finally
      AStream.Free;
    end;
    {v0.09}
    if so.Flags <> sfAscii then
      Modified := false;
    {/0.09}
  except
    DeleteFile(tmp);
    raise;
  end;
  DeleteFile(FileName);
  RenameFile(tmp, FileName);
end;

procedure TULObj.SaveToStream(AStream: TStream; var so: TStreamOptions);
  { copies all its TULxxRec properties to the AStream, if has childs,
    calls also their SaveToStream }
var
  i: integer;
  asciiHeadWritten: boolean;
  {v0.18}
  ch:TULObj;
  {/v0.18}

  procedure WriteAsciiHead;
  var
    i: integer;
    pn: shortstring;
    pv: AnsiString;
  begin
    asciiHeadWritten:= true;
    i := 0;
    StreamWriteln(AStream, so.IndentLevel + {v0.14}ULRecIDToStrStrip(RecID)
      {/v0.14 ULRecIDToStr(RecID)} + AscBeginTag);
    so.IndentLevel := so.IndentLevel + '  ';
    while ClassGetPropNameAndValue(TObject(Self), i, pn, pv) do begin
      StreamWriteln(AStream, so.IndentLevel + pn + AscValDelimiter + pv);
      inc(i);
    end;
  end;

  procedure WriteBinHead;
  begin
    {AStream.WriteBuffer(FRec^, FRec^.Head.RecLen);}
    AStream.WriteBuffer(FRec^, sizeof(FRec^.Head) + sizeof(FRec^.Info));
    ClassWritePropsToStream(Self, FObjDesc.FirstPropIndex, AStream);
  end;

  procedure WriteAsciiData;
  var
    s: shortstring;
    i: integer;
  begin
    StreamWriteln(AStream, so.IndentLevel + 'Data begin');
    repeat
      i := Data.Read(s[1], 36);
      if i = 0 then
        break;
      SetLength(s, i);
      s := StringToHex(s);
      StreamWriteln(AStream, so.IndentLevel + '  ' + s);
    until false;
    StreamWriteln(AStream, so.IndentLevel + 'end');
  end;

  procedure WriteAsciiTail;
  begin
    SetLength(so.IndentLevel, length(so.IndentLevel) - 2);
    StreamWriteln(AStream, so.IndentLevel + 'end');
  end;

begin
  if RecID <> ULFID then begin
    if not IsFlagSet(rfTemporary) then begin
      asciiHeadWritten := false;
      if FRecSize <> 0 then begin
        {UpdateChildCount;}
        if RecLen < GetMinRecLen then
          RecLen := GetMinRecLen;
        case GetChildType of
          ctData, ctULRec: begin
            DataLen := DataLen;
             { makes sure thet Rec^.Info.DataLen is updated }
          end;
        end;
        if (so.Flags and sfAscii) <> 0 then begin
          WriteAsciiHead;
        end else begin
          WriteBinHead;
        end;
      end;
      case GetChildType of
        ctData: begin
          if (Data.Size > 0) then begin
            Data.Position := 0;
            if (so.Flags and sfAscii) <> 0 then begin
              WriteAsciiData;
            end else begin
              AStream.CopyFrom(Data, Data.Size);
            end;
          end;
        end;
        ctULRec: begin
          for i := 0 to FChildList.Count {ComponentCount} - 1 do begin
            {v0.18}
            ch := TULObj(FChildList.Items[i]);
            if ((so.Flags and sfOnlySelectedChilds) = 0) or ch.IsFlagSet(rfSelected) then
              ch.SaveToStream(AStream, so);
            {/v0.18
              TULObj(FChildList.Items[i]).SaveToStream(AStream, so);
            }
          end;
        end;
      end;
      if asciiHeadWritten then begin
        WriteAsciiTail;
      end;
    end;
  end else begin
    for i := 0 to FChildList.Count{ComponentCount} - 1 do begin
      {v0.18}
      ch := TULObj(FChildList.Items[i]);
      if ((so.Flags and sfOnlySelectedChilds) = 0) or ch.IsFlagSet(rfSelected) then
        ch.SaveToStream(AStream, so);
      {/v0.18
       TULObj(FChildList.Items[i]).SaveToStream(AStream, so);
      }
    end;
    AStream.Size := AStream.Position; { truncate }
  end;
end;

procedure TULObj.Assign(Source: TPersistent);
  { copies Source's record data to itself }
var
  i: integer;
  s, d: TULObj;
  m: TMemoryStream;
  pn: shortstring;
  pv: AnsiString;
  l: integer;
begin
  if Source is TULObj then begin
    if (TULObj(Source).RecID = RecID) then
    begin
      SetRecSize(TULObj(Source).RecLen);
      Rec^.Head := TULObj(Source).Rec^.Head;
      Rec^.Info := TULObj(Source).Rec^.Info;
      m := TMemoryStream.Create;
      ClassWritePropsToStream(Source, FObjDesc.FirstPropIndex, m);
      m.Position := 0;
      Rec^.Info.FieldsLen := ClassReadPropsFromStream(Self, FObjDesc.FirstPropIndex,
        Rec^.Info.FieldsLen - sizeof(TULRecHead) - sizeof(TULRecInfo), m)
        + sizeof(TULRecHead) + sizeof(TULRecInfo);
      m.Free;
    end else begin
      Rec^.Head := TULObj(Source).Rec^.Head;
      Rec^.Info := TULObj(Source).Rec^.Info;
      l := sizeof(TULRecHead) + sizeof(TULRecInfo);
      i := TULObj(Source).ObjDesc.FirstPropIndex;
      while ClassGetPropNameAndValue(Source, i, pn, pv) do begin
        inc(i);
        l := l + ClassSetPropStr(Self, pn, pv);
      end;
      Rec^.Info.FieldsLen := l;
    end;

    case GetChildType of
      ctULRec: begin
        Clear;
        for i := 0 to TULObj(Source).ChildCount - 1 do begin
          s := TULObj(Source).Childs[i];
          d := Add(s.RecID);
          d.Assign(s);
        end;
      end;
      ctData: begin
        Data.Size := 0;
        Data.CopyFrom(TULObj(Source).Data, 0);
      end;
    end;

  end else {v0.18} {$IFNDEF CONSOLE} if Source is TClipboard then begin
    if not CopyFromClipboard then
      inherited;
  end else {$ENDIF} {/v0.18}
    inherited
end;

{v0.18}
function TULObj.GetTopOwner: TULObj;
var o: TULObj;
begin
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner, 'GetTopOwner');
      if o.RecID <> ULFID then begin
        o := TULObj(o.Owner);
      end else begin
        Result := o;
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound, 'GetTopOwner');
  until false;
end;

{$IFNDEF CONSOLE}
function TULObj.ObjCopyToClipboard(o: TULObj): boolean;
begin
  Result := false;
end;

function TULObj.CopyToClipboard: boolean;
var o: TULObj;
begin
  Result := TopOwner.ObjCopyToClipboard(Self);
end;

function TULObj.ObjCopyFromClipboard(o: TULObj): boolean;
begin
  Result := false;
end;

function TULObj.CopyFromClipboard: boolean;
var o: TULObj;
begin
  Result := TopOwner.ObjCopyFromClipboard(Self);
end;
{$ENDIF}

procedure TULObj.AssignTo(Dest: TPersistent);
begin
  {$IFNDEF CONSOLE}
  if Dest is TClipboard then begin
    if not CopyToClipboard then
      inherited;
  end else
  {$ENDIF}
    inherited;
end;
{/v0.18}

procedure TULObj.SetRecSize(ASize: longint);
var d: PULRec;
begin
  if ASize < 0 then
    SetResult(orNegativeRecSize, IntToStr(ASize));
  if FRecSize < ASize then begin
    if (ASize > 0) and (FRecSize > 0) then begin
      GetMem(d, ASize);
      FillChar(d^, ASize, 0);
      Move(FRec^, d^, Min(FRecSize, ASize));
      FRecSize := 0;
      FreeMem(FRec);
      FRec := d;
      FRecSize := ASize;
    end else begin
      FRecSize := 0;
      if FRec <> nil then
        FreeMem(FRec);
      if ASize > 0 then begin
        GetMem(FRec, ASize);
        FillChar(FRec^, ASize, 0);
        FRecSize := ASize;
      end else begin
        FRec := nil;
      end;
      FRec.Head.RecLen := ASize;
    end;
  end;
end;

function TULObj.Rec:PULRec;
begin
  Rec := FRec;
end;

function TULObj.Add(ARecID: TULRecID): TULObj;
begin
  if ChildType = ctNone then begin
    SetResult(orNoChildAllowed, 'Add ' +
      ULRecIDToStr(ARecID));
  end;
  DoChangeLock;
  try
    Add := AddObj(Self, ARecID);
    DoChange;
  finally
    DoChangeUnlock;
  end;
end;

function TULObj.FindOrAdd(ARecID: TULRecID; ARecName: TULRecName): TULObj;
var
  o: TULObj;
begin
  if not FindObj(ARecID, foNotSelf + foNotRecursive, ARecName, o) then
    o := Add(ARecID);
  FindOrAdd := o;
end;

function TULObj.AddObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
var o: TULObj;
begin
  AddObj := nil;
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner,'AddObj');
      if o.RecID <> ULFID then begin
        o := TULObj(o.Owner);
      end else begin
        AddObj := o.CreateObj(AOwner, ARecID);
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound,'AddObj');
  until false;
end;

function TULObj.CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
begin
  Result := nil;
  SetResult(orAbstractCreateObj, 'Only TULFObj.CreateObj should be used.');
{  TULObj.Create(Self, ARecID);}
end;

function TULObj.Browse: integer;
{$IFNDEF CONSOLE}var o: TULObj;{$ENDIF}
begin
{$IFNDEF CONSOLE}
  Browse := mrCancel;
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner, 'Browse');
      if o.RecID <> ULFID then begin
        o := TULObj(o.Owner);
      end else begin
        Browse := o.BrowseObj(Self);
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound,'Browse');
  until false;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TULObj.Edit: integer;
{$IFNDEF CONSOLE}
var o: TULObj;
begin
  Edit := mrCancel;
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner, 'Edit');
      if o.RecID <> ULFID then begin
        o := TULObj(o.Owner);
      end else begin
        Edit := o.EditObj(Self, false);
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound,'Edit');
  until false;
end;
{$ELSE}
begin
  Result := 0;
end;
{$ENDIF}

{v0.16}
function TULObj.EditModal: integer;
{$IFNDEF CONSOLE}
var o: TULObj;
begin
  EditModal := mrCancel;
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner, 'EditModal');
      if o.RecID <> ULFID then begin
        o := TULObj(o.Owner);
      end else begin
        EditModal := o.EditObj(Self, true);
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound,'EditModal');
  until false;
end;
{$ELSE}
begin
  Result := 0;
end;
{$ENDIF}
{/v0.16}

function TULObj.BrowseObj(AObj: TULObj):integer;
  { overriden in TULFObj to browse child records of AObj }
begin
  Result := 0;
  SetResult(orAbstractBrowseObj,'Only TULFObj.BrowseObj should be used.');
end;

function TULObj.EditObj(AObj: TULObj; Modal:boolean):integer;
  { overriden in TULFObj to edit AObj }
begin
  Result := 0;
  SetResult(orAbstractEditObj, 'Only TULFObj.EditObj should be used.');
end;

function TULObj.GetFileName:TFileName;
begin
  GetFileName := FFileName;
end;

procedure TULObj.SetFileName(const AFileName: TFileName);
begin
  FFileName := AFileName;
end;

function TULObj.IsFlagSet(rf:TULRecFlags):boolean;
      { returns (rf ans Flags) <> 0 }
begin
  IsFlagSet := (rf and Flags) = rf;
end;

procedure TULObj.SetFlag(rf:TULRecFlags; OnOff:boolean);
      { performs for OnOff = true: Flags := Flags or rf;
                 for OnOff = false: Flags := Flags and (not rf); }
begin
  if OnOff then
    SetFlags(Flags or rf)
  else
    SetFlags(Flags and (not rf));
  if (rf and rfSelected) <> 0 then
    DoChange;
end;

procedure TULObj.DataStreamInit;
begin
  if FData = nil then begin
    if IsFlagSet(rfFileDataStream) then begin
      if not IsFlagSet(rfHasRecName) then
        SetResult(orFileDataStreamMustHasRecName, 'DataStreamInit');
      FData := TFileStream.Create(RecName, fmOpenReadWrite);
    end else begin
      FData := TMemoryStream.Create;
    end;
  end;
end;

procedure TULObj.BeforeDestruction;
begin
{  if (Owner <> nil) and (Owner is TULObj) then begin
    l := TULObj(Owner).ChildList;
    i  := l.IndexOf(Self);
    if i >= 0 then
      l.Delete(i);
    TULObj(Owner).DoChange;
  end;}
  inherited;
end;

destructor TULObj.Destroy;
var
  l: TList;
  i: integer;
begin
  UsersNotify(cmULObjDestroyed);
  FUsers.Free;
  if (Owner <> nil) and (Owner is TULObj) then begin
    l := TULObj(Owner).ChildList;
    i  := l.IndexOf(Self);
    if i >= 0 then
      l.Delete(i);
    TULObj(Owner).DoChange;
  end;
  DelRef;
  FChildList.Free;
  FData.Free;
  FreeMem(FRec);{RecSize := 0;}
  FFields.Free;
  inherited;
end;

function TULObj.CountChildLen:longint;
var
  l, i: longint;
  o: TULObj;
begin
  l := 0;
  for i := 0 to ChildCount - 1 do begin
    o := Childs[i];
    if not o.IsFlagSet(rfTemporary) then begin
      l := l + {$IFDEF ULSTRING}o.FieldsLen{$ELSE}o.RecLen{$ENDIF} + o.DataLen;
    end;
  end;
  CountChildLen := l;
end;

function TULObj.GetDataLen:longint;
begin
  case GetChildType of
    ctData: begin
      if FData = nil then
        GetDataLen := 0
      else
        GetDataLen := FData.Size;
    end;
    ctULRec: begin
      GetDataLen := CountChildLen;
    end;
  else
    GetDataLen := 0;
  end;
end;

procedure TULObj.SetDataLen(ADataLen:longint);
begin
  CheckRecSize(ULRecSize);
  case GetChildType of
    ctData: begin
      Data.Size := ADataLen;
    end;
    ctULRec: begin

    end;
  else
    if ADataLen <> 0 then
      SetResult(orNoChildAllowed,'SetDataLen ' + IntToStr(ADataLen));
  end;
  FRec^.Info.DataLen := ADataLen;
end;

function TULObj.GetData:TStream;
begin
  if GetChildType <> ctData then
    SetResult(orInvalidChildType,'Data ' + IntToStr(GetChildType));
  DataStreamInit;
  GetData := FData;
end;

procedure TULObj.SetData(AStream: TStream);
begin
  if GetChildType <> ctData then
    SetResult(orInvalidChildType,'Data ' + IntToStr(GetChildType));
  if FData <> nil then
    FData.Free;
  FData := AStream;
end;

function TULObj.GetChildType: TULRecChildType;
begin
  GetChildType := ctNone;
  if IsFlagSet(rfChildAllowed) then begin
    if IsFlagSet(rfDataChild) then
      GetChildType := ctData
    else
      GetChildType := ctULRec;
  end;
end;

function TULObj.GetChildCount: TULRecCount;
begin
  GetChildCount := FChildList.Count;
end;

function TULObj.GetChild(Index: integer): TULObj;
begin
  GetChild := TULObj(FChildList.Items[Index]);
end;

function TULObj.GetChildList: TList;
begin
  GetChildList := FChildList;
end;

(*
procedure TULObj.UpdateChildCount;
  { Sets FRec^.Info.RecCount field value to ComponentCount;
    called before saving to stream, just for data consistency checking purposes. }
begin
  CheckRecSize(ULRecSize);
  FRec^.Info.RecCount := ChildCount;{ComponentCount;}
end;
*)
function TULObj.FindObj(ARecID:TULRecID; fo:TULRecFindOptions;
  const ARecName: string; var AObj:TULObj):boolean;
var
  o,c: TULObj;
  lastReached:boolean;
  i:integer;
begin
  FindObj := false;
  lastReached := ((fo and foNext) = 0) or (AObj = nil);
  o := Self;
  if (fo and foFromOwner) <> 0 then begin
    fo := fo and (not foFromOwner);
    if Owner <> nil then
      o := TULObj(Owner);
  end else if (fo and foFromRoot) <> 0 then begin
    fo := fo and (not foFromRoot);
    while o.Owner <> nil do
      o := TULObj(o.Owner);
  end;

  {v0.13}i := -1;{/v0.13 i := 0;}
  c := nil;
  if (o = Self) and ((fo and foNotSelf) <> 0) then begin
    fo := fo and (not foNotSelf);
    {
    if o.ComponentCount > 0 then begin
      c := TULObj(o.Components[i]);
      inc(i);
    end;
    }
    if o.ChildCount > 0 then begin
      {v0.13}inc(i);{/v0.13}
      c := TULObj(o.Childs[i]);
      {v0.13}{/v0.13 inc(i);}
    end;
  end else begin
    c := o;
  end;

  while c <> nil do begin
    if (c.RecID = ARecID) and
       ((ARecName = '') or (ARecName = c.RecName))
    then begin
      if (fo and foNext) <> 0 then begin
        if lastReached then begin
          AObj := c;
          FindObj := true;
          break;
        end else begin
          if AObj = c then begin
            lastReached := true;
            AObj := nil;
          end;
        end;
      end else begin
        AObj := c;
        FindObj := true;
        break;
      end;
    end;
    {v0.13}{/v0.13
    if i >= o.ChildCount then
      break;}
    if (c <> o) then begin
      if {(c.Owner = o) or }((fo and foNotRecursive) = 0) then begin
        if c.FindObj(ARecID, fo, ARecName, AObj) then begin
          FindObj := true;
          break;
        end;
      end;
    end;
    {v0.13}
    inc(i);
    if i >= o.ChildCount then
      break;
    {/v0.13}
    c := TULObj(o.Childs[i]{Components[i]});
    {v0.13}{/v0.13  inc(i);}
  end;
end;

{v0.20}
function TULObj.OwnsObj(AObj: TULObj): boolean;
var
  o: TULObj;
  i: integer;
begin
  Result := false;
  for i := 0 to ChildCount - 1 do begin
    o := Childs[i];
    if o = AObj then begin
      Result := true;
      exit;
    end else begin
      Result := o.OwnsObj(AObj);
    end;
  end;
end;
{/v0.20}

function TULObj.GetSortNum:Extended;
begin
  GetSortNum := 0;
end;

function TULObj.GetSortStr: string;
begin
  GetSortStr := '';
end;

function TULObj.NumToSortStr(ANum:Extended):string;
begin
  NumToSortStr := FloatToStrF(ANum, ffFixed, SortStrPrecision, SortStrDigits);
end;

function TULObj.GetRecName: TULRecName;
begin
  if IsFlagSet(rfHasRecName) then begin
    CheckRecSize(ULRecSize + 1);
    GetRecName := PULRecMax(FRec)^.RecName;
  end else begin
    GetRecName := '';
  end;
end;

procedure TULObj.AddRef;
begin
  if ObjDescs = nil then begin
    ObjDescs := TULObjDescs.Create;
  end;
  if not ObjDescs.FindInfo(RecID, FObjDesc) then begin
    FObjDesc := TULObjDesc.Create(Self);
    ObjDescs.Add(FObjDesc);
  end;
  FObjDesc.IncRefCount;
  FRec^.Info.Flags := FRec^.Info.Flags or FObjDesc.Flags;
end;

procedure TULObj.DelRef;
begin
  if FObjDesc <> nil then begin
    FObjDesc.DecRefCount;
  end;
end;

function TULObj.GetULRecDesc: PULRecDesc;
begin
  Result := nil;
end;

function TULObj.GetULRecDescOf(ARecID: TULRecID): PULRecDesc;
 { Returns pointer to description of properties comman to all instances
   of record with recid = ARecID; overriden in TULFObj. }
var
  o: TULObj;
begin
  Result := nil;
  o := Self;
  while (o <> nil) and (o is TULObj) do begin
    if o.RecID = ULFID then begin
      Result := o.GetULRecDescOf(ARecID);
      break;
    end else
      o := TULObj(o.Owner);
  end;
  if (o = nil) or (not (o is TULObj)) then
    SetResult(orULFTopOwnerNotFound,'GetULRecDescOF');
end;

{$IFNDEF CONSOLE}
function TULObj.IsValidInput(AForm: TForm): boolean;
begin
  Result := true;
end;
{$ENDIF}

procedure TULObj.Clear;
begin
  DoChangeLock;
  try
    while ChildCount > 0 do
      Childs[0].Free;
   {if ChildCount > 0 then begin
      DestroyComponents;
      FChildList.Clear;
      DoChange;
    end;}
  finally
    DoChangeUnlock;
  end;
end;

function ChildCompare(Item1, Item2: pointer): integer;
var s1,s2:string;
begin
  s1 := TULObj(Item1).GetSortStr;
  s2 := TULObj(Item2).GetSortStr;
  if s1 = s2 then
    Result := 0
  else if s1 < s2 then
    Result := -1
  else
    Result := 1;
end;

function ChildCompareNum(Item1, Item2: pointer): integer;
var e1,e2: extended;
begin
  e1 := TULObj(Item1).GetSortNum;
  e2 := TULObj(Item2).GetSortNum;
  if e1 = e2 then
    Result := 0
  else if e1 < e2 then
    Result := -1
  else
    Result := 1;
end;

procedure TULObj.Sort;
begin
  if not IsFlagSet(rfChildSorted) then
    exit;
  if ChildCount = 0 then
    exit;
  if IsFlagSet(rfSortedByNumber) then
    FChildList.Sort(ChildCompareNum)
  else
    FChildList.Sort(ChildCompare);
  {TList}
end;

{$IFNDEF CONSOLE}
procedure TULObj.WMAppMessage(var Msg: TMessage);
begin
  case Msg.WParam of
    cmULObjUserRegister: UserRegister(TObject(Msg.LParam));
    cmULObjUserUnregister: UserUnregister(TObject(Msg.LParam));
  end;
end;
{$ENDIF}

procedure TULObj.UserRegister(AULObjUser: TObject);
  { called from WMAppMessage if cmULUserCreated came, updates FUsers }
begin
  if FUsers = nil then
    FUsers := TList.Create;
  if RecID = ord('U') + 256*ord('L') + 256*256*ord('N'){ulntype ULNID} then begin
  end;
  FUsers.Add(AULObjUser);
end;

procedure TULObj.UserUnregister(AULObjUser: TObject);
  { called from WMAppMessage if cmULUserDestroyed came, updates FUsers }
var
  i: integer;
begin
  i := -1;
  if (FUsers <> nil) then begin
    i := FUsers.IndexOf(AULObjUser);
    if i >= 0 then begin
      FUsers.Delete(i);
    end;
  end;
  if i < 0 then
    SetResult(orUnregisteredUser,'ULObj: Trying unregister unregistered user.');
end;

function TULObj.CanDestroy:boolean;
        { ask users if the object can destroy itself (they have pointer to it) }
{$IFNDEF CONSOLE}
var
  msg: TMessage;
  i: integer;
begin
  Result := false;
  if (FUsers <> nil) and (FUsers.Count > 0) then begin
    for i := 0 to FUsers.Count - 1 do begin
      fillchar(msg, sizeof(msg), 0);
      msg.msg := WM_APPMESSAGE;
      msg.wParam := cmULObjCanDestroy;
      msg.lParam := longint(Self);
      TObject(FUsers.Items[i]).Dispatch(msg);
      if msg.Result <> 0 then
        exit;
    end;
  end;
  Result := true;
end;
{$ELSE}
begin
  Result := true;
end;
{$ENDIF}

function TULObj.UsersNotify(cm: word): integer;
  { send WM_APPMESSAGe message to all users in FUsers list, supported:
    cmULObjUpdated, cmULObjDestroyed }
{$IFNDEF CONSOLE}
var
  msg: TMessage;
  i: integer;
  r: integer;
  {v0.14}
  lc: integer;
  {/v0.14}
{$ENDIF}
begin
  Result := 0;
  {$IFNDEF CONSOLE}
  r := 0;
  if FNotifyingCM = cm then
    exit;
  if (FUsers <> nil) and (FUsers.Count > 0) then begin
    FNotifyingCM := cm;
    try
      {v0.14}
      if cm = cmULObjDestroyed then begin
        i := 0;
        while i < FUsers.Count do begin
          fillchar(msg, sizeof(msg), 0);
          msg.msg := WM_APPMESSAGE;
          msg.wParam := cm;
          msg.lParam := longint(Self);
          lc := FUsers.Count;
          TObject(FUsers.Items[i]).Dispatch(msg);
          if msg.Result <> 0 then
            r := msg.Result;
          if lc = FUsers.Count then
            inc(i)
        end;
      end else
      {/v0.14}
      for i := 0 to FUsers.Count - 1 do begin
        fillchar(msg, sizeof(msg), 0);
        msg.msg := WM_APPMESSAGE;
        msg.wParam := cm;
        msg.lParam := longint(Self);
        TObject(FUsers.Items[i]).Dispatch(msg);
        if msg.Result <> 0 then
          r := msg.Result;
      end;
      Result := r;
    finally
      FNotifyingCM := 0;
    end;
  end;
  {$ENDIF}
end;

procedure TULObj.UsersUpdate;
begin
  UsersNotify(cmULObjUpdated);
end;

procedure TULObj.DoChange;
begin
  if not DoChangeLocked then begin
    UsersUpdate;
    if (Owner <> nil) and (Owner is TULObj) then
      TULObj(Owner).DoChange;{ulbrobju}
  end else begin
    inc(FChangedCount);
  end;
  {v0.09}
  Modified := true;
  {/v0.09}
end;

procedure TULObj.DoChangeLock;
begin
  inc(FDoChangeLockCount);
end;

procedure TULObj.DoChangeUnlock;
begin
  if FDoChangeLockCount > 0 then begin
    dec(FDoChangeLockCount);
    if (FDoChangeLockCount = 0) and (FChangedCount > 0) then begin
      UsersUpdate;
      if (Owner <> nil) and (Owner is TULObj) then
        TULObj(Owner).DoChange;
      FChangedCount := 0;
    end;
  end else begin
    SetResult(orUpdateUnlockFailed,'TULObj.UpdateUnlock');{ulrectyp}
  end;
end;

function TULObj.DoChangeLocked:boolean;
begin
  Result := (FDoChangeLockCount > 0);
end;

function TULObj.ChildWithFlagFirst(AFlags: TULRecFlags): boolean;
  { returns pointer to the first child record that has all AFlags set;
    result = false if no such child found (used in ulbrowu.pas) }
var
  i, cc: integer;
begin
  Result := false;
  FActiveChildIndex := -1;
  cc := ChildCount;
  if cc > 0 then begin
    for i := 0 to cc - 1 do begin
      if Childs[i].IsFlagSet(AFlags) then begin
        FActiveChildIndex := i;
        Result := true;
        exit;
      end;
    end;
  end;
end;

function TULObj.ChildWithFlagNext(AFlags: TULRecFlags): boolean;
  { Returns pointer to the child that follows after AChild and has
    all AFlags set; result = false if no such child found
    (used in ulbrowu.pas) }
var
  i, cc: integer;
begin
  Result := false;
  cc := ChildCount;
  if cc > FActiveChildIndex + 1 then begin
    for i := FActiveChildIndex + 1 to cc - 1 do begin
      if Childs[i].IsFlagSet(AFlags) then begin
        FActiveChildIndex := i;
        Result := true;
        exit;
      end;
    end;
  end;
end;

function TULObj.ChildWithFlagCount(AFlags: TULRecFlags): integer;
  { returns count of childs with all specified flags on }
var
  i, cc, cnt: integer;
begin
  cnt := 0;
  cc := ChildCount;
  if cc > 0 then begin
    for i := 0 to cc - 1 do begin
      if Childs[i].IsFlagSet(AFlags) then
        inc(cnt);
    end;
  end;
  Result := cnt;
end;

procedure TULObj.ChildsDelete(ARecID: TULRecID; AFlags: TULRecFlags);
 { Delete all childs that have (RecID = ARecID) and (Flags and AFlags) = AFlags;
   if ARecID = 0 or AFlags = 0 that this property is not checked }
var
  i: integer;
  delcnt:integer;
  p: TULObj;
begin
  i := 0;
  DoChangeLock;
  delcnt := 0;
  try
    while i < ChildCount do begin
      p := Childs[i];
      if (ARecID <> 0) and (p.RecID <> ARecID) then begin
        inc(i);
        continue;
      end;
      if p.IsFlagSet(AFlags) and p.CanDestroy then begin
        p.Free;
        inc(delcnt);
      end else begin
        inc(i);
      end;
    end;
    if delcnt > 0 then
      DoChange;
  finally
    DoChangeUnlock;
  end;
end;

procedure TULObj.ToggleSelectChild(Index: integer; Shift: TShiftState);
var
  p, o: TULObj;
  cc, i, j, otherSelIndex: integer;
begin
  if (Index < 0) or (Index >= ChildCount) then
    exit;
  DoChangeLock;
  try
    p := Childs[Index];
    cc := ChildCount;
    if (ssShift in Shift) then begin
      otherSelIndex := -1;
      for i := 0 to cc - 1 do begin
        if i <> index then begin
          o := Childs[i];
          if o.IsFlagSet(rfSelected) then begin
            otherSelIndex := i;
            break;
          end;
        end;
      end;
      if otherSelIndex <> -1 then begin
        if otherSelIndex < index then begin
          i := otherSelIndex;
        end else begin
          i := index;
          index := otherSelIndex;
        end;
        for j := 0 to i - 1 do begin
          Childs[j].SetFlag(rfSelected, false);
        end;
        for j := i to index do begin
          Childs[j].SetFlag(rfSelected, true);
        end;
        for j := index + 1 to cc - 1 do begin
          Childs[j].SetFlag(rfSelected, false);
        end;

      end else begin
        p.SetFlag(rfSelected, not p.IsFlagSet(rfSelected));
      end;
    end else if (ssCtrl in Shift) then begin

      p.SetFlag(rfSelected, not p.IsFlagSet(rfSelected));
      {tshiftstate}
    end else begin

      for i := 0 to cc - 1 do begin
        o := Childs[i];
        if i <> index then
          o.SetFlag(rfSelected, false);
      end;
      p.SetFlag(rfSelected, not p.IsFlagSet(rfSelected));

    end;
  finally
    DoChangeUnlock;
  end;
end;

function TULObj.GetActiveChild: TULObj;
begin
  if (FActiveChildIndex < 0) or (FActiveChildIndex >= FChildList.Count) then
    Result := nil
  else
    Result := Childs[FActiveChildIndex];
end;

function TULObj.GetRecIDStr: TULRecIDStr;
begin
  Result := ULRecIDToStr(RecID);
end;

function TULObj.GetFieldsLen: integer;
begin
  if FRec^.Info.FieldsLen = 0 then
    CountFieldsLen(false);
  Result := FRec^.Info.FieldsLen;
end;

procedure TULObj.CountFieldsLen(recursive:boolean);
var i: integer;
begin
  FRec^.Info.FieldsLen := GetMinRecLen + ClassSumStringLength(Self);{proputl}
  if recursive then begin
    if ChildType = ctULRec then begin
      for i := 0 to ChildCount - 1 do begin
        Childs[i].CountFieldsLen(true);
      end;
    end;
  end;
end;

{procedure TULObj.ClearFieldsLen;
begin
  FRec^.Info.FieldsLen := 0;
end;}

procedure TULObj.SetResult(AObjResult: TULObjResult; const msg: string);
var
  id: string;
  s: string;
begin
  if AObjResult <> orOK then begin
    id := RecIDStr;
    if id[length(id)] = #0 then
      SetLength(id, Length(id) - 1);
    s := id + ' ' + IntToStr(AObjResult) + ' ' + msg;
    raise EULObj.Create(s);{exception}
  end;
end;

function TULObj.GetFields: TULObjFields;
begin
  if FFields = nil then begin
    FFields := TULObjFields.Create(Self, '');
  end;
  Result := FFields;
end;

function TULObj.GetFieldCount: integer;
begin
  Result := Fields.Count;
end;

function TULObj.FindField(const AName: string): TULObjField;
var i: integer;
begin
  Result := nil;
  for i := 0 to Fields.Count - 1 do begin
    if Fields[i].FldDesc.Name = AName then begin
      Result := Fields[i];
      exit;
    end;
  end;
  SetResult(orFieldNotFound, AName);
end;

{v0.13}
function TULObj.HasField(const AName: string; var AField: TULObjField): boolean;
      { as FindField, but not an error if not found }
var i: integer;
begin
  AField := nil;
  Result := false;
  for i := 0 to Fields.Count - 1 do begin
    if Fields[i].FldDesc.Name = AName then begin
      AField := Fields[i];
      Result := true;
      exit;
    end;
  end;
end;
{/v0.13}

{v0.09}
function TULObj.GetState(os: TULObjStateFlag):boolean;
begin
  Result := (FState and os) = os;
end;

procedure TULObj.SetState(os: TULObjStateFlag; OnOff: boolean);
begin
  if OnOff then
    FState := FState or os
  else
    FState := FState and (not os);
end;

function TULObj.GetModified:boolean;
      { returns true if this object or any of it's child has osModified state
        flag set. osModified is cleared after loading from file or after
        saving to file, set by modifying any property. }{ulrectyp}
var
  i: integer;
begin
  Result := GetState(osModified);
  if not Result then begin
    for i := 0 to ChildCount - 1 do begin
      if Childs[i].Modified then begin
        Modified := true;{speeds up next call to GetModified}
        Result := true;
        exit;
      end;
    end;
  end;
end;

procedure TULObj.SetModified(OnOff: boolean);
      { if OnOff = true then set osModified state of the object to true,
        if OnOff = false clears osModified state of the object and all
        it's childs }
var
  i: integer;
begin
  SetState(osModified, OnOff);
  if not OnOff then begin
    for i := 0 to ChildCount - 1 do begin
      Childs[i].Modified := OnOff;
    end;
  end;
end;


function TULObj.GetReadOnly: boolean;
begin
  Result := GetState(osReadOnly);
end;

procedure TULObj.SetReadOnly(OnOff:boolean);
begin
  SetState(osReadOnly, OnOff);
end;

{v0.13}
function TULObj.GetRelFileName: TFileName;
begin
  Result := RelativeFileName('',FileName);
end;
{/v0.13}

{v0.14}
function TULObj.GetRootFileName: TFileName;
var l, o: TULObj;
begin
  Result := '';
  l := Self;
  o := TULObj(l.Owner);
  while (o <> nil) and (o is TULObj) do begin
    l := o;
    o := TULObj(l.Owner);
  end;
  Result := l.FileName;
end;

function TULObj.GetRootFileDir: TFileName;
begin
  Result := ExtractFilePath(RootFileName);
end;

{v0.14}
procedure TULObj.FillULEnumNames(AFieldIndex: integer; Items: TStrings);
  { for Field[AFieldIndex] (must be FldDesc.IsULEnum,
    FldDesc.ValuesSource must be also set), fill Items for TComboBox }
var
  f, sf: TULObjField;
  o, c: TULObj;
  i: integer;
begin
  f := Fields[AFieldIndex];
  if not f.FldDesc.IsULEnum then
    SetResult(orNotULEnumField, 'TULObj.FillULEnumNames ' + f.FldDesc.Name);
  o := TULObj(f.FldDesc.ValuesSource);
  if o = nil then
    SetResult(orValueSourceNil, 'TULObj.FillULEnumNames ' + f.FldDesc.Name);
  Items.Clear;
  for i := 0 to o.ChildCount - 1 do begin
    c := o.Childs[i];
    if c.HasField(f.FldDesc.Name, sf) then
      Items.Add(sf.UsrValue);
  end;
end;

function TULObj.HasChildWithFieldUsrValue(const AFieldName: string; const AFieldUsrValue: string;
 var AChild: TULObj): boolean;
 { returns true if has some child ulobj record that has field of name AFieldName
   and the field has UsrValue = AFieldUsrValue }
var
  o: TULObj;
  f: TULObjField;
  i: integer;
begin
  Result := false;
  AChild := nil;
  for i := 0 to ChildCount - 1 do begin
    o := Childs[i];
    if o.HasField(AFieldName, f) then begin
      if f.UsrValue = AFieldUsrValue then begin
        Result := true;
        AChild := o;
        exit;
      end;
    end;
  end;
end;
{/v0.14}
{v0.18}
function TULObj.IsChildRecID(ARecID: TULRecID): boolean;
var
  i: integer;
  r: TULRecID;
  rd: PULRecDesc;
begin
  Result := false;
  for i := 0 to ObjDesc.ChildRecIDCount - 1 do begin
    r := ObjDesc.ChildRecIDs[i];
    if r = ARecID then begin
      Result := true;
      exit;
    end;
    {rd := GetULRecDescOf(r);
     if (rd = nil) or ((rd^.Flags and rfVisible) <> 0) then begin
     end;}
  end;
end;
{/v0.18}
{/TULObj}

(*
procedure Test;
const
  testfn = 'TEST.ULF';
  testfn2 = 'TEST2.ULF';
var
  f, f2, o: TULObj;
begin
  f := TULObj.Create(nil, ULFID);
  f.SaveToFile(testfn);
  f.Free;

  f := TULObj.Load(testfn);

  f2 := TULObj.Create(nil, ULFID);
  f2.Assign(f);
  f2.SaveToFile(testfn2);
  if f2.FindObj(UlxID, foDefault, o) then begin
    ShowMessage('Found');
  end;
  f.Free;
  f2.Free;
end;
*)

end.

