unit ULObjRWu;{ ULObjRW object (reader/writer of source ULObj descendant files) }
{
  (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.
}
{ ..\CULDef\ULANRecs.lst }
interface
uses
  Windows, Classes, SysUtils, {FileCtrl, }Math, Graphics { for Color related },
  ULRecTyp, ULRecUtl, ULObju, ULObjDes,
  {v1.02}{ulfobju}
  ULOType, ULOObju, ULORType, ULORObju, ULOFType, ULOFObju,
  { if ULAN\ULObj\ULOObju, ULORObju or ULOFObju files needs update
    (they are generated from ULOType, ULORType, ULOFType),
    create them by MakeCom2 in UlanObj directory using
    ULAN\UlanDef\ULOType,ULORType,ULOFType (updated) versions,
    then copy them to ULAN\ULObj directory.
  }
  {/v1.02}
  AttrType, Attrib, WinUtl;

const
  Version = '1.03';
  { v1.03 - SQL scripts for database generation }
  { v1.02 - creating .ULO file with structure/options information for ULObj objects }

type

  {v1.02}
  TULObjRWRec = class(TULORObj)
  protected
    function CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj; override;
  end;
  {/v1.02}

  TULObjRW = class({v1.02}TULOObj{/v1.02 TULObj})
  private
    {v1.02}
    FULOFile: TULObj;{ File holding ULO Object }
    FCurField: TULOFObj;{ FCurRec record's current field's options }
    {/v1.02}
    {xCCxx .. values for CurChild}
    FCCSrcFileName,
    FCCObjUnitFileName, FCCFormUnitFileName, FCCFormDFMFileName: string;
      { names of input file, output obj file, output frm file and frm resource (DFM) file }
    FCCSrcFile, objF, frmF, frdF: text;
      { corresponding text file variables }
    FCCRecIDStr, FCCObjTypeName, FCCObjUnitName, FCCFormTypeName, FCCFormUnitName: string;
      { = ULx, TULxObj, ULxObju, TULxForm, ULxFrmu }
    line: string;
      { current line from FCCSrcFileName }
    recattr: string;
      { list of attributes for whole record (in the form "attr1=value1 attr2=value2 ..."),
        specified in the ulxxtype.pas file in the format: }
      {<attr1=value1 attr2=value2 ..>}
      { just after the record word (see uldtype) }
    FCCFldN: TStringList;
      { list of field names found in record }
    FCCFldT: TStringList;
      { list of field pascal types found in record }
    FCCFldA: TStringList;
      { lists of attributes for the fields in the form "attr1=value1 attr2=value2 ...",
        specified after the field declaration in braces and in <> (see uldtype) }
    {v0.47}
    FCCCalcFields: TStringList;
    {/v0.47}
    editflds: TStringList;
      { list of field names that should appear in edit window }
    recdesc: TULRecDesc;
      { Values set from recattr list. }
    childrecids: TULChildRecIDs;
    usesStr: string;
      { if some additional unit(s) should be added uses clause of the created
        units, it should be specified here (comma separated list, after last
        name no comma); specified as record's attributes pnUses }
    FCurRec: {v1.02}TULObjRWRec{/v1.02 TULObj};
    inRecord: boolean ;
      { parsing the record's fields? }
    inAttr:boolean;
      { parsing the record's or field's attributes? }
    {include files for ULFOBJU.PAS; called only from MakeObjs }
    xu, xo, xf, xc, xd, xr: text;
    ulst: TStringList;{unit prefixes list = 3 or 4 uppercase letter codes}
    urecattr: TStringList;{rec attributes for units}
    fclst: TStringList;
      { list of root records (ulFid Childs) }
    FSourceFileName: string;
    DestDir: string ;
    SourceDir: string;
    ProjectPrefix: string;
    {v0.47}
    ShouldCreateEditForms: boolean;
    {/v0.47}

    FListFn: string;
    FTypes: TDict; // pascal type names and definitions; found in files defined in TYPEFILES= line }
    FConsts: TDict; // pascal const names and values; found -"- }
    { parse files defined in TYPEFILES=file1;file2;...   line }
    { Name of the database, defined in DATABASE=databasename  line. Can be
      a filename for the case of firebird e.g. data.fdb }
    FDatabase: string;
    procedure ParseTypeFiles(const AFiles: string);
    procedure ParseDatabase(const ALine: string);
    function GetDatabase: string;
  protected

    function CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj; override;

    procedure MakeObj(fn:string);
    procedure MakeObjs(ListFn:string);
    procedure ParseAttr;
    function ParseLine: boolean;

    {function GetFldN(Index: integer): string;
    function GetFldA(Index: integer): string;
    function GetFldT(Index: integer): string;}
    function GetSourceBaseFileName: string;
    function GetCCFieldCount: integer;
    procedure InInit;
    procedure InDone;

    procedure ObjInit;
    procedure ow(s:string);
    procedure ObjDone;

    procedure FrdInit;
    procedure dw(s: string);
    procedure FrdDone;

    procedure FrmInit;
    procedure fw(s:string);
    procedure FrmDone;

    procedure IncInit;
    procedure IncWrite;
    procedure IncDone;

    procedure CurChildCreateBegin;
    procedure CurChildCreateEnd;
  public
    {property CCFldN[Index: integer]: string read function GetFldN;
    property CCFldA[Index: integer]: string read function GetFldA;
    property CCFldT[Index: integer]: string read function GetFldT;}
    constructor Create(const AFileName: string);
    {v0.47}
    destructor Destroy; override;
    {/v0.47}
    procedure SaveToAsc;
    procedure WriteDatabaseCreate;


    property CCFieldCount: integer read GetCCFieldCount;
    property SourceBaseFileName: string read GetSourceBaseFileName;
    {.. properties of FCurRec }
    property CCFldN: TStringList read FCCFldN;
    property CCFldT: TStringList read FCCFldT;
    property CCFldA: TStringList read FCCFldA;
    {v0.47}
    property CCCalcFields: TStringList read FCCCalcFields;
    {/v0.47}
    property Database: string read GetDatabase;

    procedure Run(s: string);
  end;

implementation

function FieldColorsToFieldColorList(const AFieldColors: TULFieldColors;
  AFieldColorCount: integer): string;
var
  i: integer;
  a,b: string;
begin
  Result := '';
  for i := 0 to AFieldColorCount - 1 do begin
    if not ColorToIdent(AFieldColors[i, 0], a) then
      a := 'clBlack';
    if not ColorToIdent(AFieldColors[i, 1], b) then
      b := 'clWhite';
    Result := Result + a + ',' + b;
    if i < AFieldColorCount - 1 then
      Result := Result + ',';
  end;
end;

procedure FieldColorsListToFieldColors(av: string;
  var AFieldColors: TULFieldColors; var AFieldColorCount: integer);
var
  wrd: string;
  colr: longint;
begin
  FillChar(AFieldColors, sizeof(AFieldColors), 0);
  while ExtractWord([','], wrd, av) do begin
    if not IdentToColor(wrd, colr) then begin
      wrd := 'clBlack';
      colr := clBlack;
    end;
    AFieldColors[AFieldColorCount, 0] := colr;
    if not ExtractWord([','], wrd, av) then begin
      wrd := 'clWhite';
    end;
    if not IdentToColor(wrd, colr) then
      colr := clWhite;
    AFieldColors[AFieldColorCount, 1] := colr;
    inc(AFieldColorCount);
    if AFieldColorCount = ULMaxFieldColorCount then
      break;
  end;
end;

{v1.02}
{TULObjRWRec.}
function TULObjRWRec.CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
var
  o: TULObj;
begin
  if ARecID <> 0 then begin
    o := TULOFObj.Create(Self);
  end else begin
    o := nil;
    SetResult(orInvalidRecID, 'Invalid RecID ' + ULRecIDToStr(ARecID));
  end;
  CreateObj := o;
end;
{/TULObjRWRec.}
{/v1.02}


constructor TULObjRW.Create(const AFileName: string);
{v1.02}
var f: TULObj;
{/v1.02}
begin
  {/v1.02}
  f := TULObj.Create(nil, ULRID);{ulrectyp}
  {/v1.02}
  inherited Create({v1.02}f{/v1.02 nil ,ULRID});
  SetFlag(rfChildAllowed, true);{ulfobju}
  {v1.02}
  FULOFile := f;
  FULOFile.FileName := ChangeFileExt(AFileName, ULFExt);
  {/v1.02}
end;

function TULObjRW.CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
var
  {v1.02}
  o: TULObjRWRec;
  {/v1.02
  o: TULObj;}

begin
  if ARecID <> 0 then begin
    {v1.02}
    o := TULObjRWRec.Create(Self);
    o.TheRecIDStr := ULRecIDToStr(ARecID);{ulortype}
    {/v1.02
    o := TULObj.Create(Self, ARecID);}
  end else begin
    o := nil;
    SetResult(orInvalidRecID, 'Invalid RecID ' + ULRecIDToStr(ARecID));
  end;
  CreateObj := TULObj(o);
end;

procedure TULObjRW.IncInit;
var s:string;
begin
  s := '{ Created by ULObjRW v'+ Version + '}';

  AssignFile(xu, DestDir + 'ULXUNLST.INC');
  rewrite(xu);
  writeln(xu, s);

  AssignFile(xo, DestDir + 'ULXOCREA.INC');
  rewrite(xo);
  writeln(xo, s);

  {v0.47}
  if ShouldCreateEditForms then
  {/v0.47}
  begin
    AssignFile(xf, DestDir + 'ULXFCREA.INC');
    rewrite(xf);
    writeln(xf, s);
  end;

  AssignFile(xc, DestDir + 'ULXCNT.INC');
  rewrite(xc);
  writeln(xc, s);

  AssignFile(xd, DestDir + 'ULXRDESC.INC');
  rewrite(xd);
  writeln(xd, s);

  AssignFile(xr, DestDir + 'ULFDESC.INC');
  rewrite(xr);
  writeln(xr, s);

  ulst := TStringList.Create;
  urecattr := TStringList.Create;
  fclst := TStringList.Create;
end;

procedure TULObjRW.IncWrite;
var
  i:integer;
  ch:string[1];
  pref:string[4];
  s:string;
begin
  writeln(xc, 'const');
  writeln(xc, '  ULRecIDCount = ' + IntToStr(ulst.Count) + ';');
  writeln(xc, '  ULRecIDs: array[0..ULRecIDCount - 1] of TULRecID =(');
  write(xc, '    ');


  writeln(xr, 'const');
  writeln(xr, '  ULFChildRecIDs: array[0..' + IntToStr(fclst.Count-1) +
    '] of TULRecID = (');
  s := '';
  for i  := 0 to fclst.Count - 1 do begin
    if s = '' then
      s := fclst[i]
    else
      s := s + ', ' + fclst[i]
  end;
  writeln(xr, '    ' + s);
  writeln(xr, '  );');
  writeln(xr, '  ULFRecDesc: TULRecDesc = (');
  writeln(xr, '    Caption: ' + '''' + 'File' + '''' + ';');
  writeln(xr, '    ChildRecIDsStr: ' + '''' + s + '''' + ';');
  writeln(xr, '    ChildRecIDs: @ULFChildRecIDs;');
  writeln(xr, '    ChildRecIDCount: ' + IntToStr(fclst.Count) + ';');
  writeln(xr, '    FldCount: 0;');
  writeln(xr, '    Flds: nil;');
  writeln(xr, '    Flags: rfChildAllowed;');
  writeln(xr, '    SortExp: ' + '''' + '''' + '');
  writeln(xr, '  );');
  writeln(xr,'');


  for i := 0 to ulst.Count - 1 do begin
    pref := ulst[i];
    if i = ulst.Count - 1 then begin
      ch := '';
      writeln(xc, pref + 'ID');
    end else begin
      ch := ',';
      write(xc, pref + 'ID, ');
      if ((i + 1) mod 8 = 0) then begin
        writeln(xc);
        write(xc, '    ');
      end;
    end;

    {v0.47}
    if not ShouldCreateEditForms then
    begin
      writeln(xu, '  ' + pref + 'Type, ' + pref + 'Obju' + ch);
    end else
    {/v0.47}
    begin
      writeln(xu, '  ' + pref + 'Type, {$IFNDEF CONSOLE}' + pref + 'Frmu,{$ENDIF} ' + pref + 'Obju' + ch);
    end;

    writeln(xo, '  ' + pref + 'ID : o := T' + pref + 'Obj.Create(AOwner);');
    {v0.47}
    if ShouldCreateEditForms then
    {/v0.47}
    begin
      writeln(xf, '  ' + pref + 'ID: f := T' + pref + 'Form.Create(Application);');
    end;
    if urecattr[i] <> '' then begin
      writeln(xd, '    ' + pref + 'ID: Result := @' + pref + 'RecDesc;');
    end;
  end;
  writeln(xc, '  );');
end;

procedure TULObjRW.IncDone;
begin
  urecattr.Free;
  ulst.Free;
  {v0.47}
  fclst.Free;
  {/v0.47}
  close(xu);
  close(xo);
  {v0.47}
  if ShouldCreateEditForms then
  {/v0.47}
  begin
    close(xf);
  end;
  close(xc);
  close(xd);
  close(xr);
end;
{/include files}

procedure TULObjRW.InInit;
begin
  AssignFile(FCCSrcFile, SourceDir + FCCSrcFileName);
  Reset(FCCSrcFile);
end;

procedure TULObjRW.InDone;
begin
  CloseFile(FCCSrcFile);
end;

procedure TULObjRW.ow(s:string);
begin
  writeln(objf, s);
end;

procedure TULObjRW.ObjInit;
begin
  AssignFile(objF, DestDir + FCCObjUnitFileName);
  Rewrite(objf);
end;

procedure TULObjRW.ObjDone;
var
  i{, j}: integer;
  s, an, av: string;
  fval:string;
  {v0.22}
  a: string;
  {/v0.22}

  {v0.23}
  function CheckSetPropValue:boolean;
  begin
    Result :=
      ( (recdesc.Flds^[i].Flags and ffCommand) = 0 )
      and
      ( (recdesc.Flds^[i].Flags and ffWriteAlways) = 0 )
      and
      (av <> pvMethod)
      {v0.47}
      and
      ( (recdesc.Flds^[i].Flags and ffCalcField) = 0 )
      {/v0.47};
  end;
  {/v0.23}

  procedure WriteFldColors(AFieldNr: integer);
  var
    j: integer;
    col: integer;
    wrd: string;
    wrds: string;
  begin
    with recdesc.Flds^[AFieldNr] do begin
      ow('     FieldColors' + IntToStr(AFieldNr) + ' : array[0..' +
        IntToStr(FieldColorCount-1) + '] of TULFieldColor = (');
      for j := 0 to FieldColorCount - 1 do begin
        wrds := '(';
        if j < FieldColorCount then begin
          col := FieldColors^[j, 0];
          if not ColorToIdent(col, wrd) then begin
            wrd := 'clBlack';
          end;
          wrds := wrds + wrd + ',';
          col  := FieldColors^[j, 1];
          if not ColorToIdent(col, wrd) then begin
            wrd := 'clWhite';
          end;
          wrds := wrds + wrd + ')';
        end else begin
          wrds := '(clBlack,clWhite)';
        end;

        if j < FieldColorCount - 1 then
          ow('      ' + wrds + ',')
        else
          ow('      ' + wrds);
      end;
      ow('     ' + ')' + ';');
    end;
    ow('');
  end;

  procedure WriteFldsColors;
  var i: integer;
  begin
    for i := 0 to recdesc.FldCount - 1 do begin
      if recdesc.Flds^[i].FieldColorCount > 0 then
        WriteFldColors(i);
    end;
  end;

  procedure WriteFldDesc(AFieldNr: integer);
  var j: integer;
  begin
    with recdesc.Flds^[AFieldNr] do begin
      ow('    (');
      ow('     Caption: ' + '''' + Caption + '''' + ';');
      ow('     Hint: ' + '''' + Hint + '''' + ';');
      ow('     EditWidth: ' + IntToStr(EditWidth) + ';');
      ow('     BrowseWidth: ' + IntToStr(BrowseWidth) + ';');
      ow('     Flags: ' + IntToStr(Flags) + ';');
      fval := FloatToStrF(UserCoef, ffFixed, 7, 2);
      for j := 1 to length(fval) do begin
        if fval[j] = ',' then
          fval[j] := '.';
      end;
      ow('     UserCoef: ' + fval + ';');
      ow('     NumDec: ' + IntToStr(NumDec) + ';');
      {v0.14}
      if ValuesSourceRecID <> 0 then begin
        ow('     ValuesSourceRecID: ' + ULRecIDToStrStrip(ValuesSourceRecID) + 'ID' + ';');
      end else begin
        ow('     ValuesSourceRecID: 0' + ';');
      end;
      {v0.24}
      ow('     FieldColorCount : ' + IntToStr(FieldColorCount) +  ';');
      if FieldColorCount > 0 then begin
        ow('     FieldColors : @FieldColors' + IntToStr(AFieldNr) + ';');
      end else begin
        ow('     FieldColors : nil' + ';');
      end;
      ow('     Filter: ' + '''' + Filter + '''' + ';');
      ow('     DefDir: ' + '''' + DefDir + '''' + ';');
      ow('     StripPrefix: ' + '''' + StripPrefix + '''' + ';');
      {/v0.24}
      {v0.26}
      ow('     EditMask: ' + '''' + EditMask + '''' + ';');
      {/v0.26}
      {v0.45}
      ow('     MaxID: ' + IntToStr(MaxID) + ';');
      ow('     FieldName: ' + '''' + FieldName + '''' +  ';');
      {/v0.45}
      {v0.47}
      ow('     KeyFieldName: ' + '''' + KeyFieldName + '''' + ';');
      ow('     ListFieldName: ' + '''' + ListFieldName + '''' + ';');
      {/v0.47}
      {v0.65}
      //ow('     DefVal: ' + DefVal + ';'); dont write the thing, don't know if it's a string or what
      ow('     Typ: ' + '''' + '' + '''' + ';');
      ow('     VarSize: false' + ';');
      ow('     PasType: ' + '''' + PasType + '''' + ';');

      {/v0.65}
      {/v0.14}{ulobjdes}
      if AFieldNr = recdesc.FldCount - 1 then
        ow('    )')
      else
        ow('    ),');
    end;
  end;

  procedure WriteFldsDescs;
  var
    i: integer;
  begin
    if recdesc.FldCount = 0 then
      exit;
    WriteFldsColors;
    ow('  ' + FCCRecIDStr + 'FldDescs: array[0..' + IntToStr(recdesc.FldCount - 1) +
     '] of TULFldDesc = (');
    for i := 0 to recdesc.FldCount - 1 do begin
      WriteFldDesc(i);
    end;
    ow('  );');
    ow('');
  end;

  procedure CreateFieldChilds;
  var i: integer;
  begin
    if recdesc.FldCount = 0 then
      exit;
    for i := 0 to recdesc.FldCount - 1 do begin
      FCurField := TULOFObj(FCurRec.Add(ULOFID));
      with recdesc.Flds^[i] do begin
        FCurField.Caption := Caption;
        FCurField.Hint := Hint;
        FCurField.EditWidth := EditWidth;
        { Width of the field value in browsewindow. If = 0, default used. }
        FCurField.BrowseWidth := BrowseWidth;
        { See ffXXXX }
        FCurField.TheFlags := Flags;
        { Coeficient by which the value of the field will be divided
          if UserValue will be requested (taken in account if <> 0) }
        FCurField.UserCoef := UserCoef;
        { Number of decimal points if converting number to string,
          number of digits taken from BrowseWidth }
        FCurField.NumDec := NumDec;
        FCurField.ValuesSourceRecID := ValuesSourceRecID;

        FCurField.FieldColorsList := FieldColorsToFieldColorList(FieldColors^,
          FieldColorCount);

        FCurField.Filter := Filter ;
        { Default position/size in record edit window }
        FCurField.Left := Left;
        FCurField.Top := Top;
        FCurField.Width := Width;
        FCurField.Height := Height;
        { Default directory where to look for files for this field
          (if is filename) }
        FCurField.DefDir := DefDir;
        FCurField.StripPrefix := StripPrefix ;
        FCurField.EditMask := EditMask;
        { Used if AutoInc field }
        FCurField.MaxID := MaxID; {ulofobju}
        FCurField.FieldName := FieldName;
        FCurField.KeyFieldName := KeyFieldName;
        FCurField.ListFieldName := ListFieldName;
        { What is the type of visual component to be used to change this field }
        FCurField.Typ := Typ;
        { Is the field of variable size? (AnsiString, WideString). Will be set
          at runtime. }
        FCurField.VarSize := VarSize;
        { Keep it as the last field of this record (not used now) }
        FCurField.DefVal := DefVal;
        FCurField.PasType := PasType;//FCCFldT[i];
      end;
    end;
  end;

begin
  ow('unit ' + FCCObjUnitName + ';');
  ow('{ Generated by MakeComp ' + Version + ' from ' + FCCSrcFileName +
   '. Don' + '''' + 't modify manually !!! }');
  ow('interface');
  {v1.04}
  ow('uses Classes, SysUtils, Graphics, ' + ProjectPrefix + 'Type, ULRecTyp, ULObju, ');
  {/v1.04
  ow('uses Classes, UlanType, ULRecTyp, ULObju, ');}
  if usesStr <> '' then
    ow('  ' + usesStr + ',');
  ow('  ' + FCCRecIDStr + 'Type;');
  ow('');
  ow('type');
  ow('  ' + FCCObjTypeName + ' = class(TULObj)');
  {
  ow('  private');
  for i := 0 to CCFldN.Count -1 do begin
    ow('    F' + CCFldN[i] + ': ' + CCFldT[i] + ';');
  end;
  }
  ow('  protected');
  for i := 0 to CCFldN.Count - 1 do begin
    ow('    function Get' + CCFldN[i] + ': ' + CCFldT[i] + ';');
    ow('    procedure Set' + CCFldN[i] + '(A'+ CCFldN[i] + ': ' +
      CCFldT[i] + ');');
  end;
  ow('    function GetMinRecLen: TULRecLen; override;');
  ow('  public');
  ow('    constructor Create(AOwner:TULObj);');
  if recattr <> '' then begin
    ow('    function GetULRecDesc: PULRecDesc; override;');
  end;
  if recdesc.SortExp <> '' then begin
    if (recdesc.Flags and rfSortedByNumber) <> 0 then
      ow('    function GetSortNum: extended; override;')
    else
      ow('    function GetSortStr: string; override;')
  end;
  ow('  published');
  for i := 0 to CCFldN.Count - 1 do begin
    ow('    property ' + CCFldN[i] + ': ' + CCFldT[i]);
    ow('      read Get' + CCFldN[i] + ' write Set' + CCFldN[i] + ';');
  end;
  ow('  end;');
  ow('');

  if recattr <> '' then begin
    with recdesc do begin
      ow('const');
      if recdesc.ChildRecIDCount > 0 then begin
        ow('  ' + FCCRecIDStr + 'ChildRecIDs: array[0..' +
          IntToStr(recdesc.ChildRecIDCount - 1) + '] of TULRecID = (');
            ow('    ' + recdesc.ChildRecIDsStr);
     {  s := '';
        for i := 0 to recdesc.ChildRecIDCount - 1 do begin
          if s = '' then
            s := IntToStr(recdesc.ChildRecIDs^[i])
          else
            s := s + ', ' + IntToStr(recdesc.ChildRecIDs^[i]);
        end;
        ow('    ' + s);
        }
        ow('  );');
      end;

      WriteFldsDescs;

      ow('  ' + FCCRecIDStr + 'RecDesc: TULRecDesc = (');
      ow('    Caption: ' + '''' + recdesc.Caption + '''' + ';');
      ow('    ChildRecIDsStr: ' + '''' + recdesc.ChildRecIDsStr + '''' + ';');
      if recdesc.ChildRecIDCount > 0 then begin
        ow('    ChildRecIDs: @' + FCCRecIDStr + 'ChildRecIDs;');
      end else begin
        ow('    ChildRecIDs: nil;');
      end;
      ow('    ChildRecIDCount: ' + IntToStr(recdesc.ChildRecIDCount) + ';');
      ow('    FldCount: '+ IntToStr(recdesc.FldCount) + ';');
      if recdesc.FldCount > 0 then begin
        ow('    Flds: @' + FCCRecIDStr + 'FldDescs;');
      end else begin
        ow('    Flds: nil;');
      end;
      s := '';
      if (Flags and rfChildAllowed) <> 0 then
        s := s + 'rfChildAllowed OR ';
      if (Flags and rfDataChild) <> 0 then
        s := s + 'rfDataChild OR ';
      if (Flags and rfRootChild) <> 0 then begin
        fclst.Add(FCCRecIDStr + 'ID');
        s := s + 'rfRootChild OR ';
      end;
      if (Flags and rfChildSorted) <> 0 then
        s := s + 'rfChildSorted OR ';
      if (Flags and rfHasRecName) <> 0 then
        s := s + 'rfHasRecName OR ';
      {v0.22}
      if (Flags and rfHasPointer) <> 0 then
        s := s + 'rfHasPointer OR ';
      {/v0.22}
      {v0.24}
      if (Flags and rfUsingColors) <> 0 then
        s := s + 'rfUsingColors OR ';
      {/v0.24}
      {v0.25}
      if (Flags and rfAskForSave) <> 0 then
        s := s + 'rfAskForSave OR ';
      {/v0.25}
      if (Flags and rfTemporary) <> 0 then
        s := s + 'rfTemporary OR ';
      if (Flags and rfEnabled) <> 0 then
        s := s + 'rfEnabled OR ';
      {v1.03}
      if (Flags and rfEditModal) <> 0 then
        s := s + 'rfEditModal OR ';
      {v0.23}
      if (Flags and rfBrowseModal) <> 0 then
        s := s + 'rfBrowseModal OR ';
      {/v0.23}
      {v0.44}
      if (Flags and rfOwnMessageOnSelect) <> 0 then
        s := s + 'rfOwnMessageOnSelect OR ';
      {/v0.44}

      if (Flags and rfVisible) <> 0 then
        s := s + 'rfVisible OR ';
      if (Flags and rfFileDataStream) <> 0 then
        s := s + 'rfFileDataStream OR ';
      if (Flags and rfBrowseOnEdit) <> 0 then
        s := s + 'rfBrowseOnEdit OR ';
      if (Flags and rfSortedByNumber) <> 0 then
        s := s + 'rfSortedByNumber OR ';

      if s = '' then
        s := '0';
      while s[length(s)] in [' ','+','O','R'] do SetLength(s, length(s) - 1);
      ow('    Flags: ' + s + ';');
      ow('    SortExp: ' + '''' + SortExp + '''' + ';');
      ow('    EditFieldList: ' + '''' + EditFieldList + '''' + ';');
      ow('    BrowseFieldList: ' + '''' + BrowseFieldList + '''' + ';');
      {v0.22}
      ow('    MenuFieldList: ' + '''' + MenuFieldList + '''' + ';');
      {/v0.22}
      {v0.23}
      ow('    BrowseChildRecIDs: ' + '''' + BrowseChildRecIDs + '''' + ';');
      ow('    NameProp: ' + '''' + NameProp + '''' + ';');
      {/v0.23}
      ow('    MainProp: ' + '''' + MainProp + '''' + ';');
      ow('    DefDir: ' + '''' + DefDir + '''' + ';');
      ow('    OpenFilter: ' + '''' + OpenFilter + '''' + ';');
      ow('    SaveFilter: ' + '''' + SaveFilter + '''' + ';');
      ow('    Table: ' + '''' + Table + '''' + ';');
      ow('    Indexes: ' + '''' + Indexes + '''' + '');
      ow('   );');
      ow('');
    end;
  end;

  ow('implementation');
  ow('');
  ow('{' + FCCObjTypeName + '}');
  ow('function ' + FCCObjTypeName + '.GetMinRecLen: TULRecLen;');
  ow('begin');
  ow('  GetMinRecLen := sizeof(T' + FCCRecIDStr + 'Rec);');
  ow('end;');
  ow('');
  ow('constructor '+ FCCObjTypeName + '.Create(AOwner: TULObj);');
  ow('begin');
  ow('  inherited Create(TComponent(AOwner), ' + FCCRecIDStr + 'ID);');
  s := recattr;
  while GetNextAttrib(s, an, av) do begin
    if pos('Create', an) = 1 then begin
      ow('  ' + av);
    end;
  end;
  {v0.24}
  for i := 0 to CCFldN.Count - 1 do begin
    av := '';
    a := CCFldA[i];
    if FindAttrib(a, pnDefVal, av, false) and (av <> '') then begin
      ow('  ' + CCFldN[i] + ' := ' + av + ';');
    end;
  end;
  {/v0.24}
  ow('end;');
  ow('');
  if recattr <> '' then begin
    ow('function ' + FCCObjTypeName + '.GetULRecDesc: PULRecDesc;');
    ow('begin');
    ow('  Result := @' + FCCRecIDStr + 'RecDesc;');
    ow('end;');
    ow('');
  end;

  if recdesc.SortExp <> '' then begin
    if (recdesc.Flags and rfSortedByNumber) <> 0 then
      ow('function ' + FCCObjTypeName + '.GetSortNum: Extended;')
    else
      ow('function ' + FCCObjTypeName + '.GetSortStr: string;');
    ow('begin');
    ow('  Result := ' + recdesc.SortExp + ';');
    ow('end;');
  end;

  for i := 0 to CCFldN.Count - 1 do begin
    {v0.22}
    av := '';
    a := CCFldA[i];
    FindAttrib(a, pnType, av, false);
    {/v0.22}

    ow('procedure ' + FCCObjTypeName + '.Set' + CCFldN[i] + '(A' + CCFldN[i] + ': ' + CCFldT[i] + ');');
    ow('begin');

    {v0.23}
    if CheckSetPropValue then
    {/v0.23
    if (av <> pvMethod) then}
    ow('  if P' + FCCRecIDStr + 'Rec(Rec)^.' + CCFldN[i]+ ' <> A' + CCFldN[i] + ' then begin');

    ow('    P' + FCCRecIDStr + 'Rec(Rec)^.' + CCFldN[i]+ ' := A' + CCFldN[i] + ';');
    {v0.76}
    ow('    if ' + FCCRecIDStr + 'FldDescs[' + IntToStr(i) + '].VarSize then ');
    ow('      ClearFieldsLen;');
    {/v0.76}
    ow('    DoChange;');

    {v0.22} { uldptype }
    if av = pvMethod then
    begin
      ow('    {$IFNDEF CONSOLE}');
      ow('    Fields['+IntToStr(i) + '].Method := TMethod(A' + CCFldN[i] + ');');
      ow('    {$ENDIF}');
    end else
    {/0.22}
    begin
      {v0.23}
      if CheckSetPropValue then
      {/v0.23}
        ow('  end;');
    end;
    {v0.24}
    if recdesc.MainProp = CCFldN[i] then begin
      ow('  DoMainPropUpdated;');
    end;
    {/v0.24}

    ow('end;');
    ow('');
    ow('function ' + FCCObjTypeName + '.Get' + CCFldN[i] + ': ' + CCFldT[i] + ';');
    ow('begin');
    ow('  Get' + CCFldN[i] + ' := P' + FCCRecIDStr + 'Rec(Rec)^.' + CCFldN[i] + ';');
    ow('end;');
    ow('');
  end;
  ow('{/' + FCCObjTypeName + '}');
  ow('');
  ow('end.');
  close(objf);
  {v1.02}
  CreateFieldChilds;
  with recdesc do begin
    FCurRec.TheRecIDStr := FCCRecIDStr;
    FCurRec.Caption := Caption;
    FCurRec.ChildRecIDsStr:= ChildRecIDsStr;
    FCurRec.TheFlags := Flags;
    FCurRec.SortExp:= SortExp;
    FCurRec.EditFieldList:= EditFieldList;
    FCurRec.BrowseFieldList:= BrowseFieldList;
    FCurRec.MenuFieldList:= MenuFieldList;
    FCurRec.BrowseChildRecIDs:= BrowseChildRecIDs;
    FCurRec.NameProp:= NameProp;
    FCurRec.MainProp:= MainProp;
    FCurRec.DefDir:= DefDir;
    FCurRec.OpenFilter:= OpenFilter;
    FCurRec.SaveFilter:= SaveFilter;
    FCurRec.Table := Table;
    FCurRec.Indexes := Indexes;
  end;
  {/v1.02}
end;

procedure TULObjRW.fw(s:string);
begin
  writeln(frmF, s);
end;

procedure TULObjRW.FrmInit;
begin
  assignFile(frmF, DestDir + FCCFormUnitFileName);
  rewrite(frmF);
end;

procedure TULObjRW.FrmDone;
var
  i, p: integer;
  a, {an, }av: string;

  procedure DoFld(i:integer);
  {v0.22}
  var
    typeFound:boolean;
  {/v0.22}
  begin
    fw('    ' + CCFldN[i] + 'Lbl: TLabel;');
    a := CCFldA[i];
    {v0.22}
    typeFound := FindAttrib(a, pnType, av, false);
    if CCFldT[i] = 'boolean' then begin
      fw('    ' + CCFldN[i] + 'Edit: TCheckBox;');
    end else if
      ({v0.22}typeFound{/v0.22 FindAttrib(a, pnType, av, false)} and
       ((av = pvEnum)) {v0.14} or (av = pvULEnum) {/v0.14}
      )
    then begin
      fw('    ' + CCFldN[i] + 'Edit: TComboBox;');
    end else {v0.22}if typeFound and (av = pvMemo) then begin
      fw('    ' + CCFldN[i] + 'Edit: TMemo;');
    end else if typeFound and (av = pvMethod) then begin

    end else {/v0.22}{v0.24} if typeFound and ( (av = pvFileName) or
      (av = pvDir)) {v0.44} or (av = pvSet){/v0.44} then
    begin
      fw('    ' + CCFldN[i] + 'Edit: TBtnEdit;');
    end else {/v0.24}begin
      fw('    ' + CCFldN[i] + 'Edit: TEdit;');
    end;
  end;

begin
  fw('unit ' + FCCRecIDStr + 'Frmu;');
  fw('{ Generated by MakeComp ' + Version + ' from ' + FCCSrcFileName +
   '. Don' + '''' + 't modify manually !!! }');
  fw('interface');
  fw('');
  fw('uses');
  fw('  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,');
  fw('  IniObj, StdCtrls, ULObju, ULEdFrm, BtnEdit;');
  fw('');
  fw('type');
  fw('  T' + FCCRecIDStr + 'Form = class(TULEditForm)');
  for p := 0 to editflds.Count - 1 do begin
    i := CCFldN.IndexOf(editflds[p]);
    if i >= 0 then
      DoFld(i)
    else begin
      writeln('Error: ' + FCCRecIDStr + ' field ' + editflds[p] + ' not found. Press enter...');
      readln;
    end;
  end;
  fw('    OKBtn: TButton;');
  fw('    CancelBtn: TButton;');
  if recdesc.ChildRecIDCount > 0 then begin
    fw('    ParamsBtn: TButton;');
  end;
  fw('    ' + FCCRecIDStr + 'FormIni: TIniObject;');
  if recdesc.ChildRecIDCount > 0 then begin
    fw('    procedure ParamsBtnClick(Sender: TObject);');
  end;
  fw('    procedure FormCreate(Sender: TObject);');
  fw('    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);');
  fw('  private');
  fw('    { Private declarations }');
  fw('  public');
  fw('    { Public declarations }');
{  fw('    Obj: TULObj;');}
  fw('  end;');
  fw('');
  fw('var');
  fw('  ' + FCCRecIDStr + 'Form: T' + FCCRecIDStr + 'Form;');
  fw('');
  fw('implementation');
  fw('{$R *.DFM}');
  fw('');
  if recdesc.ChildRecIDCount > 0 then begin
    fw('procedure T' + FCCRecIDStr + 'Form.ParamsBtnClick(Sender: TObject);');
    fw('begin');
    fw('  if Obj <> nil then');
    fw('    Obj.Browse;');
    fw('end;');
    fw('');
  end;
  fw('procedure T' + FCCRecIDStr + 'Form.FormCreate(Sender: TObject);');
  fw('begin');
{  fw('  Obj := CurULObj;');
  fw('  CurULObj := nil;');}
  fw('end;');
  fw('');
  fw('procedure T' + FCCRecIDStr + 'Form.FormCloseQuery(Sender: TObject; var CanClose: Boolean);');
  fw('begin');
  fw('  if Sender = OKBtn then begin');
  fw('    CanClose := Obj.IsValidInput(Self);');
  fw('  end;');
  fw('end;');

  fw('');
  fw('end.');

  close(frmF);
end;

procedure TULObjRW.dw(s:string);
begin
  writeln(frdF, s);
end;

procedure TULObjRW.FrdInit;
begin
  assignFile(frdF, DestDir + FCCFormDFMFileName);
  rewrite(frdF);
end;

procedure TULObjRW.FrdDone;
const
  compSize = 30;
    { what is the nonvisual component visual size during designing }
  fcheight = 24;
    { form caption height }

  {v0.22}
  MemoRowCount = 3;
  {/v0.22}
var
  left, top, width, height: integer;
    { current values }
  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 }
  i: integer;
    { index in CCFldN }
  pi: integer;
    { index in editflds }
  tabord:integer;
    { taborder of edits, buttons }
  p:array[0..255]of char;
  convfn:string;
  res:longint;
  cap: string;

  a, {an, }av:string;
  typ: string;

  {v0.22}
  typeFound: boolean;
  editRowCount:integer;
  {/v0.22}
  {v0.46}
  cs: string;
  {/v0.46}
begin
  tabord := 0;
  rheight := 22;

  wdist := 5;
  hdist := 8;

  lleft := 16;
  ltop := {v0.11}20{v0.11 24};
  lheight := 13;
  lwidth  := 60;

  eleft := {v0.11}140{/v0.11 118};
  etop := 16;
  eheight := 21;
  ewidth := 121;

  {v0.22}
  {/v0.22
  btop := ltop + editflds.Count * rheight + hdist;}
  bwidth := 75;
  {bleft := wdist;{will set to (fwidth - 2 * bwidth) div 3 below}
  bheight := 25;

  fleft := 181;
  ftop := 129;
  fwidth := max(eleft + ewidth, 339);

  {v0.22}
  fheight := ltop + 2 * hdist + bheight + fcheight;
  btop := ltop + hdist;
  for pi := 0 to editflds.Count - 1 do begin
    i := CCFldN.IndexOf(editflds[pi]);
    if i >= 0 then begin
      a := CCFldA[i];
      typeFound := FindAttrib(a, pnType, av, false);
      editRowCount := 1;
      if typeFound then begin
        if (av = pvMemo) then
          editRowCount := MemoRowCount;
        if (av = pvMethod) then
          editRowCount := 0;
      end;
      fheight := fheight + editRowCount * rheight;
      btop := btop + editRowCount * rheight;
    end;
  end;
  {/v0.22
  fheight := ltop + editflds.Count * rheight + 2 * hdist + bheight + fcheight;}


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

  left := fleft;
  top := ftop;
  width := fwidth;
  height := fheight;
    { form's dimensions }

  dw('object ' + FCCRecIDStr + 'Form: T' + FCCRecIDStr + 'Form');
  dw('  Left = ' + IntToStr(left));
  dw('  Top = ' + IntToStr(top));
  dw('  Width = ' + IntToStr(width));
  dw('  Height = ' + IntToStr(height));
  dw('  Caption = ' + '''' + FCCRecIDStr + 'Form' + '''');
  dw('  Color = clBtnFace');
  dw('  Font.Charset = DEFAULT_CHARSET');
  dw('  Font.Color = clWindowText');
  dw('  Font.Height = -11');
  dw('  Font.Name = ' + '''' + 'MS Sans Serif' + '''');
  dw('  Font.Style = []');
  dw('  OldCreateOrder = False');
  dw('  OnCloseQuery = FormCloseQuery');
  dw('  OnCreate = FormCreate');
  dw('  PixelsPerInch = 96');
  dw('  TextHeight = 13');

  {v0.22}
  top := ltop;
  {/v0.22}
  for pi := 0 to editflds.Count - 1 do begin
    i := CCFldN.IndexOf(editflds[pi]);
    if i >= 0 then begin
      {v0.22}
      a := CCFldA[i];
      typeFound := FindAttrib(a, pnType, av, false);
      editRowCount := 1;
      if typeFound then begin
        if (av = pvMemo) then
          editRowCount := MemoRowCount;
        if (av = pvMethod) then
          editRowcount := 0;
      end;
      if editRowCount > 0 then begin
      {/v0.22
      top := ltop + pi * rheight;}

        left := lleft;
        width := lwidth;
        height := lheight;
        dw('  object ' + CCFldN[i] + 'Lbl: TLabel');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        if recdesc.Flds^[i].Caption = '' then
          cap := InsertSpacesIntoMultiWordName(CCFldN[i])
        else
          cap := recdesc.Flds^[i].Caption;

        dw('    Caption = ' + ''' ' + cap + '''');
          { let space before caption to leave enough space from form margin -
             autosized forms put caption to close to the margin }
        dw('    FocusControl = ' + CCFldN[i] + 'Edit');
        dw('  end');
      {v0.22}
      end;
      top := top + rheight * editRowCount;
      {/v0.22}
    end;

  end;

  {v0.22}
  top := etop;
  {/v0.22}
  for pi := 0 to editflds.Count - 1 do begin
    i := CCFldN.IndexOf(editflds[pi]);
    if i >= 0 then begin
      a := CCFldA[i];
      {v0.22}
      typeFound := FindAttrib(a, pnType, av, false);
      editRowCount := 1;
      {/v0.22
      top := etop + pi * rheight;}
      left := eleft;
      width := ewidth;
      height := eheight;
      if CCFldT[i] = 'boolean' then begin
        dw('  object ' + CCFldN[i] + 'Edit: TCheckBox');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        typ := 'TCheckBox';
      end else if {v0.22} typeFound{/v0.22 FindAttrib(a, pnType, av, false)} and
        ( (av = pvEnum)
          {v0.14} or (av = pvULEnum){/v0.14} {ulanobj\ulmfrmu}
        )
      then begin
        dw('  object ' + CCFldN[i] + 'Edit: TComboBox');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        {v0.14}
        dw('    Style = csDropDownList');
        typ := 'TComboBox';
        {/v0.14}
      end else {v0.22} if typeFound and (av = pvMemo) then begin
        editRowCount := MemoRowCount;
        height := eheight * editRowCount;
        dw('  object ' + CCFldN[i] + 'Edit: TMemo');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        typ := 'TMemo';
      end else if typeFound and (av = pvMethod) then begin
        editRowcount := 0;
      end else {v0.24} if typeFound and (av = pvFileName) then begin
        dw('  object ' + CCFldN[i] + 'Edit: TBtnEdit');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        dw('    Tag = ' + IntToStr(i));
        {dw('    ReadOnly = True');}
        typ := 'TBtnEdit';
      end else if typeFound and (av = pvDir) then begin
        dw('  object ' + CCFldN[i] + 'Edit: TBtnEdit');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        dw('    Tag = ' + IntToStr(i));
        {dw('    ReadOnly = True');}
        typ := 'TBtnEdit';
      end else{/v0.24}{v0.44}if typeFound and (av = pvSet) then begin
        dw('  object ' + CCFldN[i] + 'Edit: TBtnEdit');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        dw('    Tag = ' + IntToStr(i));
        {dw('    ReadOnly = True');}
        typ := 'TBtnEdit';
      end else{/v0.44}{/v0.22} begin
        dw('  object ' + CCFldN[i] + 'Edit: TEdit');
        dw('    Left = ' + IntToStr(left));
        dw('    Top = ' + IntToStr(top));
        dw('    Width = ' + IntToStr(width));
        dw('    Height = ' + IntToStr(height));
        dw('    TabOrder = ' + IntToStr(tabord));
        typ := 'TEdit';
      end;

      if (recdesc.Flds <> nil) and ((recdesc.Flds^[i].Flags and ffEnabled) = 0) then begin
        {if typ  = 'TEdit' then begin
          dw('    ReadOnly = True');
        end else}
        begin
          {v0.22}
          if editRowCount > 0 then
          {/v0.22}
            dw('    Enabled = False');
        end;
      end;{ulandef\ulmtype}
      {v0.14}
      if (recdesc.Flds <> nil) and ((recdesc.Flds^[i].Flags and ffReadOnly) <> 0) then begin
        {v0.22}
        if editRowCount > 0 then
        {/v0.22}
          dw('    ReadOnly = True');
      end;
      {/v0.14}

      {v0.22}
      if editRowCount > 0 then
      begin
        inc(tabord);
        dw('  end');
        top := top + rheight * editRowCount;
      end;
      {/v0.22
      inc(tabord);
      dw('  end');
      }
    end;
  end;

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

  dw('  object OKBtn: TButton');
  dw('    Left = ' + IntToStr(left));
  dw('    Top = ' + IntToStr(top));
  dw('    Width = ' + IntToStr(width));
  dw('    Height = ' + IntToStr(height));
  dw('    Caption = ' + '''' + '&OK' + '''');
  dw('    Default = True');
  dw('    ModalResult = 1');
  dw('    TabOrder = ' + IntToStr(tabord));
    inc(tabord);
  dw('  end');

  left := left + bwidth + bleft;

  dw('  object CancelBtn: TButton');
  dw('    Left = ' + IntToStr(left));
  dw('    Top = ' + IntToStr(top));
  dw('    Width = ' + IntToStr(width));
  dw('    Height = ' +  IntToStr(height));
  dw('    Caption = ' + '''' + '&Cancel' + '''');
  dw('    ModalResult = 2');
  dw('    TabOrder = ' + IntToStr(tabord));
    inc(tabord);
  dw('  end');

  if recdesc.ChildRecIDCount > 0 then begin
    left := left + bwidth + bleft;

    dw('  object ParamsBtn: TButton');
    dw('    Left = ' + IntToStr(left));
    dw('    Top = ' + IntToStr(top));
    dw('    Width = ' + IntToStr(width));
    dw('    Height = ' +  IntToStr(height));
    dw('    Caption = ' + '''' + '&Parameters' + '''');
    dw('    OnClick = ParamsBtnClick');
    dw('    TabOrder = ' + IntToStr(tabord));
    {  inc(tabord);}
    dw('  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');

  close(frdF);
  convfn := 'convert';{c:\PROGRA~1\Borland\Delphi4\Bin\convert';}
  {v1.01}
  {v0.46}
  cs := GetEnv('COMSPEC');
  if pos('CMD', Uppercase(cs)) > 0 then begin
    convfn := cs + ' /c ' + convfn;
  end else begin
   {convfn := cs + ' /c ' + convfn;}
  end;
  {/v0.46
  convfn := 'cmd /c ' + convfn;}
  {/v1.01
  convfn := 'cmd /c convert';}
  res := WinExec(StrPCopy(p,convfn + ' "' + DestDir + FCCFormDFMFileName + '"'), 0);
  if (res <= 31) then begin
    writeln(convfn + ' ' + DestDir + FCCFormDFMFileName + ' failed ' + IntToStr(res));
    readln;
  end;
end;

function TULObjRW.ParseLine: boolean;
var
  s,ats:string;
  i:integer;
begin
  ParseLine:= true;
  if inRecord then begin
    if pos(' end;', Line) <> 0 then begin
      inRecord := false;
      ParseLine := false;
    end else begin
      { Line = fieldname: fieldtype; }
      if inAttr then begin
        if GetAttributesLine(Line, '{<','>}', inAttr, s) then begin
          ats := Trim(CCFldA[CCFldA.Count - 1] + ' ' + s);
          CCFldA[CCFldA.Count - 1] := ats;
        end;
      end else begin
        i := pos(':', Line);
        if i <> 0 then begin
          s := Trim(copy(Line, 1, i - 1));
          if (s <> 'Head') and (s <> 'Info')
          then begin
            CCFldN.Add(s);
            s := Trim(copy(Line, i + 1, 255));
            GetAttributesLine(s, '{<','>}', inAttr, ats);
            s := copy(s, 1, length(s) - 1);
              { strip ';' }
            CCFldT.Add(s);
            CCFldA.Add(ats);
          end;
        end;
      end;
    end;
  end else begin
    if (pos('T' + FCCRecIDStr + 'Rec = packed record', Line) <> 0) or inAttr then begin
      if not inAttr then
        recattr := '';
      if GetAttributesLine(Line, '{<','>}', inAttr, s) then
        recattr := Trim(recattr + ' ' + s);
      if not inAttr then
        inRecord := true;
    end;
  end;
end;


procedure TULObjRW.ParseAttr;
var
  av, s: string;
  i, p: integer;
//  wrd: string;
//  colr: longint;

  procedure SetRecFlags(rf:longint; OnOff:boolean);
  begin
    if OnOff then
      recdesc.Flags := recdesc.Flags or rf
    else
      recdesc.Flags := recdesc.Flags and (not rf);
  end;

  procedure SetFieldFlag(var f:longint; ff:longint; OnOff:boolean);
  begin
    if OnOff then
      f := f or ff
    else
      f := f and (not ff);
  end;

  procedure ParseFieldAttrs(var AFld: TULFldDesc);
  var
    curFieldColors: TULFieldColors;
  begin
    with AFld{v0.24}{/v0.24 recdesc.Flds^[i]} do begin
      s := CCFldA[i];
      if FindAttrib(s, pnCaption, av, false) then
        Caption := av;
      if FindAttrib(s, pnHint, av, false) then
        Hint := av;
      if FindAttrib(s, pnEditWidth, av, false) then
        EditWidth := StrToInt(av);
      if FindAttrib(s, pnBrowseWidth, av, false) then
        BrowseWidth := StrToInt(av);
      if FindAttrib(s, pnUserCoef, av, false) then
        UserCoef := StrToFloat(FixDecSep(av));
      if FindAttrib(s, pnNumDec, av, false) then
        NumDec := StrToInt(av);
      if FindAttrib(s, pnEnabled, av, false) then begin
        SetFieldFlag(Flags, ffEnabled, (av='1'));
      end;
      {v0.22}
      {v0.31}
      if FindAttrib(s, pnNonVisible, av, false) and (av = '1') then begin
        SetFieldFlag(Flags, ffNonVisible, true);
      end else begin
        SetFieldFlag(Flags, ffToPrint, true);
      end;
      {/v0.31
      if FindAttrib(s, pnNonVisible, av, false) then begin
        SetFieldFlag(Flags, ffNonVisible, (av='1'));
      end;}
      {/v0.22}
      {v0.14}
      if FindAttrib(s, pnReadOnly, av, false) then begin
        SetFieldFlag(Flags, ffReadOnly, (av = '1'));
      end;
      {/v0.14}
      {v0.50}
      if FindAttrib(s, pnRequired, av, false) then begin
        SetFieldFlag(Flags, ffRequired, (av = '1'));
      end;
      {/v0.50}
      {v0.25}
      if FindAttrib(s, pnIsSortField, av, false) then begin
        SetFieldFlag(Flags, ffIsSortField, (av = '1'));
      end;
      {/v0.25}
      {v0.45}
      if FindAttrib(s, pnAutoInc, av, false) then begin
        SetFieldFlag(Flags, ffAutoInc, (av = '1'));
      end;
      {/v0.45}

      if FindAttrib(s, pnType, av, false) then begin
        if av = pvFileName then begin
          SetFieldFlag(Flags, ffFileName or ffReadOnly, true);
        end;
        {v0.50}{ulrectyp}
        if av = pvColor then begin
          SetFieldFlag(Flags, ffColor or ffReadOnly, true);
          SetRecFlags(rfUsingColors, true);
        end;
        {/v0.50}
        {v0.24}
        if av = pvDir then begin
          SetFieldFlag(Flags, ffDir or ffReadOnly, true);
        end;
        {/v0.24}
        {v0.14}
        if av = pvULEnum then begin
          SetFieldFlag(Flags, ffULEnum, true);
        end;
        if av = pvFileDateTime then begin
          SetFieldFlag(Flags, ffFileDateTime, true);
        end;
        {/v0.14}

        {v0.45}
        if av = pvDate then begin
          SetFieldFlag(Flags, ffDate, true);
        end;
        if av = pvTime then begin
          SetFieldFlag(Flags, ffTime, true);
        end;
        if av = pvDateTime then begin
          SetFieldFlag(Flags, ffDate or ffTime, true);
        end;
        {/v0.22}
        if av = pvMemo then begin
          SetFieldFlag(Flags, ffMemo, true);
        end;
        if av = pvMethod then begin
          SetFieldFlag(Flags, ffMethod, true);
        end;
        {/v0.22}
      end;
      {v0.14 moved above}{/v0.14
      if FindAttrib(s, pnType, av, false) then begin
        if av = pvFileDateTime then begin
          SetFieldFlag(Flags, ffFileDateTime, true);
        end;
      end;}
      {v0.14}
      if FindAttrib(s, pnValuesSourceRecID, av, false) then begin
        p := pos('ID', av);
        if p = (length(av) - 1) then begin
          av := copy(av, 1, p - 1);
        end;
        ValuesSourceRecID := StrToULRecID(av);
        {v0.22}
        SetRecFlags(rfHasPointer, true);
        {/v0.22}
      end;
      {/v0.14}

      {v0.23}
      if FindAttrib(s, pvWriteAlways, av, false) then begin
        SetFieldFlag(Flags, ffWriteAlways, true);
      end;
      if CCFldT[i] = 'TCommand' then
        SetFieldFlag(Flags, ffCommand, true);
      {/v0.23}

      {v0.23}
      if CCFldT[i] = 'TCommand' then
        SetFieldFlag(Flags, ffCommand, true);
      {/v0.23}

      {v0.24}
      if FindAttrib(s, pnColors, av, false) then begin
        FieldColorsListToFieldColors(av, curFieldColors, FieldColorCount);
        {
        fillchar(curFieldColors, sizeof(curFieldColors), 0);
        while ExtractWord([','], wrd, av) do begin
          if not IdentToColor(wrd, colr) then begin
            wrd := 'clBlack';
            colr := clBlack;
          end;
          curFieldColors[FieldColorCount, 0] := colr;

          if not ExtractWord([','], wrd, av) then begin
            wrd := 'clWhite';
          end;
          if not IdentToColor(wrd, colr) then
            colr := clWhite;
          curFieldColors[FieldColorCount, 1] := colr;

          inc(FieldColorCount);
          if FieldColorCount = ULMaxFieldColorCount then
            break;
        end;
        }
        if FieldColorCount > 0 then begin
          GetMem(FieldColors, sizeof(TULFieldColor) * FieldColorCount);
          Move(curFieldColors, FieldColors^, sizeof(TULFieldColor) * FieldColorCount);
          SetRecFlags(rfUsingColors, true);
        end;
      end;

      if FindAttrib(s, pnFilter, av, false) then begin
        Filter := av;
      end;
      if FindAttrib(s, pnDefDir, av, false) then begin
        DefDir := av;
      end;
      if FindAttrib(s, pnStripPrefix, av, false) then begin
        StripPrefix := av;
      end;
      {/v0.24}
      {v0.26}
      if FindAttrib(s, pnEditMask, av, false) then begin
        EditMask := av;
      end;
      {/v0.26}                 {ulanrecs.lst ulvltype}
      {v0.65}
      if FindAttrib(s, pnDefVal, av, false) then begin
        DefVal := av;
      end;
      {/v0.65}
      {v0.45}
      if FindAttrib(s, pnMaxID, av, false) then begin
        MaxID := StrToInt(av);
      end;
      {v0.47}{/v0.47
      if FindAttrib(s, pnDispPropName, av, false) then begin
        DispPropName := av;
      end;}
      {/v0.45}
      PasType := CCFldT[i];
    end;

    {v0.22}
    if pos('_Ptr', CCFldN[i]) > 0 then
      SetRecFlags(rfHasPointer, true);
    {/v0.22}
  end;

  {v0.48}
  procedure CreateCalcFields;
  var
    s: string;
    i: integer;
  begin
    for i := 0 to FCCCalcFields.Count - 1 do begin
      with recdesc.Flds^[i + CCFldA.Count] do begin
        av := FCCCalcFields[i];
        SetFieldFlag(Flags, ffCalcField, true);
        ExtractWord([','], FieldName, av);
        ExtractWord([','], KeyFieldName, av);
        ExtractWord([','], ListFieldName, av);
        ExtractWord([','], s, av);
        BrowseWidth := StrToInt(s);
      end;
    end;
  end;
  {/v0.48}

begin
  if recattr <> '' then begin
    with recdesc do begin
      if FindAttrib(recattr, pnCaption, av, false) then
        Caption := av;
      if FindAttrib(recattr, pnSortExp, av, false) then
        SortExp := av;
      if FindAttrib(recattr, pnUses, av, false) then
        usesStr := av;
      if FindAttrib(recattr, pnRootChild, av, false) then
        SetRecFlags(rfRootChild, (av = '1'));
      if FindAttrib(recattr, pnChildSorted, av, false) then
        SetRecFlags(rfChildSorted, (av = '1'));
      if FindAttrib(recattr, pnHasRecName, av, false) then
        SetRecFlags(rfHasRecName, (av = '1'));
      {v0.22}
      if FindAttrib(recattr, pnHasPointer, av, false) then
        SetRecFlags(rfHasPointer, (av = '1'));
      {/v0.22}
      {v0.24}
      if FindAttrib(recattr, pnUsingColors, av, false) then
        SetRecFlags(rfUsingColors, (av = '1'));
      {/v0.24}
      {v0.25}
      if FindAttrib(recattr, pnAskForSave, av, false) then{ulrectyp}
        SetRecFlags(rfAskForSave, (av = '1'));
      {/v0.25}
      if FindAttrib(recattr, pnDataChild, av, false) then begin
        SetRecFlags(rfDataChild, (av = '1'));
        if (Flags and rfDataChild) <> 0 then
         SetRecFlags(rfChildAllowed, true);
      end;
      if FindAttrib(recattr, pnTemporary, av, false) then
        SetRecFlags(rfTemporary, (av = '1'));
      if FindAttrib(recattr, pnEnabled, av, false) then
        SetRecFlags(rfEnabled, (av = '1'));
      {v1.03}
      if FindAttrib(recattr, pnEditModal, av, false) then
        SetRecFlags(rfEditModal, (av = '1'));
      {/v1.03}
      {v0.44}
      if FindAttrib(recattr, pnOwnMessageOnSelect, av, false) then
        SetRecFlags(rfOwnMessageOnSelect, (av = '1'));
      {/v0.44}
      {v0.23}
      if FindAttrib(recattr, pnBrowseModal, av, false) then
        SetRecFlags(rfBrowseModal, (av = '1'));
      {/v0.23}

      {v0.14}
{      if FindAttrib(recattr, pnReadOnly, av, false) then
        SetRecFlags(rfReadOnly, (av = '1'));}
      {/v0.14}
      if FindAttrib(recattr, pnVisible, av, false) then
        SetRecFlags(rfVisible, (av = '1'));
      if FindAttrib(recattr, pnFileDataStream, av, false) then
        SetRecFlags(rfFileDataStream, (av = '1'));
      if FindAttrib(recattr, pnBrowseOnEdit, av, false) then
        SetRecFlags(rfBrowseOnEdit, (av = '1'));
      if FindAttrib(recattr, pnSortedByNumber, av, false) then
        SetRecFlags(rfSortedByNumber, (av = '1'));
      if FindAttrib(recattr, pnEditFieldList, av, false) then
        EditFieldList := av;
      if FindAttrib(recattr, pnBrowseFieldList, av, false) then
        BrowseFieldList := av;
      {v0.22}
      if FindAttrib(recattr, pnMenuFieldList, av, false) then
        MenuFieldList := av;
      {/v0.22}
      {v0.23}
      if FindAttrib(recattr, pnBrowseChildRecIDs, av, false) then
        BrowseChildRecIDs := av;
      if FindAttrib(recattr, pnNameProp, av, false) then begin
        NameProp := av;
      end;
      {/v0.23}
      {v0.24}
      if FindAttrib(recattr, pnMainProp, av, false) then
        MainProp := av;
      if FindAttrib(recattr, pnDefDir, av, false) then
        DefDir := av;
      {/v0.24}
      {v0.25}
      if FindAttrib(recattr, pnOpenFilter, av, false) then
        OpenFilter := av;
      if FindAttrib(recattr, pnSaveFilter, av, false) then
        SaveFilter := av;
      {/v0.25}
      if FindAttrib(recattr, pnTable, av, false) then
        Table := av;
      if FindAttrib(recattr, pnIndexes, av, false) then
        Indexes := av;

      if FindAttrib(recattr, pnChildRecIDs, av, false) then begin
        Flags := (Flags or rfChildAllowed) and (not rfDataChild);
        ChildRecIDsStr := av;             {ulrectyp}
        i := 1;
        repeat
          s := FindWord([' ',','], av, i, true);
          if s = '' then
            break;
          inc(ChildRecIDCount);
        until false;
      end;
      {v0.47}
      FCCCalcFields.Clear;
      while FindAttrib(recattr, pnCalcField, av, true) do begin
        FCCCalcFields.Add(av);
      end;
      {/v0.47}
      FldCount := 0;{for now}
      Flds := nil;
    end;
  end;

  if CCFldA.Count > 0 then begin
    recdesc.FldCount := CCFldA.Count {v0.47}+ FCCCalcFields.Count{/v0.47};
    GetMem(recdesc.Flds, sizeof(TULFldDesc)* {v0.47}recdesc.FldCount{/v0.47 CCFldA.Count});
    FillChar(recdesc.Flds^, sizeof(TULFldDesc)* {v0.47}recdesc.FldCount{/v0.47 CCFldA.Count}, 0);
    for i := 0 to CCFldA.Count - 1 do begin
      ParseFieldAttrs(recdesc.Flds^[i]);
      {v0.47}recdesc.Flds^[i].FieldName := CCFldN[i];{/v0.47}
    end;
    {v0.47}

    {v0.48}
    CreateCalcFields;
    {/v0.48
    for i := 0 to FCCCalcFields.Count - 1 do begin
      with recdesc.Flds^[i + CCFldA.Count] do begin
        av := FCCCalcFields[i];
        SetFieldFlag(Flags, ffCalcField, true);
        ExtractWord([','], FieldName, av);
        ExtractWord([','], KeyFieldName, av);
        ExtractWord([','], ListFieldName, av);
      end;
    end;}
    {/v0.47}
  end;

  editflds.Clear;
  if recdesc.EditFieldList <> '' then begin
    p := 1;
    repeat
      av := FindWord([','], recdesc.EditFieldList, p, true);
      if av <> '' then begin
        editflds.Add(av);
      end else
        break;
    until false;
  end else begin
    for i := 0 to CCFldN.Count - 1 do begin
      {v0.22}
      if (recdesc.Flds^[i].Flags and ffNonVisible) = 0 then
      {/v0.22}
      editflds.Add(CCFldN[i]);
    end;
  end;

end;

function TULObjRW.GetCCFieldCount: integer;
begin
  Result := CCFldN.Count;{FCurRec.FieldCount;}
end;

procedure TULObjRW.CurChildCreateBegin;
var
  {rid: TULRecID;}
  i: integer;
begin
  i := pos('TYPE', UpperCase(SourceBaseFileName));
  FCCRecIDStr := UpperCase(copy(SourceBaseFileName, 1, i - 1));

  {v1.02}
  FCurRec := TULObjRWRec(Add(StrToULRecID(FCCRecIDStr)));
  {/v1.02
  FCurRec := Add(StrToULRecID(FCCRecIDStr));}

  FCCSrcFileName := UpperCase(SourceBaseFileName) + '.PAS';

  FCCObjTypeName := 'T' + FCCRecIDStr + 'Obj';
  FCCObjUnitFileName := FCCRecIDStr + 'OBJU.PAS';
  FCCObjUnitName := FCCRecIDStr + 'Obju';

  FCCFormTypeName := 'T' + FCCRecIDStr + 'Form';
  FCCFormUnitFileName := FCCRecIDStr + 'FRMU.PAS';
  FCCFormUnitName := FCCRecIDStr + 'Frmu';
  FCCFormDFMFileName := FCCRecIDStr + 'FRMU.TXT';

  usesStr := '';
  FCCFldN := TStringList.Create;
  FCCFldT := TStringList.Create;
  FCCFldA := TStringList.Create;
  editflds := TStringList.Create;
  {v0.47}
  FCCCalcFields := TStringList.Create;
  {/v0.47}
  recattr := '';
  FillChar(childrecids, sizeof(childrecids), 0);
  recdesc.ChildRecIDs := @childrecids;
  recdesc.Caption := '';
  recdesc.ChildRecIDsStr := '';
  recdesc.ChildRecIDCount := 0;
  recdesc.FldCount := 0;
  recdesc.Flds := nil;
  recdesc.SortExp := '';
  recdesc.Flags := 0;
  recdesc.EditFieldList := '';
  recdesc.BrowseFieldList := '';
  {v0.22}
  recdesc.MenuFieldList := '';
  {/v0.22}
  {v0.22}
  recdesc.BrowseChildRecIDs := '';
  recdesc.NameProp := '';
  {/v0.22}
  {v0.24}
  recdesc.MainProp := '';
  {/v0.24}
  {v0.25}
  recdesc.OpenFilter := '';
  recdesc.SaveFilter := '';
  {/v0.25}
  recdesc.Table := '';
  recdesc.Indexes := '';


  InInit;
  ObjInit;
  {v0.47}
  if ShouldCreateEditForms then
  {/v0.47}
  begin
    FrmInit;
    FrdInit;
  end;
end;

function TULObjRW.GetSourceBaseFileName: string;
begin
  Result := ExtractFileName(ChangeFileExt(FSourceFileName, ''));
end;

procedure TULObjRW.CurChildCreateEnd;
begin
  urecattr.Add(recattr);
  ParseAttr;

  InDone;

  ObjDone;
  {v0.47}
  if ShouldCreateEditForms then
  {/v0.47}
  begin
    FrdDone;
    FrmDone;
  end;

  editflds.Free;
  CCFldN.Free;
  CCFldT.Free;
  CCFldA.Free;
  {v0.47}
  CCCalcFields.Free;
  {/v0.47}
  if recdesc.FldCount > 0 then begin
    FreeMem(recdesc.Flds);
  end;

end;

procedure TULObjRW.MakeObj(fn:string);
begin
  FSourceFileName := fn;

  CurChildCreateBegin;
  try
    while not eof(FCCSrcFile) do begin
      readln(FCCSrcFile, Line);
      if not ParseLine then
        break;
    end;
  finally
    CurChildCreateEnd;
  end;
end;

procedure TULObjRW.MakeObjs(ListFn:string);
var
  f:text;
  s:string;
  i:integer;
  pref:string;
  fn:string;
begin
  ProjectPrefix := 'Ulan';
  fn := ExpandFileName(ListFn);
  FListFn := fn;
  SourceDir := ExtractFilePath(fn);
  DestDir := SourceDir;
  if UpperCase(copy(DestDir, length(DestDir) - 3, 3)) = 'DEF' then begin
    DestDir := copy(DestDir, 1, length(DestDir) - 4) + 'Obj\';
    try
      if not DirectoryExists(DestDir) then begin
        MkDir(DestDir);
        ioresult;
      end;
    except;
    end;
  end;
  fn := ExtractFileName(fn);
  i := pos('RECS', UpperCase(fn));
  if i > 0 then begin
    ProjectPrefix := copy(fn, 1, i - 1);
  end;
  {/v1.04}

  IncInit;
  try
    AssignFile(f, ListFn);
    Reset(f);
    try
      while not eof(f) do begin
        readln(f, s);
        ParseTypeFiles(s);
        ParseDatabase(s);

        if (s <> '') and (s[1] <> ' ') then begin
          i := pos(' ', s);
          if i <> 0 then begin
            pref := copy(s, 1, i - 1);
            ulst.add(pref);
            MakeObj(pref + 'Type');
          end;
        end;
      end;
    finally
      close(f);
    end;
    IncWrite;
  finally
    IncDone;
  end;
end;

procedure TULObjRW.Run(s: string);
begin
  if s = '' then
    exit;
  if s[1] = '@' then begin
    s := copy(s, 2, 255);
    MakeObjs(s);
  end else
    MakeObj(s);
end;

{v0.47}
destructor TULObjRW.Destroy;
begin
{  FCCFldN.Free;
  FCCFldT.Free;
  FCCFldA.Free;
  editFlds.Free;
  FCCCalcFields.Free;}
  inherited;               {amotype aacrtype}
end;
{/v0.47}

procedure TULObjRW.ParseDatabase(const ALine: string);
const
  df = 'DATABASE=';
var i:integer;
begin
  i := pos(df, ALine);
  if i = 0 then
    exit;
  FDatabase := trim(copy(ALine, i + length(df), length(ALine)));
end;

    { parse files defined in TYPEFILES=file1;file2;...   line }
procedure TULObjRW.ParseTypeFiles(const AFiles: string);
var
  i: integer;
  l: TStrings;
const
  tf = 'TYPEFILES=';
begin
  i := pos(tf, AFiles);
  if i = 0 then
    exit;
  l := TStringList.Create;
  try
    if not WinUtl.ParseLine([';'], copy(AFiles, i + length(tf), length(AFiles)), l) then
      exit;
    FConsts := TDict.Create;
    FTypes := TDict.Create;
    for i := 0 to l.Count - 1 do begin
      ParseTypeFile(AbsoluteFileName(SourceDir, l[i], ''), FConsts, FTypes);
    end;
    FConsts.SaveToFile(AbsoluteFileName(SourceDir, 'testconsts.log', ''));
    FTypes.SaveToFile(AbsoluteFileName(SourceDir, 'testtypes.log', ''));
  finally
    l.Free;
  end;
end;

procedure TULObjRW.SaveToAsc;
begin
  SaveToFile(ChangeFileExt(FListFn, '.ASC'));
end;

function TULObjRW.GetDatabase: string;
begin
  if FDatabase <> '' then
    Result := FDatabase
  else
    Result := FListFn;
end;

procedure TULObjRW.WriteDatabaseCreate;
var
  f: text;
  dbbase: string;
  reco, fldo: TULObj;
//  i,j: integer;
  rc: TULORObj absolute reco;
  fld: TULOFObj absolute fldo;
  prc: TULORObj;
  doms: TDict;
//  dom: string;
  hasGenerators: boolean;

  function hasTableRec: boolean;
  var i: integer;
  begin
    Result := false;
    for i := 0 to ChildCount - 1 do begin
      if TULORObj(Childs[i]).Table <> '' then begin
        Result := true;
        exit;
      end;
    end;
  end;

  procedure w(s:string);
  begin
    writeln(f, s);
  end;

  function findparent(ch: TULORObj; var pa: TULORObj): boolean;
  var i: integer;
  begin
    Result := false;
    for i := 0 to ChildCount - 1 do begin
      if pos(ch.TheRecIDStr + 'ID', TULORObj(Childs[i]).ChildRecIDsStr) > 0 then begin
        Result := true;
        pa := TULORObj(Childs[i]);
        exit;
      end;
    end;
  end;

  procedure writeGenerators;
  var i,j: integer;
  begin
    for i := 0 to ChildCount - 1 do begin
      reco := Childs[i];
      if (not findparent(rc, prc)) or (prc.Table = '') then
        continue;
      for j := 0 to reco.ChildCount - 1 do begin
        fldo := reco.Childs[j];
        if (fld.TheFlags and ffAutoInc) <> 0 then begin
            w('create generator gen_' + fld.FieldName + ';');// /*' + rc.TheRecIDStr + ' ' + rc.Table + '*/');
            hasGenerators:= true;
        end;
      end;
    end;
  end;

  function findSQLType(t: string; var st: string): boolean;
  var
    bt: string;
    i: integer;
    numst: string;
    numval, code: integer;
  begin
    Result := false;
    st := '';
    bt := t;
    repeat
      if pos('TDateTime', bt) = 1 then begin
        st := 'timestamp';
        Result := true;
        exit;
      end else if pos('(', bt) = 1 then begin
        st := 'integer';
        Result := true;
        exit;
      end else if pos('boolean', bt) = 1 then begin
        st := 'integer';
        Result := true;
        exit;
      end else if pos('single', bt) = 1 then begin
        st := 'float';
        Result := true;
        exit;
      end else if pos('word', bt) = 1 then begin
        st := 'integer';
        Result := true;
        exit;
      end else if pos('integer', bt) = 1 then begin
        if t <> 'integer' then begin
          st := 'integer';
          Result := true;
          exit;
        end else begin
          exit;
        end;
      end else if pos('string', bt) = 1 then begin
        st := 'varchar';
        i := pos('[', bt);
        if i <> 0 then begin
          numst := copy(bt, i + 1, 255);
          i := pos(']', numst);
          if i <> 0 then begin
            numst := copy(numst, 1, i - 1);
            val(numst, numval, code);
            if code <> 0 then begin
              numst := FConsts.Values[numst];
            end;
            st := st + '(' + numst + ')';
            Result := true;
            exit;
          end else begin
            st := st + '(255)';
            Result := true;
            exit;
          end;
        end else begin
          st := st + '(255)';
          Result := true;
          exit;
        end;
      end;
      if FTypes <> nil then begin
        bt := FTypes.Values[bt];
        if bt = '' then
          break;
      end else
        break;
    until false;

    if st = '' then begin
      Result := true;
      st := 'varchar(200)';
    end;
  end;

  procedure writeDomains;
  var i, j: integer;
    wr: TDict;
    sqlt: string;
  begin
    wr := TDict.Create;
    for i := 0 to ChildCount - 1 do begin
      reco := Childs[i];
      if (not findparent(rc, prc)) or (prc.Table = '') then
        continue;
      for j := 0 to reco.ChildCount - 1 do begin
        fldo := reco.Childs[j];
        if wr.Values[fld.PasType] = '' then begin
          if findSQLType(fld.PasType, sqlt) then begin
            w('create domain ' + fld.PasType + ' as ' + sqlt + ';');
          end;
          wr.Values[fld.PasType] := '*';
        end;
      end;
    end;
    wr.Free;
  end;

  procedure writeTables;
  var
    i, j: integer;
    line: string;//winutl
    ind, inds: string;
  begin
    for i := 0 to ChildCount - 1 do begin
      reco := Childs[i];
      if (not findparent(rc, prc)) or (prc.Table = '') then
        continue;

      inds := prc.Indexes;
      if not ExtractWord([' '], ind, inds) then
        ind := TULOFObj(reco.Childs[0]).FieldName;
      ind := StringReplace(ind, ';', ',', [rfReplaceAll]);
        {.. this is primary index exp - field(s)}

      w('create table ' + prc.Table + ' (');
      for j := 0 to reco.ChildCount - 1 do begin
        fldo := reco.Childs[j];
        line := '  ' + fld.FieldName + ' ' + fld.PasType;
        if ((fld.TheFlags and ffRequired) <> 0) or (pos(fld.FieldName, ind) <> 0) then
          line := line + ' not null';
        line := line + ',';
        w(line);
      end;

      w('  primary key (' + ind + ')');
      w(');');
      j := 1;
      while ExtractWord([' '], ind, inds) do begin
        ind := StringReplace(ind, ';', ',', [rfReplaceAll]);
        w('create index x_' + prc.Table + '_' + IntToStr(j) +
          ' on ' + prc.Table + '(' + ind + ');');
        inc(j);
      end;
      w('');
    end;
  end;

  procedure writeTriggers;
  var
    i, j: integer;
//    line: string;//winutl
//    ind, inds: string;
  begin
    if not hasGenerators then
      exit;
    w('set term ^ ;');
    for i := 0 to ChildCount - 1 do begin
      reco := Childs[i];
      if (not findparent(rc, prc)) or (prc.Table = '') then
        continue;
      for j := 0 to reco.ChildCount - 1 do begin
        fldo := reco.Childs[j];
        if (fld.TheFlags and ffAutoInc) <> 0 then begin
          w('create trigger set_' + fld.FieldName + ' for ' + prc.Table);
          w('active before insert position 0 as');
          w('begin');
          w('  if (new.' + fld.FieldName + ' is NULL) then');
          w('    new.' + fld.FieldName + ' = gen_id(gen_' + fld.FieldName +
            ', 1);');
          w('end ^');
          w('');
          w('create procedure get_gen_' + fld.FieldName + ' returns (avalue integer)');
          w('as');
          w('begin');
          w('  avalue = gen_id(gen_' + fld.FieldName + ', 1);');
          w('end ^');
          w('');
        end;
      end;

    end;

    w('commit work ^');
    w('set term ; ^');
  end;

begin
  if not hasTableRec then
    exit;
  dbbase := ChangeFileExt(Database,'');
  doms := TDict.Create;
  hasGenerators := false;
//  tblrecs := TDict.Create;
  AssignFile(f, AbsoluteFileName(SourceDir, dbbase + '_create.sql', ''));
  Rewrite(f);
  try
    w('set sql dialect 3;');
    w('create database ' + '''' + Database + '''' + ' user ' + '''' + 'sysdba' +
      '''' + ' password ' + '''' + 'masterkey' + '''' + ' default character set win1250;');
    w('');
    writeGenerators;
    w('');
    writeDomains;
    w('');
    writeTables;

    writeTriggers;

  finally
    CloseFile(f);
  end;
  doms.Free;
//  tblrecs.Free;


end;

{/TULObjRW.}
//winutl
end.
