unit ULObjDes;
interface
uses
  SysUtils, Math, Classes,
  {$IFNDEF CONSOLE}
  Messages, {v0.47}Windows, {/v0.47}Dialogs, Controls, Forms, StdCtrls, {v0.44} ExtCtrls,{/v0.44}{tcombobox}
  {$ENDIF}
  TypInfo,
  UtlType, WinUtl, BinHex, PropUtl, Fileu,
  ULRecTyp, ULRecUtl

  {$IFNDEF CONSOLE}
  {v0.21}, ActnList{/v0.21}
  {v0.24}
  ,Grids , XStringGrid, CEButton, Graphics {v0.31}, CheckLst{/v0.31}
  {$ENDIF}
  {/v0.24}
  {v0.28}, Language{/v0.28}{v0.44}, CheckListFrm{/v0.44}
  ;{uldrtype uldrobju ulobju modulu}

type
  TOnGetSetUsrValue = function(const AValue: string):string of object;

  TULObjFldDescs = class;
  TULObjDesc = class;

  TULObjFldDesc = class(TObject)
    { encapsulates RTTI property information, plus uses eventual
      ULFldDesc information }
  private
    FPropInfo: PPropInfo;
    {v0.48}{history.txt}
    FPropTypeData: PTypeData;
    {/v0.48}
    FRTIndex: integer;{ in RTTI array of objects' properties }
    FFldDescs: TULObjFldDescs;
    {FOnGetUsrValue: TOnGetSetUsrValue;
    FOnSetUsrValue: TOnGetSetUsrValue; moved to TULObjField}
    {v0.14}
    FValuesSource: TObject;{=TULObj;}
    {/v0.14}
    {v0.22}
    {FAction: TAction;}
      { If the field is method, then at runtime the Action will be
        created and to Action.OnExecute every method assigned
        to the field will be assigned too }
    {/v0.22}
    {v0.24}
    {$IFNDEF CONSOLE}
    FCellEditor: TCellEditor;
    {$ENDIF}
    FCaption: string;
    {/v0.24}
    {v0.31 moved from public}
    FFldDesc: PULFldDesc;
    {/v0.31}
    {v0.45}
    FItems, FComboItems: TStringList;{internal and user enum names for enum properties}
    {/v0.45}
    {v0.46}
    FSortProc: TListSortCompare;
      { if assigned, used for sorting by this field }
    FDescSortProc: TListSortCompare;
    {/v0.46}
  protected
    function GetName: shortstring;
    {v0.47}
    procedure CheckFldDesc;
      { raise exception if FldDesc = nil }
    {/v0.47}

    function GetCaption: string;
    function GetHint: string;
    function GetEditWidth: integer;
    function GetBrowseWidth: integer;
    function GetULIndex: integer;
    {v0.09}
    function GetUserCoef: TUserCoef;
    function GetNumDec: integer;
    {/0.09}
    {v0.13}
    function GetTypeKind: TTypeKind;
    function GetIsFileName: boolean;
    function GetIsFileDateTime: boolean;
    {/v0.13}
    {v0.50}
    function GetIsColor: boolean;
    function GetRequired: boolean;
    {/v0.50}
    {v0.45}
    function GetIsDateOrTime: boolean;
    function GetIsDate: boolean;
    function GetIsTime: boolean;
    function GetIsDateTime: boolean;
    function GetIsAutoInc: boolean;
    function GetMaxID: integer;
    procedure SetMaxID(AMaxID: integer);
    {v0.47}
    function GetIsCalcField: boolean;
    function GetKeyFieldName: string;
    function GetListFieldName: string;
    {/v0.47
    function GetDispPropName: string;}
    {/v0.45}
    {v0.24}
    function GetIsDir: boolean;
    {/v0.24}
    {v0.14}
    function GetIsULEnum: boolean;
    function GetValuesSourceRecID: TULRecID;
    procedure SetValuesSource(AObject: TObject);
    {/v0.14}
    {v0.22}
    {procedure SetMethod(AMethod: TMethod);
    function GetMethod: TMethod;}
    function GetIsMethod: boolean;
    function GetIsMemo: boolean;
    {$IFNDEF CONSOLE}
    procedure WMAppMessage(var Msg:TMessage);message WM_APPMESSAGE;
    {$ENDIF}
    {/v0.22}
    {v0.44}
    function GetIsSetType: boolean;
    {/v0.44}
    {v0.47}
    function GetIsBoolean: boolean;
    {/v0.47}
    {v0.50}
    function GetIsFloat: boolean;
    function GetVisible: boolean;
    {/v0.50}
    {v0.76}
    function GetIsVarSize: boolean;
    {/v0.76}
    {v0.24}
    function GetIsEnum: boolean;

    function GetObjDesc: TULObjDesc;
    function GetEnabled: boolean;
    {function GetObj: TObject;}
    {v0.31 moved to public}
    {/v0.31
    function IsFlagSet(ff: integer):boolean;}
    function GetFilter: string;
    function GetDefDir: string;
    procedure SetDefDir(const ADir: string);
    function GetStripPrefix: string;
      { returns eventual prefix of enum string values, that should be
        stripped of the string before showing to users }
    {/v0.24}
    {v0.25}
    function GetIsSortField: boolean;
    {/v0.25}
    {v0.26}
    function GetEditMask: string;
    {/v0.26}
    {v0.36}
    function GetDefExt: string;
    {/v0.36}
    {v0.50}
    procedure SetDefExt(const AExt: string);
    {/v0.50}
    {v0.45}
    function GetComboItems: TStrings;
    function GetGridItems: TStrings;
    function GetItems: TStrings;
    procedure FillItems;
    {/v0.45}
    {v0.48}
    function GetDataSize: integer;
    {/v0.48}
    {v0.49}
    procedure SetFilter(const AFilter: string);
    {/v0.49}
    {v0.76}
    { Find out if the field is of variable size and set the FldDesc^.VarSize to true }
    procedure CheckVarSize;
    {/v0.76}
  public
    {v0.31 moved to private}{/v0.31 FldDesc: PULFldDesc;}
    constructor Create(AFldDescs: TULObjFldDescs; APropInfo: PPropInfo; ARTIndex: integer); reintroduce;
      { this object describes RTTI property with APropInfo }
    {v0.22}
    destructor Destroy; override;
    {/v0.22}
    {v0.14}
    procedure SetResult(AObjResult: TULObjResult; const msg: string);
    {/v0.14}

    {v0.24}
    {$IFNDEF CONSOLE}
    {v0.30}
    procedure FillComboBoxItems(Items: TStrings);
    {/v0.30}
    function CreateCellEditor(AOwnerForm: TComponent; AObj:TObject): TCellEditor;
      { called from some TForm(AOwner) with the TXStringGrid, the form
        will own and dispose them. }
    {v0.46}
    procedure UpdateCellEditor(ACellEditor: TCellEditor; AObj: TObject);
      { eventually updates ACellEditor for current child AObj (for ULEnum
        fields if their values source depends on the value of other field
        of the AObj); Called before starting edit. }
    {/v0.46}

    {$ENDIF}
    function UseStripPrefix: boolean;
    {procedure DoGetColor(AState: TGridDrawState; var ATextColor: TColor;
      var ABackColor: TColor);}
    {/v0.24}
    {v0.31}
    function IsFlagSet(ff: integer):boolean;
    procedure SetFlag(ff: integer; OnOff: boolean);
    {/v0.31}
    {v0.40}
    function IsFldName(const AName: string): boolean;
      { compares Name and AName, eventually case non sensitive if ObjDesc.IsFlag
    {/v0.40}
    {v0.44}
    {$IFNDEF CONSOLE}
    function CheckListBoxFormExecute(var AValue: integer): boolean;
    {$ENDIF}
    {/v0.44}
    {v0.45}
    function EnumUsrToInternal(const AUsrValue: string): string;
    function EnumInternalToUsr(const AValue: string): string;
    {/v0.45}
    {v0.61}
    {/v0.61}

    property RTIndex: integer read FRTIndex;
    property ULIndex: integer read GetULIndex;
    property Name: shortstring read GetName;
    property Caption: string read GetCaption;
    property Hint: string read GetHint;
    property EditWidth: integer read GetEditWidth;
    property BrowseWidth: integer read GetBrowseWidth;
    property UserCoef: TUserCoef read GetUserCoef;
    property NumDec: integer read GetNumDec;
    {property OnGetUsrValue: TOnGetSetUsrValue read FOnGetUsrValue write FOnGetUsrValue;
    property OnSetUsrValue: TOnGetSetUsrValue read FOnSetUsrValue write FOnSetUsrValue;}
    {v0.13}
    property TypeKind: TTypeKind read GetTypeKind;
    property IsFileName: boolean read GetIsFileName;
    property IsFileDateTime: boolean read GetIsFileDateTime;
    {/v0.13}
    {v0.50}
    property IsColor: boolean read GetIsColor;
    property Required: boolean read GetRequired;
    {/v0.50}
    {v0.45}
    property IsDateOrTime: boolean read GetIsDateOrTime;
    property IsDate: boolean read GetIsDate;
    property IsTime: boolean read GetIsTime;
    property IsDateTime: boolean read GetIsDateTime;
    property IsAutoInc: boolean read GetIsAutoInc;
    property MaxID: integer read GetMaxID write SetMaxID;
    {v0.47}
    property KeyFieldName: string read GetKeyFieldName;
    property ListFieldName: string read GetListFieldName;
    property IsCalcField: boolean read GetIsCalcField;
    {/v0.47
    property DispPropName: string read GetDispPropName;}
    {/v0.45}

    {v0.24}
    property IsDir: boolean read GetIsDir;
    {/v0.24}
    {v0.14}
    property ValuesSource: TObject read FValuesSource write SetValuesSource;
    property ValuesSourceRecID: TULRecID read GetValuesSourceRecID;
    property IsULEnum: boolean read GetIsULEnum;
    {/v0.14}
    {v0.22}
    property IsMethod: boolean read GetIsMethod;
    {property Method: TMethod read GetMethod write SetMethod;
    property Action: TAction read FAction;}
    property IsMemo: boolean read GetIsMemo;
    property PropInfo: PPropInfo read FPropInfo;
    {/v0.22}
    {v0.44}
    property IsSetType: boolean read GetIsSetType;
    {/v0.44}
    {v0.47}
    property IsBoolean: boolean read GetIsBoolean;
    {/v0.47}
    {v0.50}
    property IsFloat: boolean read GetIsFloat;
    property Visible: boolean read GetVisible;
    {/v0.50}
    {v0.24}
    property IsEnum: boolean read GetIsEnum;
    property ObjDesc: TULObjDesc read GetObjDesc;
    {property Obj: TObject read GetObj;}
    property Enabled: boolean read GetEnabled;
    property Filter: string read GetFilter {v0.49}write SetFilter{/v0.49};
    property DefDir: string read GetDefDir write SetDefDir;
    property StripPrefix: string read GetStripPrefix;
    {/v0.24}
    {v0.25}
    property IsSortField: boolean read GetIsSortField;
    {/v0.25}
    {v0.26}
    property EditMask: string read GetEditMask;
    {/v0.26}
    {v0.31}
    property FldDesc: PULFldDesc read FFldDesc write FFldDesc;
    {/v0.31}
    {v0.36}
    property DefExt: string read GetDefExt {v0.50}write SetDefExt{/v0.50};
    {/v0.36}
    {v0.45}
    property ComboItems: TStrings read GetComboItems;
    property Items: TStrings read GetItems;
    property GridItems: TStrings read GetGridItems;
    {/v0.45}
    {v0.46}
    property SortProc: TListSortCompare read FSortProc write FSortProc;
    property DescSortProc: TListSortCompare read FDescSortProc write FDescSortProc;
    {/v0.46}
    {v0.48}
    property DataSize: integer read GetDataSize;
    {/v0.48}
  end;

  TULObjFldDescs = class(TList)
  private
    FObjDesc: TULObjDesc;
    FFirstPropIndex: integer;
  protected
    function GetFldDesc(Index: integer): TULObjFldDesc;
    function AddFldDesc(APropInfo: PPropInfo; ARTIndex: integer): TULObjFldDesc;
    procedure SetResult(AObjResult: TULObjResult; const msg: string);
  public
    constructor Create(AObjDesc: TULObjDesc; const AFieldNameList: string);
    destructor Destroy;override;
    procedure ClearFldDescs;
    procedure Fill(const AFieldNameList: string);
    property FldDescs[Index: integer]: TULObjFldDesc read GetFldDesc;default;
    property FirstPropIndex:integer read FFirstPropIndex;
    {v0.24}
    property ObjDesc: TULObjDesc read FObjDesc;
    {/v0.24}
  end;

  TULObjDesc = class(TObject)
  private
    FObj: TObject;
      { RTTI for this objects is used during creation (might be destroyed later). }
    FFields: TULObjFldDescs;{TStringList;}
      { List of all fields (String=FldName, Object=TULObjFldDesc) in TULxxRec
        order; owns the objects. }
    FEditFields: TULObjFldDescs;
      { List of the those fields (TULObjFldDesc), that should appear in
        EditWindow. }
    FBrowseFields: TULObjFldDescs;
      { List of the those fields (TULObjFldDesc), that should appear in
        EditWindow. }
    FBrowseMode: TULBrowseMode;
      { Specifies what values should return BrowseFields and BrowseFieldCount
        properties }
    {v0.22}
    FMenuFields: TULObjFldDescs;
      { List of those method fields, that should appear in local menu,
        in specified order. }
    {/v0.22}
    {v0.23}
    FBrowseChildRecIDs: TList;
    {/v0.23}
    {v0.24}
    FCaption: string;
    {/v0.24}
    {v0.40}
    FClassFlags: longint;
    {/v0.40}
    {v0.44}
    FExcludedMenuItems: TULObjMenuItems;
    FGridOptions: TULObjGridOptions;
    {/v0.44}
    {v0.50}
    FOnValuesSourceNeeded: TNotifyEvent;
    FOnChildCreated: TNotifyEvent;
    {/v0.50}
  protected
    function GetChildRecIDCount:integer;
    function GetChildRecID(Index: integer): TULRecID;
    function GetCaption: string;
    function GetFlags: TULRecFlags;
    function GetFieldCount: integer;
    function GetEditFieldCount: integer;
    function GetBrowseFieldCount: integer;
    function GetField(Index: integer): TULObjFldDesc;
    function GetEditField(Index: integer): TULObjFldDesc;
    function GetBrowseField(Index: integer): TULObjFldDesc;
    function GetFirstPropIndex: integer;
    {v0.22}
    function GetMenuFieldCount: integer;
    function GetMenuField(Index: integer): TULObjFldDesc;
    {/v0.22}
    {v0.23}
    procedure UpdateBrowseChildRecIDs(ABrowseChildRecIDs: string);
    function GetNameProp: string;
    function GetEfNameProp: string;
    {/v0.23}
    {v0.24}
    function GetDefDir: string;
    procedure SetDefDir(const ADir: string);
    {/v0.24}
    {v0.25}
    function GetOpenFilter: string;
    procedure SetOpenFilter(const AOpenFilter: string);
    function GetSaveFilter: string;
    procedure SetSaveFilter(const ASaveFilter: string);
    {/v0.25}
    {v0.37}
    function GetDefFilter: string;
    {/v0.37}
    {v0.40}
    function GetClassFlags: longint;
    procedure SetClassFlags(AFlags: longint);
    {/v0.40}
    {v0.41}
    function GetDefExt: string;
    {/v0.41}
  public
    { Common info for all instances of TULxxObj }
    RecID: TULRecID;
    RefCount: longint;
      { How many instances of this RecID exist (created but not destroyed yet) }
    {FirstPropIndex: integer;
      { What is the index of the first property listed in PropNames in
        object's published RTTI properties list. I.e. index that will
        be used to access fields will have value=0 for this property/field.

       = Index of the first objects' published property, that is not common
         to all ULObj objects }
    ULRecDesc: PULRecDesc;
      { Static record with additional info, see ULRecTyp.PAS }
    constructor Create(AObj: TObject); reintroduce;
    destructor Destroy; override;
    procedure IncRefCount;
    procedure DecRefCount;
    function FindFldDesc(const AName:string):TULObjFldDesc;
      { raises exception if the field with AName not found }
    {v0.47}
    function HasFldDesc(const AName: string; var AFldDesc: TULObjFldDesc): boolean;
    {/v0.47}
    {v0.23}
    function IsBrowseChildRecID(ARecID: TULRecID): boolean;
    function BrowseChildRecIDCount: integer;
    {/v0.23}
    {v0.50}
    function IsChildRecID(ARecID: TULRecID): boolean;
    {/v0.50}
    {v0.31}
    {$IFNDEF CONSOLE}
    procedure FieldsToCheckListBox(ff: integer; ACheckListBox: TCheckListBox; var ACaption: string);
    procedure CheckListBoxToFields(ff: integer; ACheckListBox: TCheckListBox);
    {$ENDIF}
    {/v0.31}
    {v0.40}
    function IsClassFlagSet(cf: longint): boolean;
    procedure SetClassFlag(cf: longint; OnOff: boolean);
    {/v0.40}

    {v0.47}
    {$IFNDEF CONSOLE}
    function EditFormCreate(AULObj: TObject): TForm;
    procedure EditControlFill(AControl: TWinControl; AULObj: TObject);
    {$ENDIF}
    {/v0.47}


    property ChildRecIDCount: integer read GetChildRecIDCount;
    property ChildRecIDs[Index: integer]: TULRecID read GetChildRecID;
    property Caption: string read GetCaption;
    property Flags: TULRecFlags read GetFlags;
    property FieldCount: integer read GetFieldCount;
    property Fields[Index: integer]: TULObjFldDesc read GetField;
    property EditFieldCount: integer read GetEditFieldCount;
    property EditFields[Index: integer]: TULObjFldDesc read GetEditField;
    property BrowseFieldCount: integer read GetBrowseFieldCount;
    property BrowseFields[Index: integer]: TULObjFldDesc read GetBrowseField;
    property Obj: TObject read FObj {v0.47} write FObj{/v0.47};
    property FirstPropIndex: integer read GetFirstPropIndex;
    property BrowseMode: TULBrowseMode read FBrowseMode write FBrowseMode;
    {v0.22}
    property MenuFieldCount: integer read GetMenuFieldCount;
    property MenuFields[Index: integer]: TULObjFldDesc read GetMenuField;
    property NameProp: string read GetNameProp;
    property EfNameProp: string read GetEfNameProp;
    {/v0.22}
    {v0.24}
    property DefDir: string read GetDefDir write SetDefDir;
    {/v0.24}
    {v0.25}
    property OpenFilter: string read GetOpenFilter write SetOpenFilter;
    property SaveFilter: string read GetSaveFilter write SetSaveFilter;
    {/v0.25}
    {v0.37}
    property DefFilter: string read GetDefFilter;
    {/v0.37}
    {v0.40}
    property ClassFlags: longint read GetClassFlags write SetClassFlags;
    {/v0.40}
    {v0.41}
    property DefExt: string read GetDefExt;
    {/v0.41}
    {v0.44}
    property ExcludedMenuItems: TULObjMenuItems read FExcludedMenuItems write FExcludedMenuItems;
    property GridOptions: TULObjGridOptions read FGridOptions write FGridOptions;
    {/v0.44}
    {v0.50}
    property OnValuesSourceNeeded: TNotifyEvent read FOnValuesSourceNeeded write FOnValuesSourceNeeded;
    property OnChildCreated: TNotifyEvent read FOnChildCreated write FOnChildCreated;
    {/v0.50}
    property BrowseFieldList: TULObjFldDescs read FBrowseFields;
  end;

  TULObjDescs = class(TList)
    function FindInfo(ARecID: TULRecID; var AInfo: TULObjDesc):boolean;
  end;

var
  ObjDescs: TULObjDescs = nil;
    { List of TULObjDesc }
(*
function FillFields(c: TObject; const AfterName: string;
  var FirstPropIndex:integer; Items: TStrings):boolean;
  { Fill Items with names of properties published in given object c;
    if AfterName <> '', then fills only with names of those properties that
    are defined after property of the name AfterName and the FirstPropIndex is set
    to the index of the first property that is after AfterName property. }
*)


implementation
uses
  ulobju
  {v0.47}
  {$IFNDEF CONSOLE}
  ,uledfrm, btnedit
  {$ENDIF}
  {/v0.47};
(*
function FillFields(c: TObject; const AfterName: string;
  var FirstPropIndex:integer; Items: TStrings):boolean;
  { Fill Items with names of properties published in given object c;
    if AfterName <> '', then fills only with names of those properties that
    are defined after property of the name AfterName and the FirstPropIndex is set
    to the index of the first property that is after AfterName property. }
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  j:integer;
  isAfter:boolean;

begin
  Result := false;
  if Items = nil then
    exit;
  Items.Clear;
  isAfter := (AfterName = '');
  FirstPropIndex := 0;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if not isAfter then begin
      isAfter := (pi^.Name = AfterName);
      if isAfter then
        FirstPropIndex := j + 1;
    end else begin
      Items.AddObject(pi^.Name, TULObjFldDesc.Create(pi));
    end;
  end;
  Result := true;
end;
*)

{TULObjFldDesc}
{v0.47}
procedure TULObjFldDesc.CheckFldDesc;
begin
  if FldDesc = nil then
    SetResult(orFldDescNil, '');
end;
{/v0.47}

function TULObjFldDesc.GetName: shortstring;
begin
  {v0.47}
  if FPropInfo = nil then begin
    {calculated field}
    CheckFldDesc;
    Result := FldDesc^.FieldName;
  end else
  {/v0.47}
    Result := FPropInfo^.Name;
end;

function TULObjFldDesc.GetCaption: string;
begin
  {v0.24}
  if FCaption = '' then begin
    if (FldDesc <> nil) and (FldDesc^.Caption <> '') then
      FCaption := GetTxt(FldDesc^.Caption)
    else
      FCaption := GetTxt(InsertSpacesIntoMultiWordName({v0.47}Name{/v0.47 FPropInfo^.Name}));
  end;
  Result := FCaption;
  {/v0.24}{/v0.24
  Result := FPropInfo^.Name;
  if (FldDesc <> nil) and (FldDesc^.Caption <> '') then
    Result := FldDesc^.Caption;}
end;

function TULObjFldDesc.GetHint: string;
begin
  if FldDesc = nil then
    Result := ''
  else
    Result := GetTxt(FldDesc^.Hint);
end;

function TULObjFldDesc.GetEditWidth: integer;
begin
  if FldDesc = nil then
    Result := 0
  else
    Result := FldDesc^.EditWidth;
end;

function TULObjFldDesc.GetBrowseWidth: integer;
begin
  if FldDesc = nil then
    Result := 0
  else
    Result := FldDesc^.BrowseWidth;
end;


constructor TULObjFldDesc.Create(AFldDescs: TULObjFldDescs;
  APropInfo: PPropInfo; ARTIndex: integer);
begin
  inherited Create;
  if AFldDescs = nil then
    raise EEmptyFldDescs.Create('EEmptyFldDescs');
  FFldDescs := AFldDescs;
  if APropInfo = nil then begin
    {v0.47}
    {/v0.47
    FFldDescs.SetResult(orEmptyPropInfo, '');}
  end;
  FPropInfo := APropInfo;
  FRTIndex := ARTIndex;
  {v0.48}
  if FPropInfo <> nil then begin
    FPropTypeData := PTypeData(GetTypeData(FPropInfo^.PropType^));
  end;
  {/v0.48}
end;

{v0.45}

function TULObjFldDesc.EnumInternalToUsr(const AValue: string): string;
var i: integer;
begin
  Result := AValue;
  if UseStripPrefix then begin
    i := Items.IndexOf(AValue);
    if i >= 0 then
      Result := ComboItems[i];
  end;
end;

function TULObjFldDesc.EnumUsrToInternal(const AUsrValue: string): string;
var i: integer;
begin
  Result := AUsrValue;
  i := Items.IndexOf(AUsrValue);
  if (i < 0) {and UseStripPrefix} then begin
    i := ComboItems.IndexOf(AUsrValue);
    if i >= 0 then
      Result := Items[i];
  end;
end;

function TULObjFldDesc.GetItems: TStrings;
begin
  if FItems = nil then
    FillItems;
  Result := FItems;
end;

procedure TULObjFldDesc.FillItems;
var i: integer;
begin
  if FItems = nil then begin
    FItems := TStringList.Create;
    FillEnumNames(PropInfo, FItems);{proputl}
  end;
  if FComboItems = nil then begin
    FComboItems := TStringList.Create;
    for i := 0 to FItems.Count - 1 do begin
      FComboItems.Add(GetTxt(copy(FItems[i], length(StripPrefix) + 1, length(FItems[i]))));
    end;
  end;
end;

function TULObjFldDesc.GetGridItems: TStrings;
begin
  if UseStripPrefix then
    Result := ComboItems
  else
    Result := Items;
end;

function TULObjFldDesc.GetComboItems: TStrings;
begin
  if FComboItems = nil then
    FillItems;
  Result := FComboItems;
end;
{/v0.45}

{v0.24}
{$IFNDEF CONSOLE}

{v0.30}
procedure TULObjFldDesc.FillComboBoxItems(Items: TStrings);
{var i: integer;}
begin { tcombobox  PROPUTL}
  {v0.45}
  Items.Assign(GridItems);
  {/v0.45
  FillEnumNames(FPropInfo, FItems);
  if UseStripPrefix then begin
    for i := 0 to Items.Count - 1 do begin
      Items[i] := (copy(Items[i], length(StripPrefix) + 1, length(Items[i])));
    end;
  end;}
end;
{/v0.30}

{v0.46}
procedure TULObjFldDesc.UpdateCellEditor(ACellEditor: TCellEditor; AObj: TObject);
begin
  if ACellEditor is TComboCellEditor then begin
    with ACellEditor as TComboCellEditor do begin
      if IsULEnum then begin
        with TComboInPlace(Editor) do begin
          TULObj(AObj).FillULEnumNames(ULIndex, Items);
        end;
      end;
    end;
  end;
end;
{/v0.46}

function TULObjFldDesc.CreateCellEditor(AOwnerForm: TComponent; AObj:TObject): TCellEditor;
{var s:TStringList;}
var
  ce: TCellEditor;
{  i: integer;}
  {v0.26}
  e: TEditInPlace;
  em: string;
  {/v0.26}

begin
  if IsEnum then begin
    ce := TComboCellEditor.Create(AOwnerForm);
    ce.Init;
    with ce as TComboCellEditor do begin
      Style := csDropDownList;
      with TComboInplace(Editor) do begin
        {v0.30}
        FillComboBoxItems(Items);
        {/v0.30
        FillEnumNames(FPropInfo, Items);
        if UseStripPrefix then begin
          for i := 0 to Items.Count - 1 do begin
            Items[i] := (copy(Items[i], length(StripPrefix) + 1, length(Items[i])));
          end;
        end;}
      end;
    end;
  end else if IsULEnum then begin
    ce := TComboCellEditor.Create(AOwnerForm);
    ce.Init;
    with ce as TComboCellEditor do begin
      Style := csDropDownList;
      with TComboInPlace(Editor) do begin
        TULObj(AObj).FillULEnumNames(ULIndex, Items);
      end;
    end;
  end else if IsFileName then begin {ulanrecs.lst ulrectyp}
    ce := TButtonCellEditor.Create(AOwnerForm);
    ce.Init;
    {ce.OnClick must be assigned for curchild in ULBrowu }
  end else {v0.50} if IsColor then begin
    ce := TButtonCellEditor.Create(AOwnerForm);
    ce.Init;
    {ce.OnClick must be assigned for curchild in ULBrowu }
  end else {/v0.50}{v0.44} if IsSetType then begin
    ce := TButtonCellEditor.Create(AOwnerForm);
    ce.Init;
    {ce.OnClick must be assigned for curchild in ULBrowu }
  end else {/v0.44} begin
    ce := TEditCellEditor.Create(AOwnerForm); {xstringgrid}
    ce.Init;
    e := TEditInPlace(TEditCellEditor(ce).Editor);
    {v0.26}
    em := EditMask;
    if em = '' then begin
      if TypeKind = tkInteger then begin
        em := '#9999999999;0; ';
      end;{proputl}
    end;
    e.EditMask := em;
    {/v0.26}
  end;
  Result := ce;
end;
{$ENDIF}

function TULObjFldDesc.GetIsEnum: boolean;
begin
  Result := {v0.47}(FPropInfo <> nil) and {/v0.47}(FPropInfo^.PropType^^.Kind = tkEnumeration);
end;

{v0.44}
function TULObjFldDesc.GetIsSetType: boolean;
begin
  Result := {v0.47}(FPropInfo <> nil) and {/v0.47}(FPropInfo^.PropType^^.Kind = tkSet);
end;
{/v0.44}
{v0.47}
function TULObjFldDesc.GetIsBoolean: boolean;
begin
  Result := {v0.47}(FPropInfo <> nil) and {/v0.47}(FPropInfo^.PropType^^.Name = 'Boolean');
end;
{/v0.47}
{v0.76}
function TULObjFldDesc.GetIsVarSize: boolean;
begin
  Result := (FPropInfo <> nil) and (FPropInfo^.PropType^^.Kind in [tkLString, tkWString]); {proputl}
end;
{/v0.76}
{v0.50}
function TULObjFldDesc.GetIsFloat: boolean;
begin
  Result := (FPropInfo <> nil) and (FPropInfo^.PropType^^.Kind = tkFloat);{typinfo}
end;
{/v0.50}

function TULObjFldDesc.GetObjDesc: TULObjDesc;
begin
  Result := FFldDescs.ObjDesc;
end;

{
function TULObjFldDesc.GetObj: TObject;
begin
  Result := FFldDescs.ObjDesc.Obj;
end;
}
{/v0.24}


function TULObjFldDesc.GetULIndex: integer;
begin
  Result := FRTIndex - FFldDescs.FirstPropIndex;
end;

{v0.09 ulstringgrid}
function TULObjFldDesc.GetUserCoef: TUserCoef;
begin
  if FldDesc = nil then
    Result := 0
  else
    Result := FldDesc^.UserCoef;
end;

function TULObjFldDesc.GetNumDec: integer;
begin
  if FldDesc = nil then
    Result := 0
  else
    Result := FldDesc^.NumDec;
end;
{/0.09}

{v0.13}
function TULObjFldDesc.GetTypeKind: TTypeKind;
begin
 {v0.47}
 if (FPropInfo = nil) then begin
   Result := tkString;
 end else
 {/v0.47}
   Result := (FPropInfo^.PropType^^.Kind);
end;
                              {ulobjrwu}
function TULObjFldDesc.GetIsFileName: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffFileName) <> 0);
end;

function TULObjFldDesc.GetIsFileDateTime: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffFileDateTime) <> 0);
end;
{/v0.13}

{v0.50}
function TULObjFldDesc.GetIsColor: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffColor) <> 0);
end;

function TULObjFldDesc.GetRequired: boolean;
begin
  Result := IsFlagSet(ffRequired);{(FldDesc <> nil) and ((FldDesc^.Flags and ffRequired) <> 0);}
end;
{/v0.50}
{ulobjrwu}
{v0.45}
function TULObjFldDesc.GetIsDateOrTime: boolean;
begin
  Result := (FldDesc <> nil) and
   (
     ((FldDesc^.Flags and ffDate) <> 0 ) or
     ((FldDesc^.Flags and ffTime) <> 0 )
   );
end;

function TULObjFldDesc.GetIsDateTime: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffDate) <> 0 ) and
    ((FldDesc^.Flags and ffTime) <> 0 );
end;

function TULObjFldDesc.GetIsDate: boolean;
begin
  Result := (FldDesc <> nil) and
     ((FldDesc^.Flags and ffDate) <> 0 )
     {v0.46}
     and ((FldDesc^.Flags and ffTime) = 0 )
     {/v0.46}
     ;
end;

function TULObjFldDesc.GetIsTime: boolean;
begin
  Result := (FldDesc <> nil) and
     ((FldDesc^.Flags and ffTime) <> 0 )
     {v0.46}
     and ((FldDesc^.Flags and ffDate) = 0 )
     {/v0.46}


     ;
end;

function TULObjFldDesc.GetIsAutoInc: boolean;
begin
  Result := (FldDesc <> nil) and
     ((FldDesc^.Flags and ffAutoInc) <> 0 );
end;

{/v0.45}

{v0.24}
function TULObjFldDesc.GetIsDir: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffDir) <> 0);
end;
{/v0.24}

{v0.26}
function TULObjFldDesc.GetEditMask: string;
begin
  Result := '';
  if FldDesc <> nil then
    Result := FldDesc^.EditMask;
end;
{/v0.26}


{v0.14}
function TULObjFldDesc.GetIsULEnum: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffULEnum) <> 0);
end;

function TULObjFldDesc.GetValuesSourceRecID: TULRecID;
begin
  Result := 0;
  if FldDesc <> nil then
    Result := FldDesc^.ValuesSourceRecID;
end;

procedure TULObjFldDesc.SetValuesSource(AObject: TObject);
begin
  {v0.24}
  if AObject = FValuesSource then
    exit;
  {v0.22}
  if AObject = nil then begin
    if FValuesSource <> nil then begin
      TULObj(FValuesSource).UserUnregister(Self);
      FValuesSource := nil;
    end;
    exit;
  end;
  {/v0.22}

  if not (AObject is TULObj) then
    SetResult(orNotULObject, 'TULObjFldDesc.SetValuesSource');

  {v0.22}
  if (ValuesSourceRecID <> 0) and (TULObj(AObject).RecID <> ValuesSourceRecID) then
    SetResult(orInvalidValuesSourceRecID, TULObj(AObject).RecIDStr);

  TULObj(AObject).UserRegister(Self);
  FValuesSource := AObject;
  {/v0.22
  with AObject as TULObj do begin
    if (ValuesSourceRecID <> 0) and (RecID <> ValuesSourceRecID) then
      SetResult(orInvalidValuesSourceRecID, RecIDStr);
    FValuesSource := AObject;
  end;}
end;

procedure TULObjFldDesc.SetResult(AObjResult: TULObjResult; const msg: string);
begin
  FFldDescs.SetResult(AObjResult, msg);
end;
{/v0.14}

{v0.22}
destructor TULObjFldDesc.Destroy;
begin
  {FAction.Free;}
  {v0.24}
  {$IFNDEF CONSOLE}
  FCellEditor.Free;
  {$ENDIF}
  {/v0.24}
  ValuesSource := nil;
  {v0.45}
  FComboItems.Free;
  FItems.Free;
  {/v0.45}
  inherited Destroy;
end;
{
procedure TULObjFldDesc.SetMethod(AMethod: TMethod);
begin
  if FAction = nil then
    FAction := TAction.Create(nil);
  FAction.OnExecute := TNotifyEvent(AMethod);
end;

function TULObjFldDesc.GetMethod: TMethod;
var m: TMethod;
begin
  fillchar(m, sizeof(m), 0);
  if FAction <> nil then
     m := TMethod(FAction.OnExecute);
  Result := m;
end;
}
function TULObjFldDesc.GetIsMethod: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffMethod) <> 0);
end;

function TULObjFldDesc.GetIsMemo: boolean;
begin
  Result := (FldDesc <> nil) and ((FldDesc^.Flags and ffMemo) <> 0);
end;

{$IFNDEF CONSOLE}
procedure TULObjFldDesc.WMAppMessage(var Msg: TMessage);
begin
  case Msg.WParam of
    cmULObjDestroyed: begin
      if TULObj(Msg.lParam) = FValuesSource then begin
        ValuesSource := nil;
      end;
    end;
  end;
end;
{$ENDIF}
{/v0.22}

{v0.50}
function TULObjFldDesc.GetVisible: boolean;
begin
  Result := not IsFlagSet(ffNonVisible);
end;
{/v0.50}

{v0.24}
function TULObjFldDesc.GetEnabled: boolean;
begin
  Result := IsFlagSet(ffEnabled);
end;

function TULObjFldDesc.GetFilter: string;
begin
  if (FldDesc <> nil) then begin
    Result := GetTxt(FldDesc^.Filter)
  end else
    Result := '';
end;


function TULObjFldDesc.IsFlagSet(ff: integer): boolean;{ulrectyp}
begin
  Result := {v0.31}(FldDesc <> nil) and {/v0.31}((FldDesc^.Flags and ff) = ff);
end;

{v0.31}
procedure TULObjFldDesc.SetFlag(ff: integer; OnOff: boolean);
begin
  if FldDesc <> nil then begin
    if OnOff then
      FldDesc^.Flags := FldDesc^.Flags or ff
    else
      FldDesc^.Flags := FldDesc^.Flags and (not ff);
  end;
end;
{/v0.31}

function TULObjFldDesc.GetDefDir: string;
begin
  if FldDesc <> nil then
    Result := FldDesc^.DefDir
  else
    Result := '';
end;

procedure TULObjFldDesc.SetDefDir(const ADir: string);
begin
  if FldDesc <> nil then
    FldDesc^.DefDir := ADir;
end;

function TULObjFldDesc.GetStripPrefix: string;
begin
  if FldDesc <> nil then
    Result := FldDesc^.StripPrefix
  else
    Result := '';
end;

function TULObjFldDesc.UseStripPrefix: boolean;
begin
  Result :=
    (TypeKind = tkEnumeration) and
    ((StripPrefix <> ''){v0.47} or IsBoolean{/v0.47}) and
    (UserMode <> umSysOp);
end;
{/v0.24}{ulanrecs.lst}

{v0.25}
function TULObjFldDesc.GetIsSortField: boolean;
begin
  {v0.31}
  Result := IsFlagSet(ffIsSortField);
  {/v0.31
  Result := false;
  if FldDesc <> nil then
    Result := IsFlagSet(ffIsSortField);}
end;
{/v0.25}
{v0.31}
{function TULObjFldDesc.S}
{/v0.31}

{v0.36}
function TULObjFldDesc.GetDefExt: string;
begin
  Result := '';
  if (FldDesc <> nil) then begin
    Result := GetExtFromFileDialogFilter(FldDesc^.Filter, 1);
  end;
end;
{/v0.36}

{v0.50}
procedure TULObjFldDesc.SetDefExt(const AExt: string);
var
  l: TStringList;
  i: integer;
begin
{winutl}
  if AExt = DefExt then
    exit;
  l := TStringList.Create;
  try
    if ParseLine(['|'], FldDesc^.Filter, l) then begin
      i := pos('(', l[0]);
      if i > 0 then begin
        l[0] := copy(l[0], 1, i - 1) + '(*' + AExt + ')';
      end else
        l[0] := l[0] + '(*' + AExt + ')';
      l[1] := '*' + AExt;
      FldDesc^.Filter := '';
      for i := 0 to l.Count - 1 do begin
        FldDesc^.Filter := FldDesc^.Filter + l[i];
        if i < l.Count - 1 then
          FldDesc^.Filter := FldDesc^.Filter + '|';
      end;
    end;
  finally
    l.Free;
  end;
end;
{/v0.50}

{v0.40}
function TULObjFldDesc.IsFldName(const AName: string): boolean;
{ compares Name and AName, eventually case non sensitive if ObjDesc.IsFlag }
begin
  if ObjDesc.IsClassFlagSet(cfFldNamesCaseNonSensitive) then begin
    Result := UpperCase(Name) = Uppercase(AName);
  end else begin
    Result := (Name = AName);
  end;
end;
{/v0.40}

{v0.44}
{$IFNDEF CONSOLE}
function TULObjFldDesc.CheckListBoxFormExecute(var AValue: integer): boolean;
var
  f: TForm;
  cl: TCheckListBox;
  p: TPanel;
  b: TButton;
  {v0.47}
  i: integer;
  {/v0.47}
begin
  Result := false;
  if TypeKind <> tkSet then
    exit;
  f := TForm.Create(nil);
  try
    f.Position := poScreenCenter;
    f.Caption := Caption;
    cl := TCheckListBox.Create(f);
    cl.Parent := f;
    cl.Align := alClient;
    p := TPanel.Create(f);
    p.Parent := f;
    p.Height := f.Canvas.TextHeight('M') * 3;
    p.Align := alBottom;{TAlign}
    b := TButton.Create(f);
    b.Parent := p;
    b.Caption := GetTxt({#}'&OK');
    b.Top := (p.Height - b.Height) div 2;
    b.Left := (p.Width - b.Width) div 2;
    b.ModalResult := mrOK;
    FillSetEnumNames(PropInfo, cl.Items);
    {v0.47}
    for i := 0 to cl.Items.Count - 1 do begin
      cl.Items[i] := GetTxt(cl.Items[i]);
    end;
    {/v0.47}
    CheckListBoxSetFlags(cl, AValue, sizeof(AValue));
    if f.ShowModal = mrOK then begin
      CheckListBoxGetFlags(cl, AValue, sizeof(AValue));
      Result := true;
    end;
  finally
    f.Free;
  end;
end;
{$ENDIF}
{/v0.44}

{v0.45}
{v0.47}
function TULObjFldDesc.GetIsCalcField: boolean;
begin
  Result := FPropInfo = nil;
end;

function TULObjFldDesc.GetKeyFieldName: string;
begin
  CheckFldDesc;
  Result := FldDesc^.KeyFieldName;
end;

function TULObjFldDesc.GetListFieldName: string;
begin
  CheckFldDesc;
  Result := FldDesc^.ListFieldName;
end;
{/v0.47
function TULObjFldDesc.GetDispPropName: string;
begin
  if FldDesc <> nil then
    Result := FldDesc^.DispPropName
  else
    Result := '';
end;}

function TULObjFldDesc.GetMaxID: integer;
begin
  if FldDesc <> nil then
    Result := FldDesc^.MaxID
  else
    Result := 0;
end;

procedure TULObjFldDesc.SetMaxID(AMaxID: integer);
begin
  if FldDesc <> nil then
    FldDesc^.MaxID := AMaxID;
end;
{/v0.45}

{v0.48}
function TULObjFldDesc.GetDataSize: integer;
begin
  {proputl}
  Result := 0;
  if FPropTypeData <> nil then begin
    Result := GetTypeSize(TypeKind, FPropTypeData^);
  end;
end;
{/v0.48}
{v0.49}
procedure TULObjFldDesc.SetFilter(const AFilter: string);
begin
  if FldDesc <> nil then
    FldDesc^.Filter := AFilter;
end;

{/v0.49}

{v0.76}
{ Find out if the field is of variable size and set the FldDesc^.VarSize to true }
procedure TULObjFldDesc.CheckVarSize;
begin
  if FldDesc <> nil then
    FldDesc^.VarSize := GetIsVarSize;
end;
{/v0.76}

{/TULObjFldDesc}

{TULObjFldDescs}
constructor TULObjFldDescs.Create(AObjDesc: TULObjDesc; const AFieldNameList: string);
begin
  inherited Create;
  FObjDesc := AObjDesc;
  Fill(AFieldNameList);
end;

procedure TULObjFldDescs.Fill(const AFieldNameList: string);
{ Fill Items with TULObjFldDesc of properties published in given object
  FULObjDesc.FObj (if AFieldNameList <> '' then only with fields/properties
  the names of which are specified in the list)
  Fills only with names of those properties that are defined
  after property with name = ULRecTyp . ULRecLastCommonProp }
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  j: integer;
  isAfter: boolean;

  flist: string;
  fldn: string;
  {v0.47}
  added:boolean;
  i: integer;
  {/v0.47}
const
  Delim = ',';{delimitor of field names in a FieldNameList}

{v0.36}
begin
  ClearFldDescs;
  isAfter := false;

  ti := PTypeInfo(FObjDesc.Obj.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);

  if AFieldNameList = '' then begin

    for j := 0 to td^.PropCount - 1 do begin
      pi := pl[j];
      if not isAfter then begin
        isAfter := (pi^.Name = ULRecLastCommonProp);
        if isAfter then
          FFirstPropIndex := j + 1;
      end else begin
        AddFldDesc(pi, j);
      end;
    end;

    if (FObjDesc.ULRecDesc <> nil) then begin
      if FObjDesc.ULRecDesc^.Flds <> nil then begin
        for i := 0 to FObjDesc.ULRecDesc^.FldCount - 1 do begin {aacrobju ulobju}
          {FFields[i].FldDesc := @ULRecDesc^.Flds^[i];}
          if (FObjDesc.ULRecDesc^.Flds^[i].Flags and ffCalcField) <> 0{FieldName = fldn }then
          begin
            with AddFldDesc(nil, FirstPropIndex + i) do begin
              FldDesc := @FObjDesc.ULRecDesc^.Flds^[i];
            end;
          end;
        end;
      end;
    end;

  end else begin

    flist := Trim(AFieldNameList);
    FFirstPropIndex := -1;
    while ExtractWord([Delim], fldn, flist) do begin
      if fldn = '' then
        continue;
      {v0.47}
      added := false;
      {/v0.47}
      for j := 0 to td^.PropCount - 1 do begin
        pi := pl[j];
        if not isAfter then begin
          isAfter := (pi^.Name = ULRecLastCommonProp);
          if isAfter then begin
            if FFirstPropIndex = -1 then
              FFirstPropIndex := j + 1;
          end;
        end else begin
          if fldn = pi^.Name then begin
            if (FObjDesc.ULRecDesc  = nil) or
               (FObjDesc.ULRecDesc^.Flds = nil) or
               ( (FObjDesc.ULRecDesc^.Flds^[j-FFirstPropIndex].Flags and ffNonVisible) = 0 )
            then begin
              AddFldDesc(pi, j);
              {v0.47}
              added := true;
              {/v0.47}
            end;
          end;
        end;
      end;

      {v0.47}
      if not added then begin
        if (FObjDesc.ULRecDesc <> nil) then begin
          if FObjDesc.ULRecDesc^.Flds <> nil then begin
            for i := 0 to FObjDesc.ULRecDesc^.FldCount - 1 do begin {aacrobju ulobju}
              {FFields[i].FldDesc := @ULRecDesc^.Flds^[i];}
              if FObjDesc.ULRecDesc^.Flds^[i].FieldName = fldn then begin
                 with AddFldDesc(nil, FirstPropIndex + i) do begin
                   FldDesc := @FObjDesc.ULRecDesc^.Flds^[i];
                 end;
              end;
            end;
          end;
        end;
      end;
      {/v0.47}

    end;

  end;
end;
{/v0.36
begin
  ClearFldDescs;
  isAfter := false;
  if AFieldNameList = '' then
    flist := ''
  else
    flist := Delim + Trim(AFieldNameList) + Delim;
  ti := PTypeInfo(FObjDesc.Obj.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if not isAfter then begin
      isAfter := (pi^.Name = ULRecLastCommonProp);
      if isAfter then
        FFirstPropIndex := j + 1;
    end else begin
      if (flist = '') or (pos(Delim+pi^.Name+Delim, flist) > 0) then begin
        if (flist = '') or
           (FObjDesc.ULRecDesc  = nil) or
           (FObjDesc.ULRecDesc^.Flds = nil) or
           ( (FObjDesc.ULRecDesc^.Flds^[j-FFirstPropIndex].Flags and ffNonVisible) = 0 )
        then
        AddFldDesc(pi, j);
      end;
    end;
  end;
end;
}

function TULObjFldDescs.AddFldDesc(APropInfo:PPropInfo; ARTIndex: integer): TULObjFldDesc;
var
  f: TULObjFldDesc;
begin
  f := TULObjFldDesc.Create(Self, APropInfo, ARTIndex);
  Add(f);
  Result := f;
end;

function TULObjFldDescs.GetFldDesc(Index: integer): TULObjFldDesc;
begin
  Result := TULObjFldDesc(Items[Index]);
end;

procedure TULObjFldDescs.ClearFldDescs;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    FldDescs[i].Free;
  Clear;
end;

destructor TULObjFldDescs.Destroy;
begin
  ClearFldDescs;
  inherited;
end;

procedure TULObjFldDescs.SetResult(AObjResult: TULObjResult; const msg: string);
begin
  TULObj(FObjDesc.Obj).SetResult(AObjResult, msg);
end;

{/TULObjFldDescs}

{TULObjDesc}
constructor TULObjDesc.Create(AObj: TObject);
var
  o: TULObj;
  el, bl {v0.22}, ml{/v0.22}{v0.23}, chids{/v0.23}: string;
  i: integer;

  procedure CopyFldDescs(Src, Dest: TULObjFldDescs);
  var i, j: integer;
  begin
    for i := 0 to Src.Count - 1 do begin
      for j := 0 to Dest.Count - 1 do begin
        if Src[i].Name = Dest[j].Name then
          Dest[j].FldDesc := Src[i].FldDesc;
      end;
    end;
  end;

begin
  o := TULObj(AObj);
  FObj := o;
  RecID := o.RecID;
  ULRecDesc := o.ULRecDesc;{uldrobju}
  RefCount := 0;
{ PropNames := TStringList.Create;
  PropHints := TStringList.Create; }
  FFields := TULObjFldDescs.Create(Self, '');
  if (ULRecDesc <> nil) then begin
    if ULRecDesc^.Flds <> nil then begin
      for i := 0 to FFields.Count - 1 do begin
        FFields[i].FldDesc := @ULRecDesc^.Flds^[i];
        {v0.76}
        FFields[i].CheckVarSize;
        {/v0.76}
      end;
    end;
    el := ULRecDesc^.EditFieldList;
    bl := ULRecDesc^.BrowseFieldList;
    {v0.22}
    ml := ULRecDesc^.MenuFieldList;
    {/v0.22}
    {v0.23}
    chids := ULRecDesc^.BrowseChildRecIDs;
    {/v0.23}
  end else begin
    el := '';
    bl := '';
    {v0.22}
    ml := '';
    {/v0.22}
    {v0.23}
    chids := '';
    {/v0.23}
  end;
  FEditFields := TULObjFldDescs.Create(Self, el);
  FBrowseFields := TULObjFldDescs.Create(Self, bl);
  {v0.22}
  FMenuFields := TULObjFldDescs.Create(Self, ml);
  CopyFldDescs(FFields, FMenuFields);
  {/v0.22}
  CopyFldDescs(FFields, FEditFields);
  CopyFldDescs(FFields, FBrowseFields);
  {v0.23}
  UpdateBrowseChildRecIDs(chids);
  {/v0.23}
end;

{v0.23}
procedure TULObjDesc.UpdateBrowseChildRecIDs(ABrowseChildRecIDs: string);
var
  ids: string;
  i: longint;
begin
  if FBrowseChildRecIDs = nil then
    FBrowseChildRecIDs := TList.Create;
  FBrowseChildRecIDs.Clear;
  if ABrowseChildRecIDs <> '' then begin
    while ExtractWord([','], ids, ABrowseChildRecIDs) do begin
      i := pos('ID', ids);
      if (length(ids) > 2) and (i = (length(ids) - 1)) then
        ids := copy(ids, 1, i - 1);
      if ids = '0' then
        i := 0
      else
        i := StrToULRecID(ids);
      FBrowseChildRecIDs.Add(pointer(i));
    end;
  end;
end;
{/v0.23}

procedure TULObjDesc.IncRefCount;
begin
  inc(RefCount);
end;

procedure TULObjDesc.DecRefCount;
begin
  dec(RefCount);
end;

function TULObjDesc.GetChildRecIDCount:integer;
begin
  if ULRecDesc = nil then
    Result := 0
  else
    Result := ULRecDesc^.ChildRecIDCount;
end;

function TULObjDesc.GetChildRecID(Index: integer): TULRecID;
begin
  if (Index < 0) or (Index >= ChildRecIDCount) then
    raise ERangeError.Create('TULObjDesc.ChildRecID ' + IntToStr(index));
  Result := ULRecDesc^.ChildRecIDs^[Index];
end;

function TULObjDesc.GetCaption: string;
begin
  {v0.24}
  if FCaption = '' then begin
    if ULRecDesc = nil then
      FCaption := ULRecIDToStrStrip(RecID)
    else
      FCaption := GetTxt(ULRecDesc^.Caption);
  end;
  Result := FCaption;
  {/v0.24
  if ULRecDesc = nil then
    Result := ''
  else
    Result := ULRecDesc^.Caption;}
end;

function TULObjDesc.GetFlags: TULRecFlags;
begin
  if ULRecDesc = nil then
    Result := 0
  else
    Result := ULRecDesc^.Flags;
end;

destructor TULObjDesc.Destroy;
var
  i: integer;
  fd: TULObjFldDesc;
begin
  if FFields.Count > 0 then begin
    for i := 0 to FFields.Count - 1 do begin
      fd := FFields[i];
      fd.Free;
    end;
  end;
  FFields.Free;
  FEditFields.Free;
  FBrowseFields.Free;
  {v0.23}
  FBrowseChildRecIDs.Free;
  {/v0.23}
{  PropNames.Free;
  PropHints.Free;}
end;

function TULObjDesc.GetFieldCount: integer;
begin
  Result := FFields.Count;
end;
{uldrobju}
function TULObjDesc.GetField(Index: integer): TULObjFldDesc;
begin
  Result := FFields[Index];
end;

function TULObjDesc.GetEditFieldCount: integer;
begin
  Result := FEditFields.Count;
end;

function TULObjDesc.GetEditField(Index: integer): TULObjFldDesc;
begin
  Result := FEditFields[Index];{ulobju}
end;

function TULObjDesc.GetBrowseFieldCount: integer;
begin
  case FBrowseMode of
    bmShort:  Result := FBrowseFields.Count;
  else
    Result := FFields.Count;
  end;
end;

function TULObjDesc.GetBrowseField(Index: integer): TULObjFldDesc;
begin
  case FBrowseMode of
    bmShort: Result := FBrowseFields[Index];
  else
    Result := FFields[Index];
  end;
end;

{v0.22}
function TULObjDesc.GetMenuFieldCount: integer;
begin
  {case FMenuMode of
    bmShort:  Result := FMenuFields.Count;
  else
    Result := FFields.Count;
  end;}
  Result := FMenuFields.Count;
end;

function TULObjDesc.GetMenuField(Index: integer): TULObjFldDesc;
begin
  {case FMenuMode of
    bmShort: Result := FMenuFields[Index];
  else
    Result := FFields[Index];
  end;}
  Result := FMenuFields[Index];
end;
{/v0.22}

function TULObjDesc.GetFirstPropIndex: integer;
begin
  Result := FFields.FirstPropIndex;
end;

{v0.47}
function TULObjDesc.HasFldDesc(const AName: string; var AFldDesc: TULObjFldDesc): boolean;
var
  i: integer;
begin
  Result := false;
  for i := 0 to FFields.Count - 1 do begin
    if FFields[i].Name = AName then begin
      AFldDesc := FFields[i];
      Result := true;
      exit;
    end;
  end;
end;
{/v0.47}

function TULObjDesc.FindFldDesc(const AName:string):TULObjFldDesc;
  { raises exception if the field with AName not found }
{v0.47}{/v0.47
var
  i: integer;}
begin
  Result := nil;
  {v0.47}
  if HasFldDesc(AName, Result) then
    exit;
  {/v0.47
  for i := 0 to FFields.Count - 1 do begin
    if FFields[i].Name = AName then begin
      Result := FFields[i];
      exit;
    end;
  end;}
  TULObj(Obj).SetResult(orFieldNotFound, AName);{ulrectyp}
end;
{v0.23}
function TULObjDesc.IsBrowseChildRecID(ARecID: TULRecID): boolean;
begin
  Result := false;
  if FBrowseChildRecIDs = nil then
    exit;
  Result := (BrowseChildRecIDCount = 0) or
  (FBrowseChildRecIDs.IndexOf(pointer(ARecID)) >= 0);
end;

function TULObjDesc.BrowseChildRecIDCount: integer;
begin
  Result := 0;
  if FBrowseChildRecIDs <> nil then
    Result := FBrowseChildRecIDs.Count;
end;

function TULObjDesc.GetNameProp: string;
begin
  Result := '';
  if ULRecDesc <> nil then
    Result := ULRecDesc^.NameProp;
end;

function TULObjDesc.GetEfNameProp: string;
begin
  Result := NameProp;
  if Result = '' then begin
    if (ULRecDesc <> nil) and ((ULRecDesc^.Flags and rfHasRecName) <> 0) then begin
      Result := Fields[0].Name;
    end else
      Result := 'Name';
  end;
end;
{/v0.23}
{v0.24}
function TULObjDesc.GetDefDir: string;
begin
  if ULRecDesc <> nil then
    Result := ULRecDesc^.DefDir
  else
    Result := '';
end;

procedure TULObjDesc.SetDefDir(const ADir: string);
begin
  if ULRecDesc <> nil then
    ULRecDesc^.DefDir := ADir;
end;
{/v0.24}

{v0.25}
function TULObjDesc.GetOpenFilter: string;
begin
  if ULRecDesc <> nil then
    Result := GetTxt(ULRecDesc^.OpenFilter)
  else
    Result := '';
  {v0.37}
  if Result = '' then
    Result := DefFilter;
  {/v0.37}
end;

procedure TULObjDesc.SetOpenFilter(const AOpenFilter: string);
begin
  if ULRecDesc <> nil then
    ULRecDesc^.OpenFilter := AOpenFilter;
end;


function TULObjDesc.GetSaveFilter: string;
begin
  if ULRecDesc <> nil then
    Result := GetTxt(ULRecDesc^.SaveFilter)
  else
    Result := '';
  {v0.37}
  if Result = '' then
    Result := DefFilter;
  {/v0.37}
end;

procedure TULObjDesc.SetSaveFilter(const ASaveFilter: string);
begin
  if ULRecDesc <> nil then
    ULRecDesc^.SaveFilter := ASaveFilter;
end;
{/v0.25}

{v0.31}
{$IFNDEF CONSOLE}
procedure TULObjDesc.FieldsToCheckListBox(ff: integer; ACheckListBox: TCheckListBox; var ACaption: string);
var
  i: integer;
  f: TULObjFldDesc;
begin
  with ACheckListBox do begin
    Items.Clear;
    ACaption := TULObj(Obj).ObjDesc.Caption;
    for i := 0 to TULObj(Obj).FieldCount - 1 do begin
      f := TULObj(Obj).Fields[i].FldDesc;
      Items.Add(f.Caption);
      if f.IsFlagSet(ff) then
        State[i] := cbChecked
      else
        State[i] := cbUnchecked
    end;
  end;
end;

procedure TULObjDesc.CheckListBoxToFields(ff: integer; ACheckListBox: TCheckListBox);
var
  i: integer;
  f: TULObjFldDesc;
begin
  with ACheckListBox do begin
    for i := 0 to TULObj(Obj).FieldCount - 1 do begin
      f := TULObj(Obj).Fields[i].FldDesc;
      f.SetFlag(ff, Checked[i]);
    end;
  end;
end;

{$ENDIF}
{/v0.31}


{v0.37}
function TULObjDesc.GetDefFilter: string;
begin
  Result := Caption + ' (*' + ULRecDefFileExt(RecID) +
      ')|*' + ULRecDefFileExt(RecID)
end;
{/v0.37}

{v0.40}
function TULObjDesc.GetClassFlags: longint;
begin
  Result := FClassFlags;
end;

procedure TULObjDesc.SetClassFlags(AFlags: longint);
begin
  FClassFlags := AFlags;
end;

function TULObjDesc.IsClassFlagSet(cf: longint): boolean;
begin
  Result := (FClassFlags and cf) = cf;
end;

procedure TULObjDesc.SetClassFlag(cf: longint; OnOff: boolean);
begin
  if OnOff then begin
    FClassFlags  := FClassFlags or cf
  end else begin
    FClassFlags  := FClassFlags and (not cf);
  end;
end;
{/v0.40}
{v0.41}
function TULObjDesc.GetDefExt: string;
begin
  Result := ULRecDefFileExt(RecID);
end;
{/v0.41}

{v0.47}
{$IFNDEF CONSOLE}
function TULObjDesc.EditFormCreate(AULObj: TObject): TForm;
begin
  Obj := AULObj;
  Result := TULEditForm.Create(Application);
  EditControlFill(Result, AULObj);
end;

procedure TULObjDesc.EditControlFill(AControl: TWinControl; AULObj: TObject);
const
  compSize = 30;
    { what is the nonvisual component visual size during designing }
  fcheight = 24;
    { form caption height }
  MemoRowCount = 3;
var
  f: TULObjFldDesc;
  fctrl, ctrl: TControl;
var
  left, top, width, height: integer;
    { current values }
  {v0.50}{/v0.50 fleft, ftop,}fwidth, fheight: integer;
    { form's values }
  lleft, ltop, lwidth, lheight: integer;
    { values for inserting label controls, cltop - changes }
  eleft, etop, ewidth, eheight: integer;
    { values for inserting edit controls, cetop - changes }
  rheight: integer;
    { row height (distance between tops of neighbour edit controls }
  bleft, btop, bwidth, bheight: integer;
    { values for buttons, cbleft - changes }
  wdist, hdist: integer;
    { witdth and height minimal distances between controls }
  pi: integer;
    { index in editflds }
  tabord: integer;
    { taborder of edits, buttons }
  cap: string;
  a, av: string;
  editRowCount: integer;
  cs: string;
  {v0.50}
  maxRight: integer; {what is the maximal right property of controls inserted to WinControl}
  {/v0.50}

  {v0.50}
  function ShouldIgnoreField(f: TULObjFldDesc): boolean;
  var
    i: integer;
  begin
    if UserMode = umSysOp then begin
      Result := false;
    end else begin
      i := pos('_', f.Name);
      Result := (i = length(f.Name)) or (not f.Visible);
    end;
  end;
  {/v0.50}

  procedure AddCtrlPos;
  var
    MyRect: TRect;
  begin
    {ctrl.Left := left;
    ctrl.Top := top;
    ctrl.Width := width;
    ctrl.Height := height;}

    {MyRect := ActiveControl.BoundsRect;}
    MyRect.Left := left;
    MyRect.Top := top;
    MyRect.Right := MyRect.Left + width{2 * (MyRect.Right - MyRect.Left)};
    MyRect.Bottom := MyRect.Top + height{(MyRect.Bottom - MyRect.Top) div 2};
    ctrl.BoundsRect := MyRect;

    {v0.50}
    if (ctrl.left + ctrl.width) > maxRight then
      maxRight := (ctrl.left + ctrl.width);
    {/v0.50}
  end;

  procedure AddStdEditProps;
  begin
    ctrl.Parent := AControl;
    ctrl.Name := f.Name + 'Edit';
    AddCtrlPos;
    if ctrl is TWinControl then with ctrl as TWinControl do
      TabOrder := tabord;
  end;

  procedure AddBtnEdit;
  begin
    ctrl := TBtnEdit.Create(AControl);{btnedit}
    AddStdEditProps;
    with ctrl as TBtnEdit do begin
      ReadOnly := true;  { ulrectyp }
      Tag := f.ULIndex;  { typ := 'TBtnEdit';  r}{ulobju}
    end;
  end;

begin
  {v0.50}
  AControl.HandleNeeded;
  maxRight := 0;
  {/v0.50}

  Obj := AULObj;
  tabord := 0;
  rheight := 22;

  wdist := 5;
  hdist := 8;

  lleft := 16;
  ltop := 20;
  lheight := 13;
  lwidth  := 60;

  eleft := 140;
  etop := 16;
  eheight := 21;
  ewidth := 121;

  bwidth := 75;
  bheight := 25;


  {v0.50}{/v0.50
  fleft := 181;
  ftop := 129;}
  fwidth := max(eleft + ewidth, 339);

  fheight := ltop + 2 * hdist + bheight + fcheight;
  btop := ltop + hdist;
  for pi := 0 to EditFieldCount - 1 do begin
    f := EditFields[pi];
    {v0.50}
    if ShouldIgnoreField(f) then
      continue;
    {/v0.50}
    editRowCount := 1;
    if f.IsMemo then begin
      editRowCount := MemoRowCount;
    end else if f.IsMethod then begin
      editRowCount := 0;
    end;
    fheight := fheight + editRowCount * rheight;
    btop := btop + editRowCount * rheight;
  end;

  bleft := (fwidth - 2 * bwidth) div 3;
  if ChildRecIDCount > 0 then begin
    bleft := (fwidth - 3 * bwidth) div 4;
  end;

  left := {v0.50}(Application.MainForm.Width - fwidth) div 2{/v0.50 fleft};
  top := {v0.50}(Application.MainForm.Height - fheight) div 2{/v0.50 ftop};
  width := fwidth;
  height := fheight;
    { form's dimensions }
  AControl.Left := left;
  AControl.Top := top;
  AControl.Width := width;
  AControl.Height := height;

  if AControl is TForm then with AControl as TForm do begin
    Color := clBtnFace;
    {Font.Charset := DEFAULT_CHARSET;}
    Font.Color := clWindowText;
    Font.Height := -11;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    Caption :=  TULObj(Obj).RecIDStrStripped + 'Form';{FCCRecIDStr + 'Form'};
    OldCreateOrder := False;
    PixelsPerInch := 96;
    {Canvas.TextHeight := 13;{ulobjrwu}
  end;

  top := ltop;
  fctrl := nil;
  {???}
  {
  ctrl := TLabel.Create(AControl);
  ctrl.Parent := AControl;
  ctrl.Name := 'TstLbl';
  with ctrl as TLabel do begin
    caption := ' ';
  end;
  AddCtrlPos;
  }
  {/???}
  for pi := 0 to EditFieldCount - 1 do begin
    f := EditFields[pi];
    {v0.50}
    if ShouldIgnoreField(f) then
      continue;
    {/v0.50}
    editRowCount := 1;
    if f.IsMemo then
      editRowCount := MemoRowCount
    else if f.IsMethod then
      editRowcount := 0;
    if editRowCount > 0 then begin
      left := lleft;
      width := lwidth;
      height := lheight;
      ctrl := TLabel.Create(AControl);
      if fctrl = nil then
        fctrl := ctrl;{appmancz.lng}
      ctrl.Parent := AControl;
      Application.ProcessMessages;
      ctrl.Name := f.Name + 'Lbl';
      AddCtrlPos;
        {f.Caption = '' then
          cap := InsertSpacesIntoMultiWordName(f.Name)
        else}
      with ctrl as TLabel do begin
        Caption := f.Caption;
        FocusControl := TWinControl(AControl.FindComponent(f.Name + 'Edit'));
      end;
      top := top + rheight * editRowCount;
    end;

  end;

  top := etop;
  for pi := 0 to EditFieldCount - 1 do begin
    f := EditFields[pi];
    {v0.50}
    if ShouldIgnoreField(f) then
      continue;
    {/v0.50}
    editRowCount := 1;
    left := eleft;
    width := ewidth;
    height := eheight;
    ctrl := nil;
    if f.IsBoolean then begin
      ctrl := TCheckBox.Create(AControl);
      AddStdEditProps;
      with ctrl as TCheckBox do begin
        Caption := '';
      end;
    end else if f.IsEnum or f.IsULEnum then begin
      ctrl := TComboBox.Create(AControl);
      AddStdEditProps;
      with ctrl as TComboBox do begin
        Style := csDropDownList;
        {typ := 'TComboBox';}
      end;
    end else if f.IsMemo then begin
      editRowCount := MemoRowCount;
      height := eheight * editRowCount;
      ctrl := TMemo.Create(AControl);
      AddStdEditProps;
      {typ := 'TMemo';}
    end else if f.IsMethod then begin
      editRowcount := 0;
    end else if f.IsFileName then begin
      AddBtnEdit;
    end else if f.IsDir then begin
      AddBtnEdit;
    end else if f.IsSetType then begin
      AddBtnEdit;
    {v0.50}
    end else if f.IsColor then begin
      AddBtnEdit;
    {/v0.50}
    end else begin
      ctrl := TEdit.Create(AControl);
      AddStdEditProps;
      {typ := 'TEdit';}
    end;

    if (not f.Enabled) {v0.48} and (not TULObj(AULObj).NextEditEnableAll){/v0.48} then begin
      if ctrl <> nil then
        ctrl.Enabled := False;
    end;

    if f.IsFlagSet(ffReadOnly) then begin
      if ctrl is TEdit then with ctrl as TEdit do
        ReadOnly := true;
    end;

    if editRowCount > 0 then
    begin
      inc(tabord);
      top := top + rheight * editRowCount;
    end;

  end;

  left := bleft;
  top := btop;
  width := bwidth;
  height := bheight;

  ctrl := TButton.Create(AControl);
  ctrl.Parent := AControl;
  AddCtrlPos;
  with ctrl as TButton do begin
    Name := 'OKBtn';
    Caption := GetTxt({#}'&OK');
    Default := True;
    ModalResult := 1;
    TabOrder := tabord;
    inc(tabord);
  end;

  left := left + bwidth + bleft;

  ctrl := TButton.Create(AControl);
  AddCtrlPos;
  with ctrl as TButton do begin
    Name := 'CancelBtn';
    Parent := AControl;
    Caption := GetTxt({#}'&Cancel');
    ModalResult := 2;
    TabOrder := tabord;
    inc(tabord);
  end;

  {v0.62}
  if AControl is TForm then
  {/v0.62}
  begin
    if ChildRecIDCount > 0 then begin
      left := left + bwidth + bleft;
      ctrl := TButton.Create(AControl);
      AddCtrlPos;
      with ctrl as TButton do begin
        Name := 'ParamsBtn';
        Parent := AControl;
        Caption := GetTxt({#}'&Parameters');
        TabOrder := tabord;
        inc(tabord);
      end;
    end;
  end;
  {
  left := fwidth - compSize - wdist;
  top := hdist;
  dw('  object ' + FCCRecIDStr + 'FormIni: TIniObject');
  dw('    FormNameIsIniName = False');
  dw('    Disabled = True');
  dw('    Left = ' + IntToStr(left));
  dw('    Top = ' + IntToStr(top));
  dw('  end');
  dw('end');
  }
  {v0.50}
{  if AControl is TForm then begin
    if (AControl.width - maxRight) > 10 then
      AControl.Width := maxRight + 10;
  end;}
  {/v0.50}
end;
{$ENDIF}
{/v0.47}

{v0.50}
function TULObjDesc.IsChildRecID(ARecID: TULRecID): boolean;
var i: integer;
begin
  Result := false;
  for i := 0 to ChildRecIDCount - 1 do begin
    if ARecID = ChildRecIDs[i] then begin
      Result := true;
      exit;
    end;
  end;
end;
{/v0.50}


{/TULObjDesc}

{TULObjDescs}
function TULObjDescs.FindInfo(ARecID: TULRecID; var AInfo: TULObjDesc):boolean;
var i:integer; o:TULObjDesc;
begin
  Result := false;
  AInfo := nil;
  if Count = 0 then
    exit;
  for i := 0 to Count - 1 do begin
    o := TULObjDesc(Items[i]);
    if (o <> nil) and (o.RecID = ARecID) then begin
      AInfo := o;
      Result := true;
      exit;
    end;
  end;
end;

{/TULObjDescs.}

end.
