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). }
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
{$I define.pas} {ulfobju ulobjusru}
{.$DEFINE DEBCRASH}
{$DEFINE ULSTRING}
{.$DEFINE ULOBJTIME} {define if not debugging}
uses
  {v0.41}
  Windows,
  {/v0.41}

  SysUtils, Math, Classes,
  {$IFNDEF CONSOLE}
  Messages, Dialogs, Controls, Forms,
  {$ENDIF}
  PropUtl, Fileu, ULRecTyp, ULRecUtl, UtlType,
  WinUtl, BinHex, TypInfo,
  ULObjDes {uledfrm}
  {v0.24}
   ,Graphics, Grids
  {/v0.24}
  {$IFNDEF CONSOLE}
  {$IFDEF DEBUG}
  {,DebugFrm}
  {$ENDIF}
  {v0.18}
  ,Clipbrd
  {/v0.18}
  {v0.22}
  ,ActnList, ULObjAct
  {/v0.22}
  {v0.24}
  ,ExeLogu, FoldrDlg
  {/v0.24}
  {v0.25}
  , Msgu
  {/v0.25}
  {$ENDIF}

  ,Language

  {v0.31}
  {$IFNDEF CONSOLE}
  ,ULPrnFrm {v0.41}, FileCtrl{ for MinimizeName }{/v0.41}
  {$ENDIF}
  {/v0.31}
  {v0.45}
  ,GPTimeZone
  {/v0.45}
  {v0.46}
  ,Compareu
  {/v0.46}
  {v0.54}
  ,ULOType
  {/v0.54}
  {v0.67}
  ,FileMenuHdl
  {/v0.67}
  ;
{$IFDEF DEBUG}
  { $DEFINE DEBLOAD}
{$ENDIF}
type

{Exceptions}
  EULObj = class(Exception);
    { used by ULObj objects and descendants through SetResult method }
  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);

  {v0.24}
  EULObjUsr = class(Exception);
    { used by ULObjBasicUsr and its descendants through SetResult method }
  {/v0.24}
{/Exceptions}
  {v0.41}
  TOnGetWindowCaption = procedure(var ACaption: string) of object;
{class of}
  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;
    {v0.29}
    {FAfterSetValue: TAfterSetValue;}{ulmfrmu}
    {/v0.29}
    {v0.51}
    FAutoSort: boolean;
    {/v0.51}
    {$IFNDEF CONSOLE}
    {v0.22}
    FAction: TAction;
    {/v0.22}
    {$ENDIF}
  protected
    function GetValue: string; {v0.47}virtual;{/v0.47}
    procedure SetValue(const AValue: string);{v0.47}virtual;{/v0.47}
    function GetUsrValue: string;
      { get value as string eventually converted to usr format/units }
    procedure SetUsrValue(const AUsrValue: string);
      { set value as string eventually converting from usr format/units }
    {v0.24}
    {procedure SetUsrFloat(AValue: extended);
    function GetUsrFloat: extended;}
    {/v0.24}
    {v0.22}
    {$IFNDEF CONSOLE}
    function GetMethod: TMethod;
    procedure SetMethod(const AMethod: TMethod);
    {$ENDIF}
    procedure SetInteger(AValue:integer);
      { set value as integer }
    function GetInteger: integer;
      { get value as integer }
    {v0.47 moved to public}
    {/v0.47
    procedure SetResult(AObjResult: TULObjResult; const msg: string);}
    {/v0.22}
    {v0.23}
    procedure SetFloat(AValue:extended);
    function GetFloat: extended;
    {/v0.23}
    {v0.24}
    function GetColorCount:integer;
    function GetColor(Index: integer; ct:TColorType): TColor;
    function GetObj: TULObj;
    {/v0.24}
    {v0.41}
    function GetAsFullFileName: string;
    {/v0.41}
    {v0.45}
    function GetValueSourceField: TULObjField;
      { used for ULEnum fields to find if there is in the ULObj some
        other field that is pointer to some other ULObj (related, which
        has field with the same name and the same value as THIS field) }
    {/v0.45}
    {v0.47}
    procedure DoObjModified; virtual;
      { called if some field of Obj modified; does nothing by default }
    {/v0.47}

  public
    {v0.47}
    procedure SetResult(AObjResult: TULObjResult; const msg: string);
    {/v0.47}

    {v0.22}
    destructor Destroy; override;
    {/v0.22}
    constructor Create(AOwner: TULObjFields; const AName: string); reintroduce;
    {property RTIndex: integer read FRTIndex;}
    {v0.24}
    procedure DoGetColor(AState: TGridDrawState; var ATextColor: TColor;
      var ABackColor: TColor);
    procedure UpdateNow;
      { call if you want to send to all ULObjUsru s message WM_APPMESSAGE cmULObjUpdateNow
        ulrectyp}
    {$IFNDEF CONSOLE}
    procedure DoFieldFileNameOpenSelect;
      { if Type=FileName, then invokes TOpenDialog (using FieldFileNameOpenSelect method)
        and sets selected filename AsString }
      function FieldFileNameOpenSelect(var AFileName: string): boolean;
        { perform the OpenDialog.Execute for initial value AFileName, if returns
          true, then AFileName contains the selected value }
    procedure DoDirSelect;
      { if Type=Dir, then invokes TFolderDialog (using DirSelect) and sets
        selected folder AsString }
      function DirSelect(var ADir: string): boolean;
    {$ENDIF}
    {/v0.24}
    {v0.50}
    {$IFNDEF CONSOLE}
    function DoColorSelect: boolean;
      { if Type=Color, then invokes TColorDialog }
    {$ENDIF}
    {/v0.50}
    {v0.44}
    {$IFNDEF CONSOLE}
    procedure DoCheckListBoxFormExecute;
    {$ENDIF}
      { for IsSetType field }
    function FieldUsersNotify(cm: word): integer;
      { as Obj.UsersNotify, but as parameter sent TULObjField instead of the Obj,
        see some cmULObjFieldXXXX messages in ULRecTyp }
    {/v0.44}

    {v0.47}
    { Used for ULEnum fields to retrieve ULObj that is owner of ULObjs that
      hold possible values of this field (in field with the same name);
      Sends message to Obj.Users }
    function GetValuesSource: TULObj;
    {/v0.47}
    {v0.50}
    { Should be called before accessing FileName type field value AsUsrString
      ( causes eventual users to set DefDir used to make absolute path of
      the filename to the wanted value ) }
    procedure DefDirNeeded;
    {/v0.50}


    property AsString: string read GetValue write SetValue;
    property AsUsrString: string read GetUsrValue write SetUsrValue;
    {v0.24}
    {property AsUsrFloat: extended read GetUsrFloat write SetUsrFloat;}
    {/v0.24}
    property ObjFields: TULObjFields read FObjFields;
    property FldDesc: TULObjFldDesc read FFldDesc;
    property OnGetUsrValue: TOnGetSetUsrValue read FOnGetUsrValue write FOnGetUsrValue;
    property OnSetUsrValue: TOnGetSetUsrValue read FOnSetUsrValue write FOnSetUsrValue;
    {v0.22}
    {$IFNDEF CONSOLE}
    property Method: TMethod read GetMethod write SetMethod;
      { usable only if FldDesc.IsMethod is true }
    property Action: TAction read FAction;
    {$ENDIF}
    property AsInteger: integer read GetInteger write SetInteger;
    {/v0.22}
    {v0.23}
    property AsFloat: extended read GetFloat write SetFloat;
    {/v0.23}
    {v0.24}
    property ColorCount: integer read GetColorCount;
    property Colors[Index: integer; ct: TColorType]: TColor read GetColor;
    property Obj: TULObj read GetObj;
    {/v0.24 ulobjdes}
    {v0.41}
    property AsFullFileName: string read GetAsFullFileName;
    {/v0.41}
    {v0.45}
    property ValueSourceField: TULObjField read GetValueSourceField;
    {/v0.45}
    {v0.51}
    property AutoSort: boolean read FAutoSort write FAutoSort;
    {/v0.51}
  end;

  {v0.41}
  TULObjFldAutoCon = class(TULObjField);
    { fields of this type gets auto searched in SModule object descendants
      (and in AAAu) }
  {/v0.41}

  TULObjFields = class(TList)
  private
    FObj: TULObj;
    {v0.22}
    {FActiveFieldIndex: integer;}
    {/v0.22}
  protected
    function GetField(Index: integer): TULObjField;
    procedure ClearFields;
    {v0.47}
    procedure DoObjModified; virtual;
      { called if some field of Obj modified; does nothing by default }
    {/v0.47}
  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. Should be set only by user
        from browsers or other interactive (focused) window controls.
        The meaning is valid from version 0.24. }
    {$IFNDEF CONSOLE}
    FNotifyCM: 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 }
    {v0.44}
    FChangedSelectCount: integer;
      { How many times was DoChangeSelect called between DoChangeLock and DoChangeUnlock }
    {/v0.44}
    FState : integer;
      { see osXXXX ulobject (runtime) states ulrectyp}
    {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}
    {v0.22}
    FSortProc: TListSortCompare;
    FActiveChildFieldIndex: integer;
      { UL index of active field in childs, used e.g. for sorting by this field's
        value }
    {$IFNDEF CONSOLE}
    FActions: TULObjActions;
    {$ENDIF}
    FMessageInfo: integer;
      { can be used as additional parameter for UsersNotify or other message
        sending }
    {/v0.22}
    {v0.41}
    FOnGetWindowCaption: TOnGetWindowCaption;
    {/v0.41}
    {v0.44}
    FSortChildFieldIndex: integer;
    {/v0.44}
    {v0.48}
    function GetNextEditEnableAll: boolean;
    procedure SetNextEditEnableAll(OnOff:boolean);
    {/v0.48}
  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{v0.24}(ARecID: TULRecID){/v0.24};virtual;
      { 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) or if ObjDesc.NameProp defined
        then the value of field with given field name is returned }
    {v0.24}
    procedure SetRecName(const ARecName: TULRecName);
      { if HasRecName then change the value of Field[0], otherwise assigns
        to field of EfNameProp name  }
    {/v0.24}
    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;
    {v0.50 moved to public}
    {/v0.50
    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;
    {v0.47}
    function GetRecIDStrStripped: TULRecIDStr;
      { as getrecidstr eventually stripped last #0 char }
    {/v0.47}
    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;
      { returns 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}
    {v0.22}
    procedure SetSortProc(ASortProc: TListSortCompare);
    procedure SetActiveChildFieldIndex(AULIndex:integer);
    {$IFNDEF CONSOLE}
    function GetActions: TULObjActions;
    {$ENDIF}
    procedure SetActiveChild(AChild: TULObj);
    function ValuesSourceFieldFind(const AFieldName: string;
      var AField: TULObjField): boolean;
    {/v0.22}
    {v0.23}
    function GetEfNameField: TULObjField;
    {/v0.23}
    {v0.24}
    function GetJustLoadedFromFile: boolean;
    procedure SetJustLoadedFromFile(OnOff: boolean);

    function GetJustCreated: boolean;
    procedure SetJustCreated(OnOff: boolean);
    function GetInsertNextChild: boolean;
    procedure SetInsertNextChild(OnOff: boolean);
    {v0.41}{/v0.41 function GetWindowCaption: string;}
    {/v0.24}
    {v0.25}
    {function GetClass: TClass; virtual;}
    {function GetRecID: TULRecID: virtual;}
    {/v0.25}
    {v0.31}
    function GetReportFileName: string;
    function GetBrowserAutoClose: boolean;
    procedure SetBrowserAutoClose(OnOff: boolean);
    function GetEditorAutoClose: boolean;
    procedure SetEditorAutoClose(OnOff: boolean);
    {/v0.31}
    {v0.44}
    function GetBrowseLine: string;
    {/v0.44}
    {v0.45}
    procedure FindNewIDIfNeeded;
      { called from JustCreated, scans flddescs if AutoInc field present,
        if yes, find new value for it }
    {/v0.45}
    {v0.50}
    function GetULObjRelPath: string;
      { returns this object's relative part of the full ULObjPath }
    function GetULObjPath: string;
      { returns the full path of this ULObj in system ULObj tree }
    {/v0.50}
    {v0.65}
    { Returns non-empty string that describes this objects as uniquely as
      possible, used e.g. for treeview }
    function GetCaption: string; {v0.72}virtual;{/v0.72}
    {/v0.65}
  {/protected TULObj}
  public
    {v0.50 moved from protected}
    procedure CountFieldsLen(recursive:boolean);
      { Should be called upon every change of longstring field; recursive=true
        when called before savetofile }
    procedure DefDirNeeded;
      { should be called when defdir for this (root) object is needed for
        retriving full file name }
    {/v0.50}
    {v0.41}
    {$IFNDEF CONSOLE}
    function GetWindowCaption(AForm:TForm): string;
    {$ENDIF}
    {/v0.41}
    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. }
                               {ulobjact}
    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). }
    {v0.25}
    procedure Save;
      { Just calls SaveToFile(''). Call only for object(ULFObj) that have already
        assigned FileName }
    {/v0.25}
    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;
        if using ULObjUsr, then after Assign call TULObjUsr.ClassFieldsUpdate
        (to create childs). Or better to use TULObjUsr.Assign }
    {v0.18}
    procedure AssignTo(Dest: TPersistent); override;
      { for assigning to clipboard }
    {/v0.18}
    {v0.25}
    procedure AssignClass(Source: TPersistent);
      { copy just values of published fields of source to its published
        fields of the same name (as strings) }
    {/v0.25}
    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 }
    {v0.50}
    function FindChild(ARecID: TULRecID; ARecName: TULRecName): TULObj;
      { calls Find(ARecID, ARecNamee) and raises exception if specified child
        not found, otherwise returns it (i.e. call this instead of
        FindOrAdd if the child should be already present) }
    {/v0.50}
    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.50}
    function Find(ARecID: TULRecID; const ARecName: string; var AObj: TULObj): boolean;
      { as FindObj but looks only to Childs (not self, not recursively) }
    {/v0.50}
    {v0.28}
    function FindBySortStr(const AExp: string; var AObj: TULObj): boolean;
      { looks only in sorted childs for a child with sortexp exactly equal to AExp }
      function FindIndexBySortStr(const AExp: string; var Index: integer): boolean;
    {/v0.28}
    {v0.20}
    function OwnsObj(AObj:TULObj): boolean;{IsChild?}
      { 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 instead 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. }
    {v0.46}
    {procedure DeleteAll; {ulstringgrid ulobjact}
      { As Clear, but after deleted all, calls UsersNotify cmULObjAfterChildsDelete;
        As ChildsDelete(0,0), but deletes really all childs, even those marked cantdestroy }
    {/v0.46}
    procedure Sort;
      { sort ChildList (if rfChildSorted flag set) }

    function CanDestroy:boolean;
      { Ask users if the object can destroy itself (they have pointer to it) }
    {v0.44}
    function ObjectUsersNotify(cm: word; AObject: TObject): integer;
    {/v0.44}
    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),
        cmULObjUserActionNeeded (users should call MenuActionAdd method to added
          menu item to the just beeing created local menu }
    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 }
    {v0.44}
    procedure DoChangeSelect;
    {/v0.44}
    {v0.24 replaced by new ChildWithFlagNext method}
    {/v0.24
    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) }
    {v0.24}
    procedure DoMainPropUpdated;
      { Called from Set method of property with name specified in RecDesc.MainProp,
        generates cmULObjMainPropUpdated message }
    {/v0.24}
    function ChildWithFlagNext(AFlags: TULRecFlags; var Index: integer): boolean;
      { repeats (eventually for all childs): increment index, check if the child
        of the current index has all AFlags set, return true if yes and exit
        otherwise continue. Result = false if no such child found.
        The first action of the function is incrementing of the Index.
        I.e. if Index set to -1 (any negative value can be used), then this
        function can be used to scan through all the childs. Value of Index
        param. will be changed only if the function returns true. }
    {/v0.24
    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;
        childs checked also if:
           CanDestroy and (not IsFlagSet(rfCantDelete)) }
    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}
    {v0.22}
    procedure SortByField(AULIndex:integer);
    {/v0.22}
    {v0.23}
    function FindByULObjPath(const AULObjPath: string; fo:TULRecFindOptions;
      var AObj: TULObj): boolean; virtual;
        { see description in implementation part ..}
    function CanAddChildInBrowser(ARecID: TULRecID; var ARecDesc: PULRecDesc): boolean;
      { is the child ARecID allowed to be added manually in browser? }
    {/v0.23}
    {v0.24}
    {$IFNDEF CONSOLE}
    procedure ActionsFree;
      { called from ULStringGrid.Destroy }
    {$ENDIF}
    function HasUsrWithProp(const APropName: string; var AULObjUsr: TObject;
       var APropInfo: PPropInfo): boolean;
    {/v0.24}
    {v0.25}
    {$IFNDEF CONSOLE}
    {file save related methods; called if the Obj.Owner = ULFFile,
      or if IsFlagSet(rfRootChild) (for saveas) }
    function CanClose{v0.31}(AFrom: TWinControl){/v0.31}: boolean;
      { called from (browse)Form.FormCanClose, invokes DoFileSaveAs if necessary }
    function DoFileSaveAs: boolean;
      { invokes SaveDialog, returns true if file was selected and data saved to it }
    {v0.37}
    { If NONAME present in FileName, than calls DoFileSaveAs and returns its result,
      otherwise calls Save and returns true }
    function DoFileSave: boolean;
    {/v0.37
    procedure DoFileSave;}
      { calls SaveToFile('') (eventually register to recently saved files list) }
    {/file save related methods}
    function DoFileOpen: boolean;
      { invokes OpenDialog, returns true if file was selected and data loaded from it;
        can be called only to load child objects!! (i.e. Self.RecID = ULFID) }
    {$ENDIF}
    procedure Reload;{ reload the object from file (discard changes in memory) }
    function Clone: TULObj; virtual;
      { create exact copy of itself; should be called only for ULFID objects ulfobju}
    {/v0.25}
    {v0.30}
    {$IFNDEF CONSOLE}
    procedure MenuActionAdd(AAction: TAction);
      { should be called by ULObj Users during message cmULObjUserActionNeeded,
        the AAction should be created and owned by the ULObj User and will be
        added to just beeing created local menu }
    {$ENDIF}
    {/v0.30}
    {v0.31}
    function GetBrowseChild(var AChild: TULObj):boolean;
      { returns first child that has RecID specified in BrowseChildIDs (i.e.
        visible in browser for users) }
    {$IFNDEF CONSOLE}
    procedure PrintOptionsEdit;
    procedure Print;
    {$ENDIF}
    {/v0.31}
    {v0.44}
    procedure ChildsSetFlag(rf: TULRecFlags; OnOff: boolean);
    {/v0.44}
    {v0.46}
    procedure Delete;
      { should be called instead of Free, if the objects is beeing deleted
        because of user request (or BeforeDelete method of Users should be triggered) }
    {/v0.46}
    {v0.47}
    procedure Log(const msg: string);
    procedure LogErr(const msg: string);
    function IsSelected: boolean;
    function IsActive: boolean;
    function IsActiveOrSelected: boolean;
    {/v0.47}
    {v0.61}
    { Returns true if some field AutoInc flag set on and returns
      pointer to the corresponding field }
    function HasAutoIncField(var AField: TULObjField): boolean;

    { Browse the object's childs modaly allowing only:
      - select one of the childs by doubleclick or selecting active one
        and pressing Enter (returns mrOK and ActiveChild set to the
        selected one)
      or
      - cancel the browser (returns mrCancel) }
    {$IFNDEF CONSOLE}
    function BrowseForChild: integer;
    {$ENDIF}
    {/v0.61}
    {/public methods end}

    {public properties begin}
    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{v0.24} write SetRecName{/v0.24};
    property Data: TStream read GetData write SetData;
    property DataLen: longint read GetDataLen write SetDataLen;
    property ActiveChild: TULObj read GetActiveChild write SetActiveChild;
    property FieldsLen: integer read GetFieldsLen;
    property RecIDStr: TULRecIDStr read GetRecIDStr;
    {v0.47}
    property RecIDStrStripped: TULRecIDStr read GetRecIDStrStripped;
    {/v0.47}
    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}
    {v0.22}
    property SortProc: TListSortCompare read FSortProc write SetSortProc;
    property ActiveChildFieldIndex: integer read FActiveChildFieldIndex write
      SetActiveChildFieldIndex;
    {$IFNDEF CONSOLE}
    property Actions: TULObjActions read GetActions;
    {$ENDIF}
    property MessageInfo: integer read FMessageInfo;
    {/v0.22}
    {v0.23}
    property EfNameField: TULObjField read GetEfNameField;
    {/v0.23}
    {v0.24}
    property ActiveChildIndex: integer read FActiveChildIndex;
    property JustCreated: boolean read GetJustCreated write SetJustCreated;
    property JustLoadedFromFile: boolean read GetJustLoadedFromFile write SetJustLoadedFromFile;
    property InsertNextChild: boolean read GetInsertNextChild write SetInsertNextChild;
    {v0.41}{/v0.41 property WindowCaption: string read GetWindowCaption;}
    property ChangedCount: integer read FChangedCount;
    {/v0.24}
    {v0.31}
    property ReportFileName: string read GetReportFileName;
    property BrowserAutoClose: boolean read GetBrowserAutoClose write SetBrowserAutoClose;
    property EditorAutoClose: boolean read GetEditorAutoClose write SetEditorAutoClose;
    {/v0.31}
    {v0.41}
    property OnGetWindowCaption: TOnGetWindowCaption read FOnGetWindowCaption write FOnGetWindowCaption;
    {/v0.41}
    {v0.44}
    property BrowseLine: string read GetBrowseLine;
    property Users: TList read FUsers;
    property SortChildFieldIndex: integer read FSortChildFieldIndex write SortByField;
    {$IFNDEF CONSOLE}
    property NotifyCM: integer read FNotifyCM;
      { command that is just beeing sent to Users, non zero just during UsersNotify }
    {$ENDIF}
    {/v0.44}
    {v0.48}
    property NextEditEnableAll: boolean read GetNextEditEnableAll write SetNextEditEnableAll;
    {/v0.48}
    {v0.50}
    property ULObjPath: string read GetULObjPath;
    property ULObjRelPath: string read GetULObjRelPath;
    {/v0.50}
    {v0.65}
    property Caption: string read GetCaption;
    {/v0.65}
    {v0.72}
    property ObjClassName: shortstring read ClassName;
    {/v0.72}
    {/public properties end}
  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;
  {/TULObj}

{v0.25}
  TULObjClass = class of TULObj;
{/v0.25}

{procedure Test;}

var
  CurULObj: TULObj = nil;
    { Set to object that should be acted upon e.g. in next browsing ( ulbrowu .pas )
      or editing }
{ini}
{v0.22 moved from UlanGlob}
  UserMode: TUserMode = umUser;{umSysOp}
    { behavior of some procedures behaves according this param.
      see ulantype umXXXX }
{/v0.22}
{v0.65}
  { ULObjFileVersion - what file version to use for saving files
    0 ... original version not saving any file header, version info, ...
          (used up to Chromulan version 0.64)
    1 ... saving also ULF record as root with version info, for export to xml
  }
  ULObjFileVersion: integer = 0;
{/v0.65}

{/ini}
{v0.48}
  LoadUseMemStreamBuffer: boolean = true;
{/v0.48}
{Logging}
{/v0.24}
  FLogUsersNotify: boolean = false;
  FLogUserRegUnreg: boolean = false;
{/v0.24}
{v0.31}
const
  RepFrmDir: string = 'RepFrm';
{/v0.31}
{/Logging}

{v0.23}
{TULObjBasicUsr}
type
  TULObjBasicUsr = class(TComponent)
  private
    FObj: TULObj;
    FRegistered: boolean;
      { registered at FObj as User? }
  protected
    {$IFNDEF CONSOLE}
    procedure WMAppMessage(var Msg:TMessage); message WM_APPMESSAGE;
    {$ENDIF}
    procedure SetObj(AObj: TULObj); virtual;
    { Called when some property of FObj (or its childs) changed }
    procedure ObjUpdated; virtual;
    {v0.44}
    procedure ObjUpdatedSelect; virtual;
      { called when FObj (or its childs) have rfOwnMessageOnSelect set and
        their selection state changed (ObjUpdated is not called if this flag is set
        and nothing else than selection changed) }
    procedure ObjMainPropUpdated; virtual;
      { called when MainProp property of FObj changed }
    {/v0.44}
    procedure ObjDestroyed; virtual;
      { called when FObj was destroyed; by default calls Self.Free;
        if can exist without FObj, can just call Obj := nil in overriden
        methods }
    {v0.24}
    procedure ChildObjDestroyed(AChildObj: TULObj); virtual;
      { can be used to clear eventual additional pointers to the child }
    {v0.47 moved to public}{/v0.47
    procedure SetResult(AResult: integer; const msg: string);}
      { use ULRecTyp urXXXX result codes or other, descendant object specific ones }
    {/v0.24}
    {v0.30}
    procedure MenuActionNeeded; virtual;
      { should be overriden if the user wants to add action to local menu,
        should create (and own) TAction object (just once, and keep its pointer)
        and call Obj.MenuActionAdd method in this method.
        TActioin.OnExecute should be TNotifyEvent of user. }
    {/v0.30}
    {v0.41}
    procedure FirstMenuActionNeeded; virtual;
      { as MenuActionNeeded but for adding menuitems before default ones }
    {/v0.41}
    {v0.44}
    {v0.46}
    procedure BeforeDelete; virtual;
    procedure AfterChildsDelete; virtual;
    procedure ValuesSourceNeeded; virtual;
      { Obj.Fields[Obj.MessageInfo].FldDesc.ValuesSource
        (or corresponing xxx_Src_Ptr Obj.FindField[fldname_Src_Ptr].AsInteger)
        should be set here to TULObj that hold related childs }
    {/v0.46
    procedure BeforeBrowseChildDelete; virtual;}
      { ActiveChild is going to be deleted in browser }
    procedure AfterBrowseChildDelete; virtual;
      { Child deleted in browser, ActiveChild changed to other one }
    procedure BeforeBrowseChildInsert; virtual;
      { new child is going to be inserted in browser }
    procedure AfterBrowseChildInsert; virtual;
      { new child was inserted }
    procedure BeforeEdit; virtual;
      { edit window for the object will be opened }
    procedure AfterEdit; virtual;
      { edit window was closed }
    procedure FieldChangedInBrowser(AField: TULObjField); virtual;
    {/v0.44}
    {v0.50}
    procedure FieldDefDirNeeded(AField: TULObjField); virtual;
    procedure ObjDefDirNeeded; virtual;
    {/v0.50}
    {v0.61}
    procedure AutoIncIDAssigned; virtual;
    {/v0.61}
  public
    {v0.47 moved from protected}
    procedure SetResult(AResult: integer; const msg: string);
      { use ULRecTyp urXXXX result codes or other, descendant object specific ones }
    {/v0.47}

    {v0.44}
    {$IFNDEF CONSOLE}
    procedure ActionUpdate(var AAction: TAction; ANotifyEvent: TNotifyEvent;
      const ACaption: string);
      { can be called just from xxxMenuActionNeeded events to
        update TULObjUsr AAction.OnExecute fields with TULObjUsr methods;
        Makes sure that AAction is initialized (owned by this object) and has assigned
        OnExecute to ANotifyEvent and Caption to ACaption.
        If Obj.Actions.CurMenu is <> nil than also appends new menu item to this menu
        associated with AAction (the menuitem will be owned by the owner of the menu). }
    {$ENDIF}
    {/v0.44}
    destructor Destroy;override;
    property Obj: TULObj read FObj write SetObj;
    {v0.72}
    property ObjClassName: shortstring read ClassName;
    {/v0.72}
  end;
{TULObjBasicUsr}

{v0.47}
  TULObjCalcField = class;

  TULObjFieldUsr = class(TULObjBasicUsr)
  private
    { holds ULObj connected by relation (in TULObjCalcField) }
    FCalcField: TULObjCalcField;
      { calcField that uses this ULObjFieldUsr for accessing the ULObj fields }
  protected
    constructor Create(ACalcField: TULObjCalcField); reintroduce;
    procedure ObjDestroyed; override;
    procedure ObjUpdated; override;
  end;

  TULObjCalcField = class(TULObjField)
  private
    FRelFieldUsr: TULObjFieldUsr;
    FRelField: TULObjField;
  protected
    function GetValue: string; override;
    procedure SetValue(const AValue: string); override;{to raise exception}
    procedure DoObjModified; override;
  public
    constructor Create(AOwner: TULObjFields; const AName: string); reintroduce;
      { AInfo="FieldName,KeyFieldName,ListFieldName" }
    destructor Destroy; override;
  end; {aacrtype}
{/v0.47}

type
  TULFKeeper = class(TList)
  public
    procedure CheckIn(AULFObj: TULObj);
    procedure CheckOut(AULFObj: TULObj);
    function FindByULObjPath(const AULObjPath: string; fo: TULRecFindOptions;
      var AObj: TULObj): boolean;
    {v0.46}
    procedure Clear; override;
    {/v0.46}
  end;

function ULFKeeper: TULFKeeper;
{/v0.23}

{v0.25}
{$IFNDEF CONSOLE}                      {aapgtype ulsqtype ulatype}
function FileNameOpenSelect(var AFileName: string;
  const ATitle: string; const AFilter: string; const ADefDir: string): boolean;

function FileNameSaveSelect(var AFileName: string;
  const ATitle: string; const AFilter: string; const ADefDir: string): boolean;
{$ENDIF}

{/v0.25}

{v0.61}
var
  { Changed only from TULObj.BrowseForChild method. Flag for browser that
    nothing else should be allowed then selecting active child. }
  FBrowsingForChild: boolean = false;
{/v0.61}

{v0.62}
{v0.72}
const
  FULRootTrees: TList = nil;
  { Use ULObjUsrTreeForm as default for non modal editing of ULObj objects? }
  FUseTreeViews: boolean = false;
{/v0.72
const
  FULRootTree: TULObjBasicUsr = nil;}
{/v0.62}
implementation
{v0.31}
{$IFNDEF CONSOLE}
uses
  ULStringGrid, ULEdFrm;
{$ENDIF}
{/v0.31}
{v0.24}
{$IFNDEF CONSOLE}
var
  FOpenDialog: TOpenDialog = nil;
  FSaveDialog: TSaveDialog = nil;
  FFolderDialog: TFolderDialog = nil;
{$ENDIF}
{/v0.24}

{TULFKeeper}
var
  FULFKeeper : TULFKeeper = nil;

function ULFKeeper: TULFKeeper;
begin
  if FULFKeeper = nil then
    FULFKeeper := TULFKeeper.Create;
  Result := FULFKeeper;
end;

procedure TULFKeeper.CheckIn(AULFObj:TULObj);
var
  i: integer;
begin
  i := IndexOf(AULFObj);
  if i < 0 then
    Add(AULFObj);{ulfobju}
  {v0.62}
  {v0.72}
  if (FULRootTrees <> nil) and (FULRootTrees.Count > 0) then begin
    for i := 0 to FULRootTrees.Count - 1 do begin
      TULObjBasicUsr(FULRootTrees[i]).ObjUpdated;
    end;
  end;
  {/v0.72
  if FULRootTree <> nil then
    FULRootTree.ObjUpdated;
  }
  {/v0.62}
end;

procedure TULFKeeper.CheckOut(AULFObj:TULObj);
var
  i: integer;
begin
  i := IndexOf(AULFObj);
  if i < 0 then
    exit;
  Delete(i);
end;

function TULFKeeper.FindByULObjPath(const AULObjPath: string; fo:TULRecFindOptions;
  var AObj: TULObj): boolean;
var
  f: TULObj;
  i: integer;
begin
  Result := false;
  for i := 0 to Count - 1 do begin
    f := TULObj(Items[i]);
    if f.FindByULObjPath(AULObjPath, fo, AObj) then begin
      Result := true;
      exit;
    end;
  end;
end;

{v0.46}
procedure TULFKeeper.Clear;
var o: TULObj;
begin
  while Count > 0 do begin
    o := TULObj(Items[0]);
    o.Free;
  end;
  inherited;
end;
{/v0.46}

{/TULFKeeper}

{TULObjField}

{v0.22}
{$IFNDEF CONSOLE}
function TULObjField.GetMethod: TMethod;
var m: TMethod;
begin
  FillChar(m, sizeof(m), 0);
  if FldDesc.IsMethod then begin
    if Assigned(FAction) and Assigned(FAction.OnExecute) then
      m := TMethod(FAction.OnExecute);
    {if ClassGetMethod(FObjFields.Obj, FFldDesc.RTIndex, m) then;}
  end;
  Result := m;
end; {cprjobju}

procedure TULObjField.SetMethod(const AMethod: TMethod);
begin
  if FldDesc.IsMethod then begin
    if not Assigned(FAction) then
      FAction := TAction.Create(nil);
    FAction.OnExecute := TNotifyEvent(AMethod);
    {if ClassSetMethod(FObjFields.Obj, FFldDesc.RTIndex, AMethod) then;}
  end;
end;
{$ENDIF}

destructor TULObjField.Destroy;
begin
  {$IFNDEF CONSOLE}
  {FOpenDialog.Free;}
  FAction.Free;
  {$ENDIF}
  inherited Destroy;
end;
{/v0.22} {ulstringgrid}

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}

  {v0.45}
  {procedure FixULEnum(var r: string);
  var
    f: TULObjField;
    o: TULObj;
    dn: string;
  begin
    if UserMode = umSysOp then
      exit;
    f := ValueSourceField;
    dn := FldDesc.DispPropName;
    if (f <> nil) and (dn <> '') then begin
      o := TULObj(f.AsInteger);
      if o <> nil then begin
        if o.HasField(dn, f) then
          r := f.AsUsrString;
      end;
    end;
  end;}
  {/v0.45}

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;{ulrectyp ulsrtype}
    end {v0.24}
    else if FldDesc.UseStripPrefix then begin
      {v0.45}
      Result := FldDesc.EnumInternalToUsr(Result);
      {/v0.45 l := pos(FldDesc.StripPrefix, Result);
      if l = 1 then begin
        Result := copy(Result, length(FldDesc.StripPrefix) + 1, length(Result));
      end;}
    end {v0.36}
    else if FldDesc.IsFileName then begin
      {v0.50}
      DefDirNeeded;
      {/v0.50}
      Result := RelativeFileName(FldDesc.DefDir, Result, FldDesc.DefExt);
    end {v0.45} else if FldDesc.IsDateOrTime then begin
      if Result <> '' then begin
        dt := FixDT(StrToFloat(Result));
        if FldDesc.IsDate then
          Result := DateToStr(dt)
        else if FldDesc.IsTime then
          Result := TimeToStr(dt)
        else
          Result := StdDateTimeToUsrStr(dt);{gptimezone ulrectyp}
      end;
    end else if FldDesc.IsULEnum then begin
      {FixULEnum(Result);}
    end;
    {/v0.45};
    {/v0.36};
    {/v0.24};
    {/v0.13};
  end;
end;

{v0.24}
{procedure TULObjField.SetUsrFloat(AValue: extended);
begin
end;

function TULObjField.GetUsrFloat: extended;
begin
end;}
{/v0.24}

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
      {v0.62}
      if AValue = '' then begin
        ClassSetPropStr(FObjFields.Obj, FFldDesc.RTIndex, '0');
      end else
      {/v0.62}
      begin
        if ClassSetPropStr(FObjFields.Obj, FFldDesc.RTIndex, FixDecSep(AValue)) = 0 then;
      end;
    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;}
    {v0.25}
    if FFldDesc.IsSortField {v0.51} and AutoSort{/v0.51} then begin
      if Obj.Owner is TULObj then
        TULObj(Obj.Owner).Sort;
    end;
    {/v0.25}
  end;
  {v0.29}
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.24}
    if FldDesc.UseStripPrefix then begin {ulstringgrid uledutl}
      {v0.45}
      s := FldDesc.EnumUsrToInternal(AUsrValue);
      {/v0.45
      s := FldDesc.StripPrefix + AUsrValue;}
    end;
    {/v0.24}
    {v0.13}
    if {v0.60}
      FldDesc.IsFileDateTime
      {/v0.60 (s <> '') and FFldDesc.IsFileDateTime}
    then begin
      {v0.60}
      if s = '' then begin
        s := '0';
      end else
      {/v0.60}
      begin
        dt := StrToDateTime(s);
        s := IntToStr(DateTimeToFileDate(dt));
      end;
    end {v0.36}
    {v0.45}
    else if FldDesc.IsDateOrTime then begin
      if FFldDesc.IsDate then
        dt := StrToDate(s)
      else if FFldDesc.IsTime then
        dt := StrToTime(s)
      else
        dt := UsrStrToStdDateTime(s);
      s := FloatToStr(FixDT(dt));
    end
    {/v0.45}
    else if FFldDesc.IsFileName then begin
      {v0.50}
      DefDirNeeded;
      {/v0.50}
      s := RelativeFileName(FFldDesc.DefDir, s, FFldDesc.DefExt);
    end;
    {/v0.36};
    {/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;

{v0.22}
procedure TULObjField.SetInteger(AValue:integer);
      { set value as integer }
begin
  if FFldDesc.TypeKind in [tkInteger, tkChar, tkEnumeration, tkWChar{v0.44}, tkSet{/v0.44}] then
  begin
    SetOrdProp(FObjFields.Obj, FldDesc.PropInfo, AValue);
  end else if (FFldDesc.TypeKind in [tkString, tkLString])
    {v0.47}and (FldDesc.PropInfo <> nil){/v0.47} then
  begin
    SetStrProp(FObjFields.Obj, FldDesc.PropInfo, IntToStr(AValue));
  end else begin
    SetResult(orInvalidFieldType, 'SetInteger ' + FldDesc.Name);
  end;
end;

function TULObjField.GetInteger: integer;
      { get value as integer }
begin {typinfo}
  if FFldDesc.TypeKind in [tkInteger, tkChar, tkEnumeration, tkWChar{v0.44}, tkSet{/v0.44}] then
  begin
    {if ClassGetPropInt(FObjFields.Obj, FFldDesc.RTIndex, v) then}  {typinfo}
    Result := GetOrdProp(FObjFields.Obj, FldDesc.PropInfo);
  end else if (FFldDesc.TypeKind in [tkString, tkLString])
    {v0.47}and (FldDesc.PropInfo <> nil){/v0.47}then
  begin
    Result := StrToInt(GetStrProp(FObjFields.Obj, FldDesc.PropInfo));
  end else begin
    Result := 0;
    SetResult(orInvalidFieldType, 'GetInteger');
  end;
end;

procedure TULObjField.SetResult(AObjResult: TULObjResult; const msg: string);
begin
  FObjFields.Obj.SetResult(AObjResult, msg + ' Fld: ' + FFldDesc.Name);
end;
{/v0.22}

{v0.23}
procedure TULObjField.SetFloat(AValue:extended);
      { set value as Float }
begin
  if FFldDesc.TypeKind in [tkFloat] then
  begin
    SetFloatProp(FObjFields.Obj, FldDesc.PropInfo, AValue);
  end else if FFldDesc.TypeKind in [tkInteger] then
  begin
    SetOrdProp(FObjFields.Obj, FldDesc.PropInfo, round(AValue));
  end else if (FFldDesc.TypeKind in [tkString, tkLString])
    {v0.47}and (FldDesc.PropInfo <> nil){/v0.47} then
  begin
    SetStrProp(FObjFields.Obj, FldDesc.PropInfo, FloatToStr(AValue));
  end else begin
    SetResult(orInvalidFieldType, 'SetFloat');
  end;
end;

function TULObjField.GetFloat: extended;
      { get value as Float }
{v0.50}
var s: string;
{/v0.50}

begin
  if FFldDesc.TypeKind in [tkFloat] then
  begin
    Result := GetFloatProp(FObjFields.Obj, FldDesc.PropInfo);
  end else if FFldDesc.TypeKind in [tkInteger] then begin
    Result := GetOrdProp(FObjFields.Obj, FldDesc.PropInfo);
  end else if (FFldDesc.TypeKind in [tkString, tkLString])
    {v0.47}and (FldDesc.PropInfo <> nil){/v0.47}then
  begin
    {v0.50}
    s := GetStrProp(FObjFields.Obj, FldDesc.PropInfo);
    if s = '' then
      Result := 0
    else
      Result := StrToFloat(s);
    {/v0.50
    Result := StrToFloat(GetStrProp(FObjFields.Obj, FldDesc.PropInfo));}
  end else begin
    Result := 0;
    SetResult(orInvalidFieldType, 'GetFloat');
  end;
end;
{v0.23}

{v0.24}
procedure TULObjField.DoGetColor(AState: TGridDrawState; var ATextColor: TColor;
  var ABackColor: TColor);
var i:integer;
begin
  {v0.50}
  if FldDesc.IsColor then begin
    ABackColor := AsInteger;
    exit;
  end;
  {/v0.50}
  if FldDesc.TypeKind <> tkEnumeration then
    exit;
  i := AsInteger;
  if i < 0 then
    exit;
  if i >= ColorCount then
    exit;
  ATextColor := Colors[i, ctPen];
  ABackColor := Colors[i, ctBrush]
end;

function TULObjField.GetColorCount:integer;
begin
  Result := FldDesc.FldDesc^.FieldColorCount;
end;

function TULObjField.GetColor(Index: integer; ct: TColorType): TColor;
begin
  Result := FldDesc.FldDesc^.FieldColors^[Index, ord(ct)];
end;

function TULObjField.GetObj: TULObj;
begin
  Result := ObjFields.Obj;
end;

procedure TULObjField.UpdateNow;
begin {modulu}
  Obj.UsersNotify(cmULObjUpdateNow);
end;

{$IFNDEF CONSOLE}
{v0.25}
function FileNameOpenSelect(var AFileName: string;
  const ATitle: string; const AFilter: string; const ADefDir: string): boolean;
var
  opt: TOpenOptions;
  {v0.62}
  dir: string;
  {/v0.62}
begin
  if FOpenDialog = nil then begin
    FOpenDialog := TOpenDialog.Create(nil);
    opt := FOpenDialog.Options;
    Include(opt, ofFileMustExist);
    FOpenDialog.Options := opt;
  end;

  FOpenDialog.FileName := AFileName;
  FOpenDialog.Title := ATitle;
  FOpenDialog.Filter := AFilter;
  if ExtractFilePath(AFileName) = '' then begin
    if ADefDir <> '' then
      FOpenDialog.InitialDir := ADefDir
    else
      FOpenDialog.InitialDir := '';
  end else begin
    FOpenDialog.InitialDir := '';
  end;
  {v0.62}
  GetDir(0, dir);
  try
  {/v0.62}
  if FOpenDialog.Execute then begin
    Result := true;
    AFileName := FOpenDialog.FileName;
  end else begin
    Result := false;
  end;
  {v0.62}
  finally
    ChDir(dir);
  end;
  {/v0.62}
end;

function FileNameSaveSelect(var AFileName: string;
  const ATitle: string; const AFilter: string; const ADefDir: string): boolean;
{var opt: TOpenOptions; {tsavedialog}
{v0.29}
var defext: string;
{/v0.29}
begin
  if FSaveDialog = nil then begin
    FSaveDialog := TSaveDialog.Create(nil);
    {opt := FOpenDialog.Options;
    Include(opt, ofFileMustExist);
    FOpenDialog.Options := opt;}
  end;
  FSaveDialog.FileName := AFileName;
  FSaveDialog.Title := ATitle;
  FSaveDialog.Filter := AFilter;
  {v0.29}
  defext := GetExtFromFileDialogFilter(AFilter, {v0.36}1{/v0.36 0});
  if defext <> '' then begin
    if defext[1] = '.' then
      defext := copy(defext, 2, length(defext));
    FSaveDialog.DefaultExt := defext;
  end;
  {/v0.29} {aapgtype}
  if ExtractFilePath(AFileName) = '' then begin
    if ADefDir <> '' then
      FSaveDialog.InitialDir := ADefDir
    else
      FSaveDialog.InitialDir := '';
  end else begin
    FSaveDialog.InitialDir := '';
  end;
  if FSaveDialog.Execute then begin
    Result := true;
    AFileName := FSaveDialog.FileName;
  end else begin
    Result := false;
  end;
end;
{/v0.25}

procedure TULObjField.DoFieldFileNameOpenSelect;
var
  s: string;
  {v0.36}
  os: string;
  {/v0.36}
begin {uledfrm ulobjusru}
  {v0.50}
  DefDirNeeded;
  {/v0.50}
  {v0.36}
  os := AbsoluteFileName(FldDesc.DefDir, AsString, FldDesc.DefExt);
  s := os;
  {/v0.36
  s := AsString;}
  if FieldFileNameOpenSelect(s) then begin
    {v0.36}
    if os <> s then begin
      AsString := RelativeFileName(FldDesc.DefDir, s, FldDesc.DefExt);
      Obj.UsersNotify(cmULObjFieldFileNameChanged);
    end;
    {/v0.36
    if AsString <> s then begin
      if (FldDesc.DefDir <> '') and (FldDesc.DefDir = ExtractFilePath(s)) then begin
        s := ExtractFileName(s);
        if s = AsString then
          exit;
      end;
      AsString := s;
      Obj.UsersNotify(cmULObjFieldFileNameChanged);
    end; }
  end;
end;

{v0.25}
{function TULObjField.FieldFileNameSaveSelect(var AFileName: string): boolean;
begin
  Result : FileNameSaveSelect(AFileName, FldDesc.Caption, FldDesc.Filter, FldDesc.DefDir);
end;
{/v0.25}

function TULObjField.FieldFileNameOpenSelect(var AFileName: string): boolean;
{v0.25}
begin
  {v0.50}
  DefDirNeeded;
  {/v0.50}
  Result := FileNameOpenSelect(AFileName, FldDesc.Caption, FldDesc.Filter, FldDesc.DefDir);
end;
{/v0.25
var
  opt: TOpenOptions;
begin
  if FOpenDialog = nil then begin
    FOpenDialog := TOpenDialog.Create(nil);
  end;
  opt := FOpenDialog.Options;
  Include(opt, ofFileMustExist);
  FOpenDialog.Options := opt;
  FOpenDialog.Filter := FldDesc.Filter;
  FOpenDialog.FileName := AFileName;
  if ExtractFilePath(AFileName) = '' then begin
    if FldDesc.DefDir <> '' then
      FOpenDialog.InitialDir := FldDesc.DefDir;
  end else begin
    FOpenDialog.InitialDir := '';
  end;
  if FOpenDialog.Execute then begin
    AFileName := FOpenDialog.FileName;
    Result := true;
  end else
    Result := false;
end;
}

procedure TULObjField.DoDirSelect;
      { if Type=Dir, then invokes TFolderDialog (using DirSelect) and sets
        selected folder AsString }
var
  s: string;
begin
  s := AsString;
  if DirSelect(s) then begin
    if AsString <> s then begin
      AsString := s;
      Obj.UsersNotify(cmULObjFieldDirChanged);
    end;
  end;
end;

function TULObjField.DirSelect(var ADir: string): boolean;
begin
  if FFolderDialog = nil then begin
    FFolderDialog := TFolderDialog.Create(nil);
  end;
  FFolderDialog.Directory := ADir;
  FFolderDialog.Title := FldDesc.Caption;
  if FFolderDialog.Execute then begin
    ADir := {v0.37}AddBackSlash{/v0.37}(FFolderDialog.Directory);
    Result := true;
  end else
    Result := false;
end;
{$ENDIF}
{/v0.24}
{v0.50}
{$IFNDEF CONSOLE}
function TULObjField.DoColorSelect: boolean;
  { if Type=Color, then invokes TColorDialog }
begin
  Result := false;
  with TColorDialog.Create(Application) do begin
    Color := AsInteger;
    if Execute then begin
      {v0.57}
      if AsInteger <> Color then
      {/v0.57}
      begin
        Result := true;
        AsInteger := Color;
      end;
    end;
    Free;
  end;
end;
{$ENDIF}
{/v0.50}

{v0.41}
function TULObjField.GetAsFullFileName: string;
begin
  {v0.50}
  DefDirNeeded;
  {/v0.50}
  Result := AbsoluteFileName(FldDesc.DefDir, AsString, FldDesc.DefExt);
end;
{/v0.41}
{v0.45}
function TULObjField.GetValueSourceField: TULObjField;
begin
  Obj.HasField(FldDesc.Name + '_Ptr', Result);
end;
{/v0.45}


{v0.44}
{$IFNDEF CONSOLE}
procedure TULObjField.DoCheckListBoxFormExecute;
  { for IsSetType field }
var
  i: integer;
begin
  i := AsInteger;
  if FldDesc.CheckListBoxFormExecute(i) then
    AsInteger := i;
end;
{$ENDIF}

function TULObjField.FieldUsersNotify(cm: word): integer;
 { as Obj.UsersNotify, but as parameter sent TULObjField instead of the Obj,
   see some cmULObjFieldXXXX messages in ULRecTyp }
begin
  Result := Obj.ObjectUsersNotify(cm, Self);
end;

{/v0.44}

{v0.47}
function TULObjField.GetValuesSource: TULObj;
var
  vsf: TULObjField;
begin
  if not FldDesc.IsULEnum then
    SetResult(orNotULEnumField, 'GetValuesSource ' + FldDesc.Name);
  Obj.FMessageInfo := FldDesc.ULIndex;
  {v0.50}
  if Assigned(Obj.ObjDesc.OnValuesSourceNeeded) then
    Obj.ObjDesc.OnValuesSourceNeeded(Obj);
  {/v0.50}
  Obj.UsersNotify(cmULObjValuesSourceNeeded);
  if Obj.ValuesSourceFieldFind(FldDesc.Name, vsf) then begin
    Result := TULObj(vsf.AsInteger)
  end else
    Result := nil;
  if Result = nil then begin
    Result := TULObj(FldDesc.ValuesSource);
  end;
  if Result = nil then begin
    if ULFKeeper.FindByULObjPath(ULRecIDToStrStrip(FldDesc.ValuesSourceRecID) + ':' , 0, Result) then
    begin
      FldDesc.ValuesSource := Result;
    end;
  end;
  if Result = nil then
    SetResult(orValuesSourceNil, 'GetValuesSource ' + FldDesc.Name);
end;

procedure TULObjField.DoObjModified;
begin
end;
{/v0.47}

{v0.50}
procedure TULObjField.DefDirNeeded;
  { should be called before accessing FileName type field value AsUsrString
    ( causes eventual users to set DefDir used to make absolute path of
    the filename to the wanted value ) }
begin
  FieldUsersNotify(cmULObjFieldDefDirNeeded);
end;
{/v0.50}

{/TULObjField.}

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

constructor TULObjFields.Create(AOwner: TULObj; const AFieldNameList: string);
var
  fl, ln:string;
  n: shortstring;
  v: AnsiString;
  i: integer;
  f: TULObjField;
  od: TULObjDesc;
const
  Delim = ',';
begin
  inherited Create;
  {v0.47}
  FObj := AOwner;
  if AFieldNameList <> '' then begin
    fl := AFieldNameList;
    while ExtractWord([Delim], ln, fl) do begin
      if GetPropIndex(AOwner, ln) >= 0 then begin
        f := TULObjField.Create(Self, ln);
      end else begin
        f := TULObjCalcField.Create(Self, ln);
      end;
      Add(f);
    end;
  end else begin
    od := FObj.ObjDesc;
    if od.ULRecDesc <> nil then begin
      for i := 0 to od.ULRecDesc^.FldCount - 1 do begin
        n := od.ULRecDesc^.Flds^[i].FieldName;
        if GetPropIndex(AOwner, n) >= 0 then
          f := TULObjField.Create(Self, n)
        else
          f := TULObjCalcField.Create(Self, n);
        Add(f);
      end;
    end else begin
      i := FObj.ObjDesc.FirstPropIndex;
      while ClassGetPropNameAndValue(AOwner, i, n, v) do begin
        f := TULObjField.Create(Self, n);
        Add(f);
        inc(i);
      end;
    end;
  end;
  {/v0.47
  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
  {$IFDEF DEBCRASH}
  Obj.Log(Obj.ObjDesc.Caption + ' ULObjFields.Destroy begin');
  {$ENDIF}
  ClearFields;
  inherited;
  {$IFDEF DEBCRASH}
  Obj.Log(Obj.ObjDesc.Caption + ' ULObjFields.Destroy end');
  {$ENDIF}
end;

{v0.47}
procedure TULObjFields.DoObjModified;
var i: integer;
begin
  for i := 0 to Count - 1 do
    Fields[i].DoObjModified;
end;
  { called if some field of Obj modified; does nothing by default }
{/v0.47}

{/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{v0.24}(ARecID: TULRecID){/v0.24};
{v0.24}
var
  AOwner, c: TULObj;
  ins: boolean;
  i: integer;
{/v0.24}
begin                 {ulrectyp}
  FChildList := TList.Create;
  RecLen := GetMinRecLen;
  CountFieldsLen(false);
  Flags := rfDefault;
  {$IFDEF ULOBJTIME}
  CreateTime := Now;
  ChangeTime := Now;
  {$ENDIF}
  {v0.22}
  FActiveChildFieldIndex := -1;
  {/v0.22}
  {v0.44}
  FSortChildFieldIndex := -1;
  {/v0.44}

  {v0.24 moved from TULFObj }
  RecID := ARecID;
  if Owner is TULObj {(Owner <> nil)} then begin
    AOwner := TULObj(Owner);
    if AOwner.IsFlagSet(rfChildSorted) then begin
      ins := false;
      for i := 0 to AOwner.ChildCount - 1 do begin
        c := AOwner.Childs[i];
        if GetSortStr < {v0.28}c.GetSortStr{/v0.28 GetSortStr} then begin
          AOwner.ChildList.Insert(i, Self);
          ins := true;
          break;
        end;
      end;
      if not ins then
        AOwner.ChildList.Add(Self);
    end else begin
      if AOwner.InsertNextChild then begin
        i := AOwner.ActiveChildIndex;
        if i >= 0 then
          AOwner.ChildList.Insert(i, Self)
        else
          AOwner.ChildList.Add(Self);
        AOwner.InsertNextChild := false;
      end else
      begin
        AOwner.ChildList.Add(Self);
      end;
    end;
  end else begin
    {v0.50}
    AOwner := nil;
    {/v0.50}
    if (ARecID <> ULFID) and (ARecID <> ULRID) {v0.54}and (ARecID <> ULOID){/v0.54}then
      SetResult(orMustHaveOwner,'Must have owner ' + IntToStr(ARecID));
  end;
  AddRef;
  {/v0.24}
  {v0.50}
  if AOwner <> nil then begin
    if Assigned(AOwner.ObjDesc.OnChildCreated) then
      AOwner.ObjDesc.OnChildCreated(Self);
  end;
  {/v0.50}
end;

constructor TULObj.Create(AOwner: TComponent; ARecID:TULRecID);
begin
  inherited Create(AOwner);
  {v0.26}
  DoChangeLock;
  try
    {/v0.26}
    DoOnCreate(ARecID);
    {v0.24}{/v0.24 RecID := ARecID;
    if AOwner = nil then begin
      if (RecID <> ULFID) then begin
        SetResult(orMustHaveOwner, 'Must have owner ' + RecIDStr);
      end;
    end;
    AddRef;}
    {v0.26}
  finally
    DoChangeUnlock;
  end;
  {/v0.26}
end;

constructor TULObj.Load(const AFileName: TFileName);
      { creates all from given file }
begin
  inherited Create(nil);
  {v0.26}
  DoChangeLock;
  try
  {/v0.26}

  DoOnCreate{v0.24}(ULFID);{/v0.24;
  RecID := ULFID;
  AddRef;}
  {v0.26}
  finally
    DoChangeUnlock;
  end;
  {/v0.26}
  LoadFromFile(AFileName);{ulaobju}
end;

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


(*v0.38*)
procedure TULObj.LoadFromFile(const AFileName: TFileName);
  { create ULObj childs using data stored the file AFileName,
    opens stream and calls LoadRecFromStream }
var
  {v0.48}
  s : TStream;
  ts: TStream;
  {/v0.48 s: TFileStream;}
  o: TULObj;
  e: string;
  so: TStreamOptions;
  fn: string;
begin
  fn := AFileName;
  if fn = '' then
    fn := FileName;
  if fn = '' then
    SetResult(orEmptyFileName, 'LoadFromFile');
  e := UpperCase(ExtractFileExt(fn));
  FillChar(so, sizeof(so), 0);
  if e = AscExt then
    so.Flags := sfAscii;
  s := nil;
  DoChangeLock;
  try
    Clear;
    {v0.48}
    {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.LoadFromFile ' + AFileName + ' begin');
    {$ENDIF}

    if LoadUseMemStreamBuffer then begin
      ts := TFileStream.Create(fn, fmOpenRead + fmShareDenyWrite);
      try
        s := TMemoryStream.Create;
        s.CopyFrom(ts, ts.Size);
        s.Position := 0;
      finally
        ts.Free;
      end;
    end else
    {/v0.48}
      s := TFileStream.Create(fn, fmOpenRead + fmShareDenyWrite);
    repeat
    until not LoadFromStream(s, so, o);
  finally
    DoChangeUnlock;
    s.Free;
    {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.LoadFromFile ' + AFileName + ' end');
    {$ENDIF}
  end;
  Modified := false;
  FileName := fn;
end;

(*/v0.38
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;
  Clear;
  s := nil;
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromFile ' + {v0.25}FileName{/v0.25 AFileName} + ' begin');
  {$ENDIF}
  {v0.26}
  DoChangeLock;
  {/v0.26}
  try
    s := TFileStream.Create({v0.25}FileName{/v0.25 AFileName}, fmOpenRead + fmShareDenyWrite);
    repeat
    until not LoadFromStream(s, so, o);
  finally
    {v0.26}
    DoChangeUnlock;
    {/v0.26}
    s.Free;
  end;
  {v0.09}
  Modified := false;
  {/v0.09}
  {$IFDEF DEBLOAD}
    DebLog('ULObj.LoadFromFile ' + {v0.25}FileName{/v0.25 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 := '';          //ulaobju
    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}

    {v0.65}
    if r = ULFID then begin
      if RecID <> ULFID then begin
        SetResult(orReadULFIDByNonULFObj, '');{ulrectyp}
      end else
        AObj := Self;
    end else
    {/v0.65}
      AObj := Add(r);
    so.IndentLevel := so.IndentLevel + '  ';
  end;

{v0.24}
const
    ULADID = ord('U') + 256*ord('L') + 256*256*ord('A') + 256*256*256*ord('D');
{/v0.24}

begin
  LoadFromStream := false;
  AObj := nil;
  {v0.25}
  if AStream.Position = AStream.Size then
    exit;
  {/v0.25}
  {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.LoadFromStream begin pos=' + IntToStr(AStream.Position));
  {$ENDIF}
  {v0.26}
  DoChangeLock;
  try
  {/v0.26}
    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(ObjDesc.Caption + '.LoadFromStream head: ID=' + ULRecIDToStr(head.RecID) +
          ' RecLen=' + IntToStr(head.RecLen));
      {$ENDIF}
      {v0.65}
      if (head.RecID = ULFID) then begin
        if (RecID = ULFID) then begin
          AObj := Self;
        end else begin
          SetResult(orReadULFIDByNonULFObj, '');{ulrectyp}
        end;
      end else
      {/v0.65}
        AObj := Add(head.RecID);
      {v0.24}
      {if head.RecID = ULADID then begin
        l := 0;
      end;}
      {/v0.24}
      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;
    {v0.26}
    AObj.DoChangeLock;
    try
    {v0.26}
      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(ObjDesc.Caption + '.LoadFromStream reset default RecLen=' + IntToStr(AObj.GetMinRecLen) +
              ', in File was RecLen=' + IntToStr(head.RecLen));
          {$ENDIF}
        end;
      end;
      {v0.22}
      if IsFlagSet(rfHasPointer) then begin
      end;
      {/v0.22}
      {$IFDEF DEBLOAD}
      DebLog(ObjDesc.Caption + '.LoadFromStream end pos=' + IntToStr(AStream.Position));
      {$ENDIF}
    {v0.26}
    finally
      AObj.DoChangeUnlock;
    end;
    {/v0.26}
  {v0.26}
  finally
    DoChangeUnlock;
  end;
  {/v0.26}
  LoadFromStream := true;
end;

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

  procedure ReadAsciiRec;
  var
    s, pn {v0.22}{/v0.22 ,pv}: shortstring;
    i: integer;
    {v0.22}
    ts: shortstring;
    pv: string;
    fd: TULObjFldDesc;
    {/v0.22}
  begin {ulrectyp winutl}
    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
            {v0.22}
            ts := LTrim(s);
            i := pos(AscValDelimiter, s);
            if (i = 0) or
               ( (length(s) - length(ts)) > length(so.IndentLevel)) then
            begin
              {i.e. no "=" in the line or the leading spaces are beyond current
                indentlevel }
              if ( (length(s) >= length(so.MemoLevel)) and
                   (copy(s, 1, length(so.MemoLevel)) = so.MemoLevel)
                 ) or
                 ( ts = '' )
              then begin
                { it is continuing value of memo field (multiline string) }
                pn := so.LastPropName;
                fd := ObjDesc.FindFldDesc(pn);
                ts := copy(s, length(so.MemoLevel) + 1, length(s));
                if ClassGetPropStr(Self, fd.RTIndex, pv) then begin {proputl}
                  if ClassSetPropStr(Self, fd.RTIndex, pv + #13#10 + ts) = 0 then
                    SetResult(orSetPropStrFailed, pn + '=' + pv + #13#10 + ts);
                end else begin
                  SetResult(orGetPropStrFailed, pn + '=' + pv);
                end;
              end else begin
                SetResult(orInvalidAscFormat, 'Invalid Asc format: "' +
                  AscValDelimiter + '" missing. Line ' + IntToStr(so.Line));
              end;
            end else begin
              so.MemoLevel := Pad(so.MemoLevel, i);
              i := pos(AscValDelimiter, ts);
              pn := copy(ts, 1, i - 1);
              pv := copy(ts, i + 1, 255);
              if ClassSetPropStr(Self, pn, pv) > 0 then begin
                so.LastPropName := pn
              end else begin
                SetResult(orSetPropStrFailed, pn + '=' + pv);
              end;
            end;
            {/v0.22
            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
  {v0.65}{/v0.65
  if (RecID = ULFID) then
    SetResult(orULFCantLoadRecFromStream, 'ULF can not LoadRecFromStream');}
  {v0.26}
  DoChangeLock;
  try
  {/v0.26}
    {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.LoadRecFromStream begin pos=' + IntToStr(AStream.Position));
    {$ENDIF}

    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));
      {v0.62}
      propsize := FRec^.Info.FieldsLen - sizeof(TULRecHead) - sizeof(TULRecInfo);
      propread := ClassReadPropsFromStream(Self, FObjDesc.FirstPropIndex,
                         propsize, AStream);{proputl}
      if propread<>propsize then
         AStream.Seek(propsize - propread, soFromCurrent);
      FRec^.Info.FieldsLen := propread + sizeof(TULRecHead) + sizeof(TULRecInfo);
      {/v0.62
       FRec^.Info.FieldsLen := ClassReadPropsFromStream(Self, FObjDesc.FirstPropIndex,
         FRec^.Info.FieldsLen - sizeof(TULRecHead) - sizeof(TULRecInfo), AStream)
         + sizeof(TULRecHead) + sizeof(TULRecInfo);
      }
      {$IFDEF DEBLOAD}
      DebLog(ObjDesc.Caption + '.LoadRecFromStream Info.FieldsLen=' + IntToStr(FRec^.Info.FieldsLen) + ' Info.DataLen=' + IntToStr(FRec^.Info.DataLen));
      {$ENDIF}
      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;
  {v0.26}
   {$IFDEF DEBLOAD}
     DebLog(ObjDesc.Caption + '.LoadRecFromStream end pos=' + IntToStr(AStream.Position));
   {$ENDIF}

  finally
    DoChangeUnlock;
  end;
  {/v0.26}
end;

{v0.25}
procedure TULObj.Save;
begin
  SaveToFile('');
end;
{/v0.25}

(*v0.38*)
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;
  fn: string;
begin
  fn := AFileName;
  if fn = '' then
    fn := FileName;
  {$IFDEF DEBLOAD}
  DebLog(ObjDesc.Caption + '.SaveToFile ' + fn + ' begin');
  {$ENDIF}
  if fn = '' then
    SetResult(orEmptyFileName, 'SaveToFile');
  e := UpperCase(ExtractFileExt(fn));
  FillChar(so, sizeof(so), 0);
  if e = AscExt then
    so.Flags := sfAscii;
  AStream := nil;
  tmp := ReplaceExt(fn, 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;
  {v0.61}
  if (not FileExists(fn)) or DeleteFile(fn) then begin
    if RenameFile(tmp, fn) then begin
      FileName := fn;
      {v0.67}
      {v0.69}{/v0.69 if FMH <> nil then
        FMH.FileAdd(fn);}
      {/v.67}
    end else begin
      raise EULObj.Create('Could not rename file: ' + tmp + ' -> ' + fn);
    end;
  end else begin
    raise EULObj.Create('Could not delete old file: '+ fn);
  end;
  {/v0.61
  DeleteFile(fn);
  RenameFile(tmp, fn);
  FileName := fn;
  }
  {$IFDEF DEBLOAD}
  DebLog(ObjDesc.Caption + '.SaveToFile ' + fn + ' end');
  {$ENDIF}
end;
(*/v0.38
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
  fnch := false;
  if AFileName <> '' then begin
    FileName := AFileName;
  end;
  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;
    {v0.22}
    fpi: integer;
    ss: TStringStream;
    il, h, sl: shortstring;
    {/v0.22}
  begin
    asciiHeadWritten:= true;
    i := 0;
    StreamWriteln(AStream, so.IndentLevel + {v0.14}ULRecIDToStrStrip(RecID)
      {/v0.14 ULRecIDToStr(RecID)} + AscBeginTag);
    so.IndentLevel := so.IndentLevel + '  ';

    {v0.22 multiline strings}
    fpi := ObjDesc.FirstPropIndex;
    ss := nil;
    try
      {/v0.22}
      while ClassGetPropNameAndValue(TObject(Self), i, pn, pv) do begin
        {v0.22}
        if (i >= fpi) and Fields[i - fpi].FldDesc.IsMemo then begin
          {ulobjdes}
          il := so.IndentLevel + pad('',length(pn + AscValDelimiter));
          if ss = nil then begin
            ss := TStringStream.Create(pv)
          end else begin
            ss.Size := 0;
            ss.WriteString(pv);
          end;
          ss.Position := 0;
          h := so.IndentLevel + pn + AscValDelimiter;
          while StreamReadln(ss, sl) do begin
            StreamWriteln(AStream, h + sl);
            h := il;
          end;
        end else
        {/v0.22}
        begin
          StreamWriteln(AStream, so.IndentLevel + pn + AscValDelimiter + pv);
        end;
        inc(i);
      end;
    {v0.22}
    finally
      ss.Free;
    end;
    {/v0.22}
  end;

  procedure WriteBinHead;
  begin
    {AStream.WriteBuffer(FRec^, FRec^.Head.RecLen);}
    AStream.WriteBuffer(FRec^, sizeof(FRec^.Head) + sizeof(FRec^.Info));
    {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.SaveToStream before props to stream pos=' +
      IntToStr(AStream.Position) + ' FieldsLen=' + IntToStr(FRec^.Info.FieldsLen));
    {$ENDIF}
    ClassWritePropsToStream(Self, FObjDesc.FirstPropIndex, AStream);
    {$IFDEF DEBLOAD}
    DebLog(ObjDesc.Caption + '.SaveToStream after props to stream pos=' + IntToStr(AStream.Position));
    {$ENDIF}
  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
  {$IFDEF DEBLOAD}
  DebLog(ObjDesc.Caption + '.SaveToStream begin pos=' + IntToStr(AStream.Position));
  {$ENDIF}
  if (RecID <> ULFID) {v0.65} or (ULObjFileVersion > 0){/v0.65} 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;
  {$IFDEF DEBLOAD}
  DebLog(ObjDesc.Caption + '.SaveToStream end pos=' + IntToStr(AStream.Position));
  {$ENDIF}
end;

{v0.25}
procedure TULObj.AssignClass(Source: TPersistent);
var
  i: integer;
  pn: shortstring;
  pv: AnsiString;
  pi: PPropInfo;
begin
  i := 0;
  while ClassGetPropNameAndValue(Source, i, pn, pv) do begin
    inc(i);
    if ClassGetPropInfo(Self, pn, pi) then begin
      ClassSetPropStr(Self, pn, pv);
    end;
  end;
end;                                
{/v0.25}

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;}
  {v0.25}
  pi: PPropInfo;
  {/v0.25}
begin
  {v0.26}
  DoChangeLock;
  try
  {/v0.26}
    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
        {v0.25 total nonsense}{/v0.25
        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);
          {proputl}
          {v0.25}
          if ClassGetPropInfo(Self, pn, pi) then begin
            ClassSetPropStr(Self, pn, pv);
          end;
          {/v0.25
          l := l + ClassSetPropStr(Self, pn, pv);}
        end;
        {v0.25}{/v0.25
        Rec^.Info.FieldsLen := l;}
      end;

      case GetChildType of
        ctULRec: begin
          {v0.24}
          DoChangeLock;
          try
          {/v0.24}
            Clear;
            for i := 0 to TULObj(Source).ChildCount - 1 do begin
              s := TULObj(Source).Childs[i];
              {v0.50}
              if IsChildRecID(s.RecID) then begin
                d := Add(s.RecID);
                d.Assign(s);
              end;
              {/v0.50
              d := Add(s.RecID);
              d.Assign(s);}
            end;
          {v0.24}
          finally
            DoChangeUnlock;
          end;
          {/v0.24}
        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
  {v0.26}
  finally
    DoChangeUnlock;
  end;
  {/v0.26}
end;

{v0.18}
function TULObj.GetTopOwner: TULObj;
var o: TULObj;
begin
  Result := nil;
  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; {ulatype}
begin
  Result := nil;
  if ChildType = ctNone then begin
    SetResult(orNoChildAllowed, 'Add ' +
      ULRecIDToStr(ARecID));
  end;
  DoChangeLock;
  try
    Result := AddObj(Self, ARecID);
    DoChange;
  finally
    DoChangeUnlock;
    {v0.46}
    {v0.48 could have been locked more times}
    if not DoChangeLocked then
    {/v0.48}
      ActiveChild := Result;
    {/v0.46}
  end;
end;

{v0.50}
function TULObj.Find(ARecID: TULRecID; const ARecName: string; var AObj: TULObj): boolean;
  { as FindObj but looks only to Childs (not self, not recursively) }
begin
  Result := FindObj(ARecID, foNotSelf + foNotRecursive, ARecName, AObj);
end;

function TULObj.FindChild(ARecID: TULRecID; ARecName: TULRecName): TULObj;
  { calls Find(ARecID, ARecNamee) and raises exception if specified child
    not found, otherwise returns it (i.e. call this instead of
    FindOrAdd if the child should be already present) }
begin
  if not Find(ARecID, ARecName, Result) then
    SetResult(orChildNotFound, ULRecIDToStrStrip(ARecID) + ' ' + ARecName);{ulrectyp}
end;
{/v0.50}

function TULObj.FindOrAdd(ARecID: TULRecID; ARecName: TULRecName): TULObj;
var
  o: TULObj;
begin
  if not FindObj(ARecID, foNotSelf + foNotRecursive, ARecName, o) then begin
    o := Add(ARecID);
    {v0.22}
    {v0.50}
    if (o.FieldCount > 0) and (ARecName <> '') then
      o.RecName := ARecName;
    {/v0.50
    if (o.FieldCount > 0) and o.IsFlagSet(rfHasRecName) then
      o.Fields[0].AsString := ARecName;}
    {/v0.22}
  end;
  FindOrAdd := o;
end;

function TULObj.AddObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
var o: TULObj;
begin
  Result := nil;
  o := Self;
  repeat
    if (o <> nil) then begin
      if not (o is TULObj) then
        SetResult(orNonULObjOwner,'AddObj');
      if {v0.24} (o.RecID <> ULFID) {v0.24} and (o.RecID <> ULRID){/v0.24}
      {v0.54}and (o.RecID <> ULOID){/v0.54}
      then begin
        o := TULObj(o.Owner);
      end else begin
        Result := 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);{ulfobju}
        break;
      end;
    end else
      SetResult(orULFTopOwnerNotFound,'Browse');
  until false;
{$ELSE}
  Result := 0;
{$ENDIF}
end;

function TULObj.Edit: integer;
{$IFNDEF CONSOLE}
var o: TULObj;
{v0.21}
  modal:boolean;
{/v0.21}
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
        {v0.21}
        modal := IsFlagSet(rfEditModal);{ulrectyp}
        {/v0.21}
        Edit := o.EditObj(Self, {v0.21} modal{/v0.21 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);{ulfobju}
        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 ulfobju uledfrm}
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);
{v0.38}
var i: integer;
{/v0.38}
begin
  {v0.31}
  if FFileName <> AFileName then begin
    FFileName := AFileName;
    UsersNotify(cmULObjFileNameChanged);
    {v0.38}
    for i := 0 to ChildCount - 1 do begin
      Childs[i].UsersNotify(cmULObjFileNameChanged);
    end;
    {/v0.38}
  end;
  {/v0.31
  FFileName := AFileName;}
end;

function TULObj.IsFlagSet(rf:TULRecFlags):boolean;
  { returns (rf ans Flags) = rf }
{v0.23}
var  f: TULRecFlags;
{/v0.23}
{v0.24}
var od:TULObjDesc;
{/v0.24}
begin
  {v0.23}
  f := Flags;
  if (rf and rfIsBrowseChild) <> 0 then begin
    if UserMode = umSysOp then begin

      f := f or rfIsBrowseChild

    end else begin

      if (Owner <> nil) and (Owner is TULObj) then begin
        {v0.24}
        od := TULObj(Owner).ObjDesc;
        if od.BrowseChildRecIDCount > 0 then begin
          if od.IsBrowseChildRecID(RecID) then
            f := f or rfIsBrowseChild;
        end else begin
          if  (rfVisible and Flags) <> 0 then
            f := f or rfIsBrowseChild;
        end;
        {/v0.24
        with TULObj(Owner).ObjDesc do begin
          if BrowseChildRecIDCount > 0 then begin
            if IsBrowseChildRecID(RecID) then
              f := f or rfIsBrowseChild;
          end else begin
            if  (rfVisible and Flags) <> 0 then
              f := f or rfIsBrowseChild;
          end;
        end;}

      end else begin
        if (rfVisible and Flags) <> 0 then
          f := f or rfIsBrowseChild;
      end;
    end;
  end;
  IsFlagSet := (rf and f) = rf;
  {/v0.23
  IsFlagSet := (rf and Flags) = rf;}
end;

procedure TULObj.SetFlag(rf:TULRecFlags; OnOff:boolean);   {ulbrowu}
      { performs for OnOff = true: Flags := Flags or rf;
                 for OnOff = false: Flags := Flags and (not rf); }
{v0.45}
var f: TULRecFlags;
{/v0.45}
begin
  {v0.45}
  f := Flags;
  {/v0.45}
  if OnOff then begin
    SetFlags(Flags or rf)
  end else begin
    SetFlags(Flags and (not rf));
  end;

  if (rf and rfSelected) <> 0 then begin
    {v0.45}
    if (f and rfSelected) <> (Flags and rfSelected) then
    {/v0.45}
    begin
      {v0.44}{ulrectyp}
      if (rfOwnMessageOnSelect and Flags) <> 0 then begin
        DoChangeSelect;
      end else
      {/v0.44}
        DoChange;
    end;
  end;
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;

{v0.64}
var
  FInDestroyCount: integer = 0;
{/v0.64}
destructor TULObj.Destroy;
var
  l: TList;
  i: integer;
  {v0.24}
  s: string;
  o: TObject;
  {/v0.24}
begin
  {v0.65}
  {$IFDEF DEBCRASH}
//  Log(ClassName + '.Destroy begin');
  {$ENDIF}
  {/v0.65}
  {v0.64}
  inc(FInDestroyCount);
  try
  {/v0.64}
  {v0.24}
  if (Owner <> nil) and (Owner is TULObj) then begin
    l := TULObj(Owner).ChildList;
    i  := l.IndexOf(Self);
    if i >= 0 then
      l.Delete(i);
    if TULObj(Owner).ActiveChild = Self then
      TULObj(Owner).ActiveChild := nil;
    {TULObj(Owner).DoChange;}
  end;
  {/v0.24}
  UsersNotify(cmULObjDestroyed);
  {v0.22}{logfrm}
  if (FUsers <> nil) and (FUsers.Count > 0) then begin
    { every user should react to cmULObjDestroy message by unregistering itself
      (and setting pointer to this obj to nil) }
    s := '';
    for i := 0 to FUsers.Count - 1 do begin
      o := TObject(FUsers[i]);
      if (o <> nil) then begin
        if o is TComponent then begin
          if TComponent(o).Name = '' then begin
            s := s + 'TComponent,'
          end else
            s := s + TComponent(o).Name + ','
        end else begin
          s := s + 'TObject,';
        end;
      end else begin
        s := s + 'nil,';
      end;
    end;
    SetResult(orUnregisteredUsers, ObjDesc.Caption + '(' + IntToStr(FUsers.Count) + '): ' + s);
  end;
  {/v0.22}
  {v0.24 moved above}
  if (Owner is TULObj) then begin
    TULObj(Owner).DoChange;
  end;
  FUsers.Free;
  FUsers := nil;
  {/v0.24
  if (Owner <> nil) and (Owner is TULObj) then begin
    l := TULObj(Owner).ChildList;
    i  := l.IndexOf(Self);
    if i >= 0 then
      l.Delete(i);
    if TULObj(Owner).ActiveChild = Self then
      TULObj(Owner).ActiveChild := nil;
    TULObj(Owner).DoChange;
  end; }
  DelRef;
  FChildList.Free;
  FData.Free;
  FreeMem(FRec);
  FFields.Free;
  inherited;
  {v0.64}
  finally
    dec(FInDestroyCount);
  end;
  {/v0.64}
  {v0.65}
  {$IFDEF DEBCRASH}
//  Log(ClassName + '.Destroy end');
  {$ENDIF}
  {/v0.65}
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.23}
function TULObj.FindByULObjPath(const AULObjPath: string; fo:TULRecFindOptions;
   var AObj: TULObj): boolean;
{
  Search for AObj in the whole ULObjs tree (including other files).

  Syntax for AULObjPath:

   [ /[::file="filename"/] | ../ ]
   [[[RecIDStrX:][[PropNameX=]"PropValueX"]].][[RecIDStr:][[PropName2=]"PropValue2"]]
   ...

  if starts with / search will start from all registered ULFObj file roots
    (if file name specified, then only in this file used), will scan the file(s)
    until something found or failed

  if does not start with /, then the object itself and its childs will be
  searched

  if starts with .. search will be started from the objects's owner

  if RecIDStrX: specified, and the Obj has this RecID, then the info for this
    RecID will be stripped off and the remaining path will be submitted to childs
   (and childs of childs, ..). If no remaining path, checked this obj for match.

  If RecIDStrX not specified, than path will be stripped only if property
  name and value match found in this ULObj.  Otherwise unmodified path will
  be submited to childs.

  If PropName will be omitted, than the value will be compared to
  value taken from (checking for presence in the following order):

  1. ObjDesc.NameProp field, if not specified (i.e. ObjDecs.NameProp=''), then ...
  2. if the Obj has rfHasRecName flag set - the first ULObj indexed string
     field (that is RecName) is used, if does not have rfHasRecName flag set...
  3. TComponent.Name is used
  .. Use ObjDesd.EfNameProp to get name of the field from which the value
  should be taken.

  From ULObjFields AsUsrString value is checked.

  Values must be specified in quotes if contain spaces, dots, slahes, colons, etc.
}

var
  idStr, pName, pValue, rest,
  tValue: string;
  {id:TULRecID;}
  i: integer;
  inQ: boolean;{, valueFound: boolean;}
  ch: char;
  {f:TULObjField;}

  function Cut: string;
  begin
    Result := copy(rest, 1, i - 1);
    rest := copy(rest, i + 1, length(rest));
    i := 0;
  end;

  function ScanChilds(const APath:string): boolean;
  var
    i: integer;
  begin
    Result := false;
    for i := 0 to ChildCount - 1 do begin
      if Childs[i].FindByULObjPath(APath, fo, AObj) then begin
        Result := true;
        exit;
      end;
    end;
  end;

  {v0.52}
  procedure GettValue;
  begin
    if pName = 'Name' then begin
      tValue := Name;
    end else  if pName = 'ClassName' then begin
      tValue := ClassName;
    end else if pName = 'ClassDesc' then begin
      tValue := ObjDesc.Caption;
    end else  begin
      tValue := FindField(pName).AsUsrString;
    end;
  end;
  {/v0.52}
  
begin
  Result := false;
  {v0.47}
  if AULObjPath = '' then
    exit;
  {/v0.47}
  if AULObjPath[1] = '/' then begin
{ulfobju}
    {v0.50}
    fo := fo or foFromRoot;
    {/v0.50}
    Result := TopOwner.FindByULObjPath({v0.47}copy(AULObjPath, 2,
      length(AULObjPath)){/v0.47 AULObjPath}, fo, AObj)

  end else if (length(AULObjPath) > {v0.50}2{/v0.50 1}) and (copy(AULObjPath, 1, 2) = {v0.50}'../'{/v0.50 ..}) then
  begin

    if Owner is TULObj then begin
      Result := TULObj(Owner).FindByULObjPath(copy(AULObjPath, {v0.50}4{/v0.50 3}, length(AULObjPath)), fo, AObj);
    end else
      SetResult(orNonULObjOwner, AULObjPath);

  end else begin
    {v0.50}
    if (fo and foFromRoot) <> 0 then begin
      if RecID = ULFID then begin
        {check if file name specified, if yes and different then exit}
      end;
    end;
    {/v0.50}

    inQ := false;
    {valueFound := false;}
    idStr := '';
    pName := '';
    pValue := '';
    rest := AULObjPath;
    i := 1;
    while i <= length(rest) do begin
      ch := rest[i];
      if not inQ then begin
        case ch of
          ':': begin
            idStr := Cut
          end;
          '=': begin
            pName := Cut;
          end;
          '"': begin
            inQ := true;
            if i <> 1 then begin
              SetResult(orMisplacedQuoteInFindByULPath, rest);{ulrectyp}
            end;
            Cut;
          end;
          '.': begin
            pValue := Cut;
            break;
          end;
        end
      end else begin
        if ch = '"' then begin
          {$HINTS OFF}
          inQ := false;
          {$HINTS ON}
          pValue := Cut;
          if rest <> '' then begin
            if rest[1] <> '.' then begin
              SetResult(orDotMissingInULPath, rest);
            end;
            rest := copy(rest, 2, length(rest));
          end;
          break;
        end;
      end;
      inc(i);
    end;

    if idStr <> '' then begin

      if (idStr = ULRecIDToStrStrip(RecID)) then begin

        if pName = '' then begin
          if pValue = '' then begin
            if rest <> '' then begin
              pValue := rest;
              rest := '';
            end;
          end;

          if pValue = '' then begin
            if rest <> '' then begin
              Result := ScanChilds(rest);
              exit;
            end else begin
              AObj := Self;
              Result := true;
              exit;
            end;
          end else begin
            pName := ObjDesc.EfNameProp;
          end;
        end;

        if pValue = '' then begin
          pValue := rest;
          rest := '';
        end;

        {v0.52}
        GettValue;
        {/v0.52
        f := FindField(pName);
        tValue := f.AsUsrString;}
        if (tValue = pValue) or (pValue = '') then begin
          if rest = '' then begin
            AObj := Self;
            Result := true;
            exit;
          end else begin
            Result := ScanChilds(rest);
          end;
        end;

      end else begin
        Result := ScanChilds(AULObjPath);
      end;

    end else begin
      {idStr = ''}
      if pName = '' then begin

        if pValue = '' then begin
          pValue := rest;
          rest := '';
        end;
        if pValue = '' then begin
          Result := ScanChilds(AULObjPath);
          exit;
        end;

        pName := ObjDesc.EfNameProp;
        {v0.52}
        GettValue;
        {/v0.52
        if pName = 'Name' then begin
          tValue := Name;
        end else begin
          tValue := FindField(pName).AsUsrString;
        end;   }
        if tValue <> pValue then
          Result := ScanChilds(AULObjPath)
        else begin
          if rest <> '' then
            Result := ScanChilds(rest)
          else begin
            AObj := Self;
            Result := true;
          end;
        end;

      end else begin
        {v0.52}
        GettValue;
        {/v0.52
        if pName = 'Name' then begin
          tValue := Name;
        end else  if pName = 'ClassName' then begin
          tValue := ClassName;
        end else if pName = 'ClassDesc' then begin
          tValue := ObjDesc.Caption;
        end else  begin
          tValue := FindField(pName).AsUsrString;
        end;
        }
        if tValue <> pValue then begin
          {v0.50 only if not searching from root???!!!}
          Result := ScanChilds(AULObjPath);
          {/v0.50
          Result := false;
          exit;}
        end else begin
          if rest <> '' then begin
            Result := ScanChilds(rest);
          end else begin
            AObj := Self;
            Result := true;
          end;
        end;

      end;

    end;

  end;
end;
{/v0.23}


{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
    {v0.50}
    if EfNameField <> nil then begin
      Result := EfNameField.AsString;
    end else
    {/v0.50}
    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}


{v0.46}
{procedure TULObj.DeleteAll;
begin
  if ChildCount > 0 then begin
    Clear;
    UsersNotify(cmULObjAfterChildsDelete);
  end;
end;}
{/v0.46}

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;

{v0.22}
function ChildCompareField(Item1, Item2: pointer): integer;
var
  u1: TULObj absolute Item1;
  u2: TULObj absolute Item2;
  o: TULObj;
  i: integer;
  s1, s2: string;
  {v0.44}
  f1, f2: TULObjField;
  e1, e2: extended;
  i1, i2: integer;
  {/v0.44}
begin
  o := TULObj(u1.Owner);
  if o = nil then
    u1.SetResult(orNilOwner, 'ChildCompareField');

  {v0.44}
  i := o.FSortChildFieldIndex;
  {/v0.44
  i := o.ActiveChildFieldIndex;}
  {v0.44}
  f1 := u1.Fields[i];
  f2 := u2.Fields[i];

  case f1.FldDesc.TypeKind of

    tkInteger, tkChar, tkSet, tkEnumeration: begin
      i1 := f1.GetInteger;
      i2 := f2.GetInteger;
      if i1 < i2 then
        Result := -1
      else if i1 > i2 then
        Result := 1
      else
        Result := 0;
    end;

    tkFloat: begin
      e1 := f1.GetFloat;
      e2 := f2.GetFloat;
      if e1 < e2 then
        Result := -1
      else if e1 > e2 then
        Result := 1
      else
        Result := 0;
    end;
    {
    tkString, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);}
  else
  {/v0.44}
    begin
      s1 := u1.Fields[i].GetValue;
      s2 := u2.Fields[i].GetValue;
      if s1 < s2 then
        Result := -1
      else if s1 > s2 then
        Result := 1
      else
        Result := 0;
    end;
  {v0.44}
  end;
  {/v0.44}
(*case u1.Fields[i].FldDesc.TypeKind of
    tkInteger:
    {tkInteger, tkChar, tkEnumeration, tkWChar:}
    {proputl ulobjdes}
    tkFloat:
  else
  end;*)
end;
{/v0.22}

procedure TULObj.Sort;
begin
  if ChildCount = 0 then
    exit;
  if Assigned(FSortProc) then begin
    FChildList.Sort(FSortProc);
    {v0.44}{classes}
    UsersNotify(cmULObjChildsResorted);
    {/v0.44}
  end else begin
    if IsFlagSet(rfChildSorted) then begin
      if IsFlagSet(rfSortedByNumber) then
        FChildList.Sort(ChildCompareNum)
      else
        FChildList.Sort(ChildCompare);
      {/v0.44}
      UsersNotify(cmULObjChildsResorted);
      {/v0.44}
    end;
  end;
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;
  {v0.24}
  {$IFNDEF CONSOLE}
  if FLogUserRegUnreg then begin
    if AULObjUser is TPersistent then
      {v0.65}{/v0.65 ExeLog.}Log('UserRegister: ' + PTypeInfo(AULObjUser.ClassInfo)^.Name + ' at ' + ObjDesc.Caption);
  end;
  {$ENDIF}
  {/v0.24}
  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);
      {v0.24}
      {$IFNDEF CONSOLE}
      if FLogUserRegUnreg then begin
        if AULObjUser is TPersistent then
          {v0.65}{/v0.65 ExeLog.}Log('UserUnregister: ' + PTypeInfo(AULObjUser.ClassInfo)^.Name + ' at ' + ObjDesc.Caption);
      end;
      {$ENDIF}
      {/v0.24}
    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}

{v0.44}
function TULObj.UsersNotify(cm: word): integer;
begin
  Result := ObjectUsersNotify(cm, Self);
end;
{/v0.44
function TULObj.UsersNotify(cm: word): integer;}
  { send WM_APPMESSAGe message to all users in FUsers list, supported:
    cmULObjUpdated, cmULObjDestroyed }

function TULObj.ObjectUsersNotify(cm: word; AObject: TObject): integer;
{$IFNDEF CONSOLE}
var
  msg: TMessage;
  i: integer;
  r: integer;
  {v0.14}
  lc: integer;
  {/v0.14}
  {v0.44}
  ocm: word;
  {/v0.44}
{$ENDIF}
begin
  Result := 0;
  {$IFNDEF CONSOLE}
  r := 0;
  if FNotifyCM = cm then
    exit;
  if (FUsers <> nil) and (FUsers.Count > 0) then begin
    {v0.44}
    ocm := FNotifyCM;
    {/v0.44}
    FNotifyCM := cm;
    try
      {v0.47 user can unregister during any message, not only cmULObjDestroyed}{/v0.47
      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({v0.44}AObject{/v0.44 Self});
          lc := FUsers.Count;
          {v0.24}
          if FLogUsersNotify then begin
            if TObject(FUsers.Items[i]) is TPersistent then
              {v0.65}{/v0.65 ExeLog.}Log('UsersNotify.Destroyed ' + ObjDesc.Caption + ' -> ' +
                PTypeInfo(TObject(FUsers.Items[i]).ClassInfo)^.Name);
          end;
          {/v0.24}
          TObject(FUsers.Items[i]).Dispatch(msg);
          if msg.Result <> 0 then
            r := msg.Result;
          if lc = FUsers.Count then begin
            inc(i);{i.e. user was not deleted}
          end;
        end;
      end {v0.47}{/v0.47 else
      for i := 0 to FUsers.Count - 1 do begin
        fillchar(msg, sizeof(msg), 0);
        msg.msg := WM_APPMESSAGE;
        msg.wParam := cm;
        msg.lParam := longint(AObject);
        TObject(FUsers.Items[i]).Dispatch(msg);
        if msg.Result <> 0 then
          r := msg.Result;
      end} ;
      Result := r;
    finally
      {v0.44}
      FNotifyCM := ocm;
      {/v0.44
      FNotifyCM := 0;}
    end;
  end;
  {$ENDIF}
end;

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

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

{v0.24}
procedure TULObj.DoMainPropUpdated;
begin
  UsersNotify(cmULObjMainPropUpdated);
end;
{/v0.24}

procedure TULObj.DoChangeLock;
begin
  {v0.44}
  if FDoChangeLockCount = 0 then
    UsersNotify(cmULObjBeginUpdate);{ulrectyp}
  {/v0.44}
  inc(FDoChangeLockCount);
end;

var testi:integer;
procedure TULObj.DoChangeUnlock;
begin
  if FDoChangeLockCount > 0 then begin
    dec(FDoChangeLockCount);
    {v0.44}
    if (FDoChangeLockCount = 0) then begin
      {debug}
      if (Owner <> nil) and (Owner is TULObj) and (TULObj(Owner).RecID = ULFID) Then begin
        testi := 0;
      end;
      {/debug}
      UsersNotify(cmULObjEndUpdate);
      if (FChangedCount > 0) then begin
        Modified := true;
        UsersUpdate;
        if (Owner <> nil) and (Owner is TULObj) then
          TULObj(Owner).DoChange;
        FChangedCount := 0; {ulbrowsefrm}
      end;
      if (FChangedSelectCount > 0) then begin
        DoChangeSelect;
        FChangedSelectCount := 0;
      end;
    end;
    {/v0.44
    if (FDoChangeLockCount = 0) and (FChangedCount > 0) then begin
      Modified := true;
      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;

{v0.24}{/v0.24
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) }
{v0.24}{/v0.24
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;
}

{v0.24}
function TULObj.ChildWithFlagNext(AFlags: TULRecFlags; var Index: integer): boolean;
var
  i, cc: integer;
begin
  Result := false;
  inc(Index);
  if Index < 0 then
    Index := 0;
  cc := ChildCount;
  if Index >= cc then
    exit;
  for i := Index to cc - 1 do begin
    if Childs[i].IsFlagSet(AFlags) then begin
      Index := i;
      Result := true;
      exit;
    end;
  end;
end;
{/v0.24
function TULObj.ChildWithFlagNext(AFlags: TULRecFlags): boolean;}
  { Returns Index (always bigger then submitted Index) of the child that follows
    after the child at original Index and has all AFlags set; result = false
    if no such child found (used in ULStringGrid) }
{v0.24
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 ({v0.22}(AFlags = 0) or {/v0.22}p.IsFlagSet(AFlags)) and
         p.CanDestroy
         {v0.22}
         and (not p.IsFlagSet(rfCantDelete)) {ulactionu}
         {/v0.22}
      then begin
        {v0.46}
        p.Delete;
        {/v0.46
        p.Free;}
        inc(delcnt);
      end else begin
        inc(i);
      end;
    end;
    if delcnt > 0 then
      DoChange;
  finally
    DoChangeUnlock;
    {0.46}
    if delcnt > 0 then
      UsersNotify(cmULObjAfterChildsDelete);
    {/v0.46}
  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;

{v0.47}
function TULObj.GetRecIDStrStripped: TULRecIDStr;
begin
  Result := ULRecIDToStrStrip(RecID);
end;
{/v0.47}

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
    {v0.22}
    if AObjResult = orEmptyRec then
      id := 'id:None'
    else
    {/v0.22}
      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;{ulrectyp ulmtype modulu}

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 {ulantype}
    if {v0.40}Fields[i].FldDesc.IsFldName(AName)
       {/v0.40 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 {v0.40}Fields[i].FldDesc.IsFldName(AName)
       {/v0.40 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 }{ulrectyp}
var
  i: integer;
begin
  SetState(osModified, OnOff);
  if not OnOff then begin
    {v0.31}
    if (Owner is TULObj) and (TULObj(Owner).RecID = ULFID) then begin
      TULObj(Owner).SetState(osModified, OnOff);
    end;
    {/v0.31}
    for i := 0 to ChildCount - 1 do begin
      Childs[i].Modified := OnOff;
    end;
  end else begin
    if (RecID = ULFID) and (pos('.ULS', FileName) <> 0) then begin
      testi := 1;
    end;
    {v0.47}
    if FFields <> nil then begin
      FFields.DoObjModified;
    end;
    {/v0.47}
  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
  {v0.50}
  DefDirNeeded;
  {/v0.50}
  {v0.41}
  Result := RelativeFileName(ObjDesc.DefDir, FileName, ObjDesc.DefExt);
  {/v0.41
  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;


function TULObj.ValuesSourceFieldFind(const AFieldName: string; var AField: TULObjField): boolean;
var i: integer;
begin
  Result := false;
  AField := nil;
  for i := 0 to FieldCount - 1 do begin
    if {v0.40}Fields[i].FldDesc.IsFldName(AFieldName + '_Src_Ptr')
       {/v0.40 Fields[i].FldDesc.Name = AFieldName + '_Src_Ptr'}
    then begin
      AField := Fields[i];
      Result := true;
      exit;
    end;
  end;
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
{  vsf, }f, sf: TULObjField;
  o, c: TULObj;
  i: integer;

  vf: TULObjField;
begin
  f := Fields[AFieldIndex];
  (*v0.47*)
  o := f.GetValuesSource;
  (*/v0.47
  if not f.FldDesc.IsULEnum then
    SetResult(orNotULEnumField, 'TULObj.FillULEnumNames ' + f.FldDesc.Name);
  {v0.22}

  {v0.46}
  FMessageInfo := AFieldIndex;
  {/v0.46}
  UsersNotify(cmULObjValuesSourceNeeded);
  if ValuesSourceFieldFind(f.FldDesc.Name, vsf) then begin
    o := TULObj(vsf.AsInteger)
  end else
    o := nil;
  {/v0.22}
  if o = nil then begin
    o := TULObj(f.FldDesc.ValuesSource);
  end;
  {v0.24}
  if o = nil then begin
    if ULFKeeper.FindByULObjPath(ULRecIDToStrStrip(f.FldDesc.ValuesSourceRecID) + ':' , 0, o) then
    begin
      f.FldDesc.ValuesSource := o;
    end;
  end;  {ulfobju}
  {/v0.24}
  if o = nil then                                       {ulstringgrid}
    SetResult(orValuesSourceNil, 'TULObj.FillULEnumNames ' + f.FldDesc.Name);
  *)
  {v0.45}
  vf := f.ValueSourceField;
  {/v0.45}
  Items.Clear;
  for i := 0 to o.ChildCount - 1 do begin
    c := o.Childs[i];
    if c.HasField(f.FldDesc.Name, sf) then begin
      Items.Add(sf.AsUsrString);
      {v0.45}
      if vf <> nil then begin
        if sf.AsString = f.AsString then
          vf.AsInteger := integer(c);
      end;
      {/v0.45}
    end;
  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.AsUsrString = 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}

{v0.22}
procedure TULObj.SetSortProc(ASortProc: TListSortCompare);
begin
  FSortProc := ASortProc;
  if Assigned(FSortProc) then
    Sort;
end;

procedure TULObj.SetActiveChildFieldIndex(AULIndex:integer);
{v0.26}
var c: TULObj;
{/v0.26}
begin
  if AULIndex = FActiveChildFieldIndex then
    exit;
  if (AULIndex < 0) then begin
    if AULIndex <> -1 then
      SetResult(orInvalidChildFieldIndex, inttostr(AULIndex));{ulrectyp}
  end else begin
    if ChildCount > 0 then begin
      {v0.26}
      c := ActiveChild;
      if c = nil then
        c := Childs[0];
      if AULIndex >= c.FieldCount then
        AULIndex := -1;
      {/v0.26
      if AULIndex >= Childs[0].FieldCount then begin
        SetResult(orInvalidChildFieldIndex, inttostr(AULIndex));
      end;}
    end;
  end;
  FActiveChildFieldIndex := AULIndex;
  {v0.44}{/v0.44
  if @ChildCompareField = @FSortProc then begin
    Sort;
  end;}
end;

procedure TULObj.SortByField(AULIndex:integer);
{v0.46}
var
  c: TULObj;
  fd: TULObjFldDesc;
{/v0.46}
begin
  ActiveChildFieldIndex := AULIndex;
  {v0.44}
  FSortChildFieldIndex := ActiveChildFieldIndex;
  if FSortChildFieldIndex >= 0 then
  {/v0.44}
  begin
    {v0.46}
    fd := nil;
    if (ChildCount > 0) then begin
      c := Childs[0];
      if FSortChildFieldIndex < c.FieldCount then 
        fd := c.Fields[FSortChildFieldIndex].FldDesc;
    end;
    if (fd <> nil) and Assigned(fd.SortProc) then begin
      if CompareRec(fd.SortProc, SortProc, sizeof(TListSortCompare)) = 0 then begin
        if Assigned(fd.DescSortProc) then
          SortProc := fd.DescSortProc;
      end else begin
        SortProc := fd.SortProc;
      end;
    end else
    {/v0.46}
    begin
      SortProc := ChildCompareField;
    end;
  end;
end;

{$IFNDEF CONSOLE}
function TULObj.GetActions: TULObjActions;
begin
  if FActions = nil then
    FActions := TULObjActions.Create(Self);
  Result := FActions;
end;

{v0.24}
procedure TULObj.ActionsFree;
begin
  FActions.Free;
  FActions := nil;
end;

{/v0.24}

{$ENDIF}

procedure TULObj.SetActiveChild(AChild: TULObj);
var
  i: integer;
begin
  {v0.44}
  i := FChildList.IndexOf(AChild);
  if i <> FActiveChildIndex then begin
    FActiveChildIndex := i;
    UsersNotify(cmULObjActiveChildChanged);{ulstringgrid ulrectyp}
  end;
  {/v0.44
  FActiveChildIndex := FChildList.IndexOf(AChild);}
end;
{/v0.22}

{v0.23}
function TULObj.CanAddChildInBrowser(ARecID: TULRecID; var ARecDesc: PULRecDesc):boolean;
begin
  Result := true;
  ARecDesc := GetULRecDescOf(ARecID);
  if ARecDesc = nil then
    exit;
  if (ARecDesc^.Flags and rfVisible) <> 0 then begin
    {v0.24}
    if not ObjDesc.IsBrowseChildRecID(ARecID) then
      Result := false;
    {/v0.24
    if ARecDesc^.BrowseChildRecIDs <> '' then begin
      if pos(',' + ULRecIDToStrStrip(ARecID) +',', ','+ ARecDesc^.BrowseChildRecIDs + ',') = 0 then
      begin
        Result := false; language
      end;
    end;}
  end else begin
    Result := false;
  end;
end;

{v0.23}
function TULObj.GetEfNameField: TULObjField;
var s: string;
begin
  Result := nil;
  s := ObjDesc.EfNameProp;
  if s <> 'Name' then {ulobjdes}
    Result := FindField(s);
end;
{/v0.23}

{/v0.23}

{v0.24}
{function TULObj.GetMultiChanged: boolean;
begin
  Result := GetState(osMultiChanged);
end;

procedure TULObj.SetMultiChanged(OnOff: boolean);
begin
  SetState(osMultiChanged, OnOff); ulrectyp
  if not OnOff then
    DoChange;
end;
}
function TULObj.GetJustLoadedFromFile: boolean;
begin
  Result := GetState(osJustLoadedFromFile);
end;

procedure TULObj.SetJustLoadedFromFile(OnOff: boolean);
begin
  SetState(osJustLoadedFromFile, OnOff);
  if not OnOff then
    DoChange;
end;

function TULObj.GetJustCreated: boolean;
begin
  Result := GetState(osJustCreated);
end;

{v0.45}
procedure TULObj.FindNewIDIfNeeded;
var
  f: TULObjField;
  od: TULObjDesc;
  ow: TULObj;
  ind: integer;

  l: TList;
  i, cc: integer;
  usid, cid, id: integer;
  maxid: integer;
begin
  if not (Owner is TULObj) then
    exit;
  ow := TULObj(Owner);
  od := ObjDesc;
  f := nil;
  ind := -1;
  maxid := 0;
  for i := 0 to od.FieldCount - 1 do begin
    if od.Fields[i].IsAutoInc then begin
      ind := i;
      f := Fields[ind];
      maxid := f.FldDesc.MaxID;
      break;
    end;
  end;
  if f = nil then
    exit;

  cc := ow.ChildCount;
  if cc > 0 then begin
    l := TList.Create;
    try
      for i := 0 to cc - 1 do begin
        usid := ow.Childs[i].Fields[ind].AsInteger;
        l.Add(pointer(usid));
      end;
      l.Sort(ListSortCompareInt);{classes winutl}
      id := 0;
      for i := 0 to l.Count - 1 do begin
        cid := integer(l.Items[i]);
        if cid > i + 1 then begin
          id := i + 1;
          break;
        end;
      end;
      if id = 0 then begin
        id := integer(l.Items[cc-1]) + 1;
      end;
      if (maxid <> 0) and (id > MaxID) then
        SetResult(urTooManyRecords, GetTxt({#}'Too many records'));{ulrectyp}
    finally
      l.Free;
    end;
  end else begin
    id := 1;
  end;
  f.AsInteger := id;
  {v0.61}
  UsersNotify(cmULObjAutoIncIDAssigned);
  {/v0.61}
end;
{/v0.45}

procedure TULObj.SetJustCreated(OnOff: boolean);
begin
  SetState(osJustCreated, OnOff);
  if not OnOff then begin
    DoChange;
  end{v0.45} else begin
    FindNewIDIfNeeded;
  end{/v0.45};
end;

function TULObj.GetInsertNextChild: boolean;
begin
  Result := GetState(osInsertNextChild);
end;

procedure TULObj.SetInsertNextChild(OnOff: boolean);
begin
  SetState(osInsertNextChild, OnOff);
end;
{$IFNDEF CONSOLE}
function TULObj.GetWindowCaption{v0.41}(AForm: TForm){/v0.41}: string;
var
  o: TULObj;
begin
  Result := ObjDesc.Caption;
  o := TULObj(Owner);
  while (o <> nil) and (o is TULObj) do begin
    if o.RecID = ULFID then begin
      Result := {v0.41}
        MinimizeName(o.RelFileName, AForm.Canvas, AForm.Width - 4*getsystemmetrics(SM_CYCAPTION)) {getsystemmetrics}
        {v0.41 o.RelFileName}+ ':' + Result;
      break;
    end else begin
      Result := o.ObjDesc.Caption + '/' + Result;
    end;
    o := TULObj(o.Owner);
  end;
  {v0.41}
  if Assigned(FOnGetWindowCaption) then
    FOnGetWindowCaption(Result);
end;{ulobjdes}
{$ENDIF}

function TULObj.HasUsrWithProp(const APropName: string; var AULObjUsr: TObject;
       var APropInfo: PPropInfo): boolean;
var
  o: TObject;
  i: integer;
begin
  Result := false;
  AULObjUsr := nil;
  APropInfo := nil;
  if FUsers = nil then
    exit;
  for i := 0 to FUsers.Count - 1 do begin
    o := TObject(FUsers.Items[i]);{proputl}
    if ClassGetPropInfo(o, APropName, APropInfo) then begin
      AULObjUsr := o;
      Result := true;
      exit;
    end;
  end;
end;

procedure TULObj.SetRecName(const ARecName: TULRecNAme);
begin
  if IsFlagSet(rfHasRecName) then
    Fields[0].AsString := ARecName
  {v0.50}
  else begin
    if EfNameField <> nil then begin
      EfNameField.AsString := ARecName;
    end
  end;
 {/v0.50}
end;

{/v0.24}

{v0.25}
{$IFNDEF CONSOLE}

{file save related methods; called if the Obj.Owner = ULFFile,
  or if IsFlagSet(rfRootChild) (for saveas) }
function TULObj.CanClose{v0.31}(AFrom: TWinControl){/v0.31}: boolean;
  { called from BrowseGrid,EditForm.CanClose, invokes DoFileSaveAs if necessary }
var fn: string;
begin
  Result := true;
  if not (Owner is TULObj) then
    exit;
  if TULObj(Owner).RecID <> ULFID then
    exit;
  {v0.58 decide if omit asking to save only if called automatically
    from some wincontrol }
  if (AFrom <> nil) then
  {/v0.58}
  begin
    if (not IsFlagSet(rfAskForSave))
    {v0.31}
       and
       ((not BrowserAutoClose) or (not (AFrom is TULStringGrid)))
       and
       ((not EditorAutoClose) or (not (AFrom is TULEditForm)))
    {/v0.31}
    then
      exit;
  end;
  {if not Obj.IsFlagSet(rfRootChild) then
    exit;}
  fn := RootFileName;
  if (pos('NONAME', {v0.37}Uppercase{/0.37}(fn)) <> 0) or (fn = '') then begin
    if not DoFileSaveAs then begin
      if ShowMessage(GetTxt({#}'Discard the file?'), smNoYes, 0) <> cmYes then begin
        CanClose := false;
      end else begin
        Modified := false;
        {v0.38}
        UsersNotify(cmULObjFileDiscarded);
        {/v0.38}
        {Data.AcquiredDataDiscard;}
      end; {ulanrecs.lst}
    end;
  end else begin
    if not Modified then
      exit;
    if TopOwner.ReadOnly then begin
      case ShowMessage(RootFileName + ' ' + GetTxt({#}'was opened Read Only but modified.') +
        ' ' + GetTxt({#}'Save to other file?'), smYesNoCancel, 0) of

        cmCancel: Result := false;
        cmYes: begin
          if not DoFileSaveAs then begin
            Result := false;
          end else begin
            Modified := false;
          end;
        end;
        cmNo: begin
          Modified := false;
        end;
      end; {aapgtype aapgobju}
    end else begin
      case ShowMessage(RootFileName, smFileModifiedSave, 0) of
        cmCancel: Result := false;
        cmNo: begin
          Reload;{TopOwner.LoadFromFile('');}
          Modified := false;
        end;
      else
        TopOwner.DoFileSave
      end;
    end;
  end;
end;

function TULObj.DoFileSaveAs: boolean;
  { invokes SaveDialog, returns true if file was selected and data saved to it }
var fn: string;
{v0.37}
var ow: TULObj;
{/v0.37}
begin
  {v0.37}
  fn := FileName;
  if fn = '' then
  {/v0.37}
  begin
    fn := TopOwner.FileName;
  end;
  {v0.37}
  ow := Self;
  while (ow.Owner is TULObj) and (not ow.IsFlagSet(rfRootChild)) do begin
    ow := TULObj(ow.Owner);
  end;
  {v0.50}
  ow.DefDirNeeded;
  {/v0.50}
  if FileNameSaveSelect(fn, ow.ObjDesc.Caption, ow.ObjDesc.SaveFilter, ow.ObjDesc.DefDir) then
  begin
    TopOwner.SaveToFile(fn);
    Result := true;
  end else begin
    Result := false;
  end;
  {/v0.37
  if FileNameSaveSelect(fn, ObjDesc.Caption, ObjDesc.SaveFilter, ObjDesc.DefDir) then begin
    TopOwner.SaveToFile(fn);
    Result := true;
  end else begin
    Result := false;
  end;}
end;

{v0.37}
function TULObj.DoFileSave: boolean;
var ow: TULObj;
begin
  ow := TopOwner;
  if (pos('NONAME', Uppercase(ow.FileName)) <> 0) or (ow.FileName = '') then begin
    Result := DoFileSaveAs
  end else begin
    ow.SaveToFile('');
    Result := True;
  end;
end;
{/v0.37
procedure TULObj.DoFileSave;
begin
  TopOwner.SaveToFile('')
end;
}

{/file save related methods}

function TULObj.DoFileOpen: boolean;
  { invokes OpenDialog, returns true if file was selected and data loaded from it }
var fn: string;
begin
  fn := '';
  Result := false;
  if RecID <> ULFID then begin
    SetResult(orOnlyULFCanDoFileOpen, ''); {ulrectyp}
    exit;
  end;
  {v0.50}
  DefDirNeeded;
  {/v0.50}
  if FileNameOpenSelect(fn, ObjDesc.Caption, ObjDesc.OpenFilter, ObjDesc.DefDir) then begin
    LoadFromFile(fn);
    Result := true;
  end;
end;
{$ENDIF}

function TULObj.Clone: TULObj;
var o: TULObj;
begin
  o := TULObjClass.Create(Owner, RecID);
  o.Assign(Self);
  Result := o;
end;

procedure TULObj.Reload;
var
  f: TULObj;
  o: TULObj;
begin
  f := TopOwner.Clone;
  try
    {v0.44}
    if not FileExists(f.FileName) then
    begin
      Clear;
      TopOwner.Modified := false;
    end else
    {/v0.44}
    begin
      f.LoadFromFile('');
      if f.FindObj(RecID, foNotRecursive, RecName, o) then begin {ulrectyp}
        Assign(o);
      end;
    end;
  finally
    f.Free;
  end;
end;

{function TULObj.GetClass: TClass;
begin
  Result := TULObjClass;
end;}

{function TULObj.GetRecID: TULRecID;
begin
  Result := 0;
end;}

{/v0.25}

{v0.28}
function TULObj.FindBySortStr(const AExp: string; var AObj: TULObj): boolean;
var Index: integer;
begin
  Result := FindIndexBySortStr(AExp, Index);
  if Result then
    AObj := Childs[Index]
  else
    AObj := nil;
end;

function TULObj.FindIndexBySortStr(const AExp: string; var Index: integer): boolean;
var
  L, H, I, C: Integer;

  s: string;
begin
  {from Objects.pas}
  Result := false;
  L := 0;
  H := ChildCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    {v0.28}
    s := Childs[I].GetSortStr;
    if s < AExp then
      C := -1
    else if s > AExp then
      C := 1
    else
      C := 0;
    {/C := Compare(KeyOf(Items^[I]), Key);}

    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if true{not Duplicates} then begin
          L := I;
          break;
        end;
      end;
    end;
  end;
  Index := L;
  {/from Objects.pas}
end;

{/v0.28}

{v0.30}
{$IFNDEF CONSOLE}
procedure TULObj.MenuActionAdd(AAction: TAction);
begin
  Actions.MenuActionAdd(AAction);
end;
{$ENDIF}
{/v0.30}

{v0.31}
{$IFNDEF CONSOLE}
procedure TULObj.PrintOptionsEdit;
var f: TULPrnForm;
begin{ulobjact}
  CurULObj := Self;
  f := TULPrnForm.Create(Application);
  try
    f.ShowModal;
  finally
    f.Free;
  end;
end;{ulobjact}

procedure TULObj.Print;
begin

end;
{$ENDIF}
{v0.44}
procedure TULObj.ChildsSetFlag(rf: TULRecFlags; OnOff: boolean);
var
  i: integer;
begin
  for i := 0 to ChildCount - 1 do
    Childs[i].SetFlag(rf, OnOff);
end;
{/v0.44}

{v0.46}
procedure TULObj.Delete;
  { should be called instead of Free, if the objects is beeing deleted
    because of user request (or BeforeDelete method of Users should be triggered) }
begin
  UsersNotify(cmULObjBeforeDelete);
  Free;
end;
{/v0.46}


function TULObj.GetBrowseChild(var AChild: TULObj):boolean;
var
  i: integer;
  c: TULObj;
begin
  Result := false;
  for i := 0 to ChildCount - 1 do begin
    c := Childs[i];
    if ObjDesc.IsBrowseChildRecID(c.RecID) then begin
      AChild := c;{ulortype}
      Result := true;
      exit;
    end;
  end;
end;

function TULObj.GetReportFileName: string;
var d: string;
begin
  d := RepFrmDir;
  if ExtractFilePath(d) = '' then begin
    d := ExtractFilePath(paramstr(0)) + RepFrmDir;
  end;
  if d[length(d)] <> '\' then
    d := d + '\';
  if not CreateDir(d) then
    SetResult(orCanNotCreateRepFrmDir, d);
  Result := d + ULRecIDToStrStrip(RecID) + 'Rep.dfm';{ ulrecutl ulrectyp}
end;

function TULObj.GetBrowserAutoClose: boolean;
begin
  Result := GetState(osBrowserAutoClose);
end;

procedure TULObj.SetBrowserAutoClose(OnOff: boolean);
begin
  SetState(osBrowserAutoClose, OnOff);
end;

function TULObj.GetEditorAutoClose: boolean;
begin
  Result := GetState(osEditorAutoClose);
end;

procedure TULObj.SetEditorAutoClose(OnOff: boolean);
begin
  SetState(osEditorAutoClose, OnOff);
end;

{/v0.31}

{v0.44}
function TULObj.GetBrowseLine: string;
var i: integer;
begin
  Result := '';
  for i := 0 to ObjDesc.BrowseFieldCount - 1 do begin
    Result := Result + ' ' + Fields[ObjDesc.BrowseFields[i].ULIndex].AsUsrString;
  end;
  {Ulobjdes}
end;
{/v0.44}

{v0.47}
procedure TULObj.Log(const msg: string);
begin
  {$IFNDEF CONSOLE}
  ExeLog.Log(ClassName + '.' + msg);
  {$IFDEF DEBCRASH}
  ExeLog.FlushLog;{exelogu}
  {$ENDIF}

  {$ENDIF}
end;

procedure TULObj.LogErr(const msg: string);
begin
  {$IFNDEF CONSOLE}
  ExeLog.LogErr(ClassName + '.' + msg);
  {$ENDIF}
end;

function TULObj.IsSelected: boolean;
begin
  Result := IsFlagSet(rfSelected);
end;

function TULObj.IsActive: boolean;
begin
  Result := ( (Owner is TULObj) and (TULObj(Owner).ActiveChild = Self) );
end;

function TULObj.IsActiveOrSelected: boolean;
begin
  Result := IsSelected or IsActive;
end;
{/v0.47}

{v0.48}
function TULObj.GetNextEditEnableAll: boolean;
begin
  Result := GetState(osNextEditEnableAll);
end;
procedure TULObj.SetNextEditEnableAll(OnOff:boolean);
begin
  SetState(osNextEditEnableAll, OnOff);
end;
{/v0.48}

{v0.50}
procedure TULObj.DefDirNeeded;
begin
  UsersNotify(cmULObjDefDirNeeded);
end;

{v0.50}
function CheckAddQuotes(const AValue: string): string;
begin
  Result := AValue;
  if (pos('.', Result) <> 0) or (pos(' ', Result) <> 0) or (pos(':', Result) <> 0) then
  begin
    Result := '"' + Result + '"';
  end;
end;

function TULObj.GetULObjRelPath: string;
var pName: string;
begin
  pName := ObjDesc.EfNameProp;
  if pName = 'Name' then
    Result := Name
  else
    Result := FindField(pName).AsUsrString;
  if Result = '' then begin
    if ObjDesc.Caption <> '' then
      Result := 'ClassDesc=' + CheckAddQuotes(ObjDesc.Caption)
    else
      Result := 'ClassName=' + ClassName;
  end else begin
    Result := CheckAddQuotes(Result);
  end;
  {v0.52}
  Result := ULRecIDToStrStrip(RecID) + ':' + Result;{ulrecutl}
  {/v0.52}
end;

function TULObj.GetULObjPath: string;
  { returns the full path of this ULObj in system ULObj tree }
var o: TObject;
begin
  Result := ULObjRelPath;
  o := Owner;
  while (o is TULObj) do begin
    if TULObj(o).RecID = ULFID then begin
      {v0.52}
      Result := '/' + Result;
      {/v0.52}
      exit;
    end;
    Result := TULObj(o).ULObjRelPath + '.' + Result;
    o := TULObj(o).Owner;
  end;
end;
{/v0.50}

{v0.61}
function TULObj.HasAutoIncField(var AField: TULObjField): boolean;
var
  od: TULObjDesc;
  i: integer;
begin
  Result := false;
  od := ObjDesc;
  AField := nil;
  for i := 0 to od.FieldCount - 1 do begin
    if od.Fields[i].IsAutoInc then begin
      AField := Fields[i];
      Result := true;
      exit;
    end;
  end;
end;
{$IFNDEF CONSOLE}
function TULObj.BrowseForChild: integer;
var wasModal: boolean;
begin
  FBrowsingForChild := true;
  try
    wasModal := IsFlagSet(rfBrowseModal);
    try
      SetFlag(rfBrowseModal, true);
      Result := Browse;
      if ActiveChild = nil then
        Result := mrCancel;
    finally
      SetFlag(rfBrowseModal, wasModal);
    end;
  finally
    FBrowsingForChild := false;
  end;
end;
{$ENDIF}
{/v0.61}
{v0.65}
function TULObj.GetCaption: string;
var
  f: TULObjField;
begin
  Result := '';
  f := EfNameField;
  if f <> nil then
    Result := f.AsUsrString;
  if Result = '' then
    Result := RecName;
  if Result = '' then
    Result := ObjDesc.Caption;
  if Result = '' then
    Result := ClassName;
end;
{/v0.65}
{/TULObj.}

{TULObjBasicUsr}
{$IFNDEF CONSOLE}

procedure TULObjBasicUsr.WMAppMessage(var Msg:TMessage);
begin
  case Msg.wParam of
    cmULObjUpdated: begin
      if TULObj(Msg.lParam) = FObj then begin
        ObjUpdated;
          {if ChildCount <> FObj.ChildCount then
            ChildsUpdate;}
      end;
    end;
    {v0.44}
    cmULObjUpdatedSelect: begin
      if TULObj(Msg.lParam) = FObj then begin
        ObjUpdatedSelect;
      end;
    end;
    cmULObjMainPropUpdated: begin
      if TULObj(Msg.lParam) = FObj then begin
        ObjMainPropUpdated;
      end;
    end;
    {v0.46}
    cmULObjBeforeDelete: begin
      if TULObj(Msg.lParam) = FObj then begin
        BeforeDelete;
      end;
    end;
    cmULObjValuesSourceNeeded: begin
      if TULObj(Msg.lParam) = FObj then begin
        ValuesSourceNeeded;
      end;
    end;
    cmULObjAfterChildsDelete: begin
      if TULObj(Msg.lParam) = FObj then begin
        AfterChildsDelete;
      end;
    end;
    {/v0.46
    cmULObjBeforeBrowseChildDelete: begin
      if TULObj(Msg.lParam) = FObj then begin
        BeforeBrowseChildDelete;
      end;
    end;}
    cmULObjAfterBrowseChildDelete: begin
      if TULObj(Msg.lParam) = FObj then begin
        AfterBrowseChildDelete;
      end;
    end;
    cmULObjBeforeBrowseChildInsert: begin
      if TULObj(Msg.lParam) = FObj then begin
        BeforeBrowseChildInsert;
      end;
    end;
    cmULObjAfterBrowseChildInsert: begin
      if TULObj(Msg.lParam) = FObj then begin
        AfterBrowseChildInsert;
      end;
    end;
    cmULObjAfterEdit: begin
      if TULObj(Msg.LParam) = FObj then begin
        AfterEdit;
      end;
    end;
    cmULObjFieldChangedInBrowser: begin
      if TULObjField(Msg.LParam).Obj = FObj then
        FieldChangedInBrowser(TULObjField(Msg.LParam));
    end;
    {/v0.44}
    {v0.50}
    cmULObjFieldDefDirNeeded: begin
      if TULObjField(Msg.LParam).Obj = FObj then
        FieldDefDirNeeded(TULObjField(Msg.LParam));
    end;
    cmULObjDefDirNeeded: begin
      if TULObj(Msg.LParam) = FObj then begin
        ObjDefDirNeeded;
      end;
    end;
    {/v0.50}
    cmULObjDestroyed: begin
      if TULObj(Msg.lParam) = FObj then begin
        if (Owner <> nil) and (Owner is TULObjBasicUsr) then
          TULObjBasicUsr(Owner).ChildObjDestroyed(FObj);
        ObjDestroyed;
        {Disposed Self, don't dereference itself!!!}
      end;
    end;
    {v0.30}{ulrectyp}
    cmULObjUserActionNeeded: begin
      if TULObj(Msg.lParam) = FObj then
        MenuActionNeeded;
    end;
    {/v0.30}
    {v0.41}
    cmULObjUserFirstActionNeeded: begin
      if TULObj(Msg.lParam) = FObj then
        FirstMenuActionNeeded;
    end;
    {/v0.41}
    {v0.61}
    cmULObjAutoIncIDAssigned: begin
      if TULObj(Msg.lParam) = FObj then
        AutoIncIDAssigned;
    end;
    {/v0.61}
  end;
end;
{$ENDIF}

procedure TULObjBasicUsr.ChildObjDestroyed(AChildObj: TULObj);
begin
end;

procedure TULObjBasicUsr.ObjUpdated;
begin

end;

{v0.44}
procedure TULObjBasicUsr.ObjUpdatedSelect;
begin

end;

procedure TULObjBasicUsr.ObjMainPropUpdated;
begin
end;
{/v0.44}

procedure TULObjBasicUsr.ObjDestroyed;
begin
  Free;
end;

procedure TULObjBasicUsr.SetObj(AObj: TULObj);
begin
  if FObj = AObj then
    exit;

  if FObj <> nil then begin
    if FRegistered then begin
      FObj.UserUnregister(Self);
      FRegistered := false;
    end;
    FObj := nil;
  end;

  FObj := AObj;
  if FObj <> nil then begin
    FObj.UserRegister(Self);
    FRegistered := true;
  end;
end;                      {ulobjusru}

destructor TULObjBasicUsr.Destroy;
begin
  Obj := nil;
  inherited Destroy;
end;

{v0.24}
procedure TULObjBasicUsr.SetResult(AResult: integer; const msg: string);
begin
  raise EULObjUsr.Create('TULObj(Basic)Usr ' + IntToStr(AResult) + ' ' + msg);
end;
{/v0.24}

{v0.30}
procedure TULObjBasicUsr.MenuActionNeeded;
begin
  {call (few times):
    ActionUpdate(var AAction: TAction; ANotifyEvent: TNotifyEvent; const ACaption: string);
    for each FXXXAction field of the TULObjBasicUsr descendant;
    the menu items will be added at the end of the standard menu }
end;
{/v0.30}
{v0.41}
procedure TULObjBasicUsr.FirstMenuActionNeeded;
begin
  { as MenuActionNeeded, but the items will be addes as the first items of the
    standard menu. See example above in MenuActionNeeded. }
end;
{/v0.41}

{v0.44}
{$IFNDEF CONSOLE}
procedure TULObjBasicUsr.ActionUpdate(var AAction: TAction; ANotifyEvent: TNotifyEvent; const ACaption: string);
begin
  if AAction = nil then begin
    AAction := TAction.Create(Self);
    AAction.OnExecute := ANotifyEvent;
  end;
  AAction.Caption := ACaption;
  Obj.MenuActionAdd(AAction);
end;
{$ENDIF}

{v0.46}
procedure TULObjBasicUsr.BeforeDelete;
begin
end;
procedure TULObjBasicUsr.AfterChildsDelete;
begin
end;
var testi2:integer;
procedure TULObjBasicUsr.ValuesSourceNeeded;
begin
  testi2 := 0;
end;
{/v0.46
procedure TULObjBasicUsr.BeforeBrowseChildDelete;
begin
end;}

procedure TULObjBasicUsr.AfterBrowseChildDelete;
begin
end;

procedure TULObjBasicUsr.BeforeBrowseChildInsert;
begin
end;

procedure TULObjBasicUsr.AfterBrowseChildInsert;
begin
end;

procedure TULObjBasicUsr.BeforeEdit;
begin
end;

procedure TULObjBasicUsr.AfterEdit;
begin

end;

procedure TULObjBasicUsr.FieldChangedInBrowser(AField: TULObjField);
begin

end;
{/v0.44}

{v0.50}
procedure TULObjBasicUsr.FieldDefDirNeeded(AField: TULObjField);
begin
end;
                                  {ulobjact ulstringgrid}
procedure TULObjBasicUsr.ObjDefDirNeeded;
begin
end;
{/v0.50}
{v0.61}
procedure TULObjBasicUsr.AutoIncIDAssigned;
begin
end;
{/v0.61}
{v0.71}
{/v0.71}
{/TULObjBasicUsr.}

{v0.47}

{TULObjFieldUsr}
constructor TULObjFieldUsr.Create(ACalcField: TULObjCalcField);
begin
  inherited Create(nil);
  FCalcField := ACalcField;
end;

procedure TULObjFieldUsr.ObjUpdated;
begin
  Obj := nil;{will cause refind of FRelField}
  FCalcField.FRelField := nil;
end;

procedure TULObjFieldUsr.ObjDestroyed;
begin
  { either relfield.obj or values source destroyed - clear pointers}
  Obj := nil;
  FCalcField.FRelField := nil;
end;
{/TULObjFieldUsr}

procedure TULObjCalcField.DoObjModified;
begin
  FRelFieldUsr.ObjUpdated;
end;

function TULObjCalcField.GetValue: string;
var
  c, o: TULObj;
  f: TULObjField;
{  ind: integer;
  i: integer;}
begin
  Result := '';
  if (FRelField = nil) and (FRelFieldUsr.Obj = nil) then begin
    {if UserMode = umSysOp then
      exit;}
    if Obj.HasField(FldDesc.KeyFieldName, f) then begin
      o := f.GetValuesSource;                   {appmancz.lng}
      if (o <> nil) {should be always} then begin
        if o.HasChildWithFieldUsrValue(FldDesc.KeyFieldName, f.AsString, c) then begin
          FRelField := c.FindField(FldDesc.ListFieldName);
          FRelFieldUsr.Obj := c;
        end else begin
          FRelFieldUsr.Obj := o;
            { will watch changes of values source object, will try find child
              again if values source changes }
        end;
      end;
    end else begin
      {can not happen, checked in constructor}
    end;
  end;

  if FRelField <> nil then begin
    Result := FRelField.GetValue;
  end;
end;

procedure TULObjCalcField.SetValue(const AValue: string);
begin
  {ignore}
  {SetResult(orCantSetValueToCalcField,'');}{ulrectyp}
end;

constructor TULObjCalcField.Create(AOwner: TULObjFields; const AName: string );
var
  i: integer;
{  f: TULObjField;}
  od: TULObjDesc;
  fd: TULObjFldDesc;
begin
  TObject.Create;
  if not (AOwner is TULObjFields) then
    raise EULObj.Create('TULObjCalcField.Create: invalid AOwner');
  FObjFields := AOwner;
  od := Obj.ObjDesc;
  for i := 0 to od.FieldCount - 1 do begin
    if od.Fields[i].Name = AName then begin
      FFldDesc := od.Fields[i];
      if (not od.HasFldDesc(FldDesc.KeyFieldName, fd)) or fd.IsCalcField then
        SetResult(orKeyFieldInvalid, AName + ',' + FldDesc.KeyFieldName);
      if not fd.IsULEnum then
        SetResult(orKeyFieldIsNotULEnum, AName + ',' + FldDesc.KeyFieldName);
      if (FldDesc.ListFieldName = '') then
        SetResult(orListFieldEmpty, AName);{ulrectyp}
      break;
    end;
  end;
  if FFldDesc = nil then
    SetResult(orFieldNotFound, AName);
  FRelFieldUsr := TULObjFieldUsr.Create(Self);
end;

destructor TULObjCalcField.Destroy;
begin
  FRelFieldUsr.Free;
  inherited;
end;
{/v0.47}


{/TULObjBasicUsr}{ulobjusru}

(*
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;
*)
{v0.24}

initialization
finalization
  {$IFNDEF CONSOLE}
  FOpenDialog.Free;
  FSaveDialog.Free;
  FFolderDialog.Free;
  {$ENDIF} {utltype}
{/v0.24}{find tlist find}
end.


