program makecomp;
(*
  writeln('Usage: MakeComp xxxxTYPE | @ULREC.LST');
  writeln('Creates TxxObj object declaration/definition units xxxxOBJU.PAS');
  writeln('and objects' + '''' + ' editing form xxxxFRMU.PAS and xxxxFRMU.DFM');
  writeln('(use delphi convert program)');
  writeln('Using fields from "TxxxxRec = packed record" found in xxxxTYPE.PAS file ');
  writeln('xxxx is 1-4 uppercase chars. Ulan projects uses ULxx.');
  writeln('Generated sources use ULRecType.PAS, ULObju.PAS and IniObj.PAS');
*)
{ used for source files specified in ULREC.LST file }
uses
  SysUtils,
  Classes,
  Math,
  Windows,
  Stru,
  Attrib,
  AttrType,
  ULRecTyp
  {v1.01}
  ,WinUtl
  {/v1.01}
  {v0.14}
  ,ulrecutl
  {/v0.14}
  ;

const
  Version = '1.02';
  {1.01 floattostr accepts '.'}

var
  inN, objFn, frmFn, frdFn: string;
    { names of input file, output obj file, output frm file and frm resource (DFM) file }
  inF, objF, frmF, frdF: text;
    { correspondint text file variables }
  prefix, objN, objUn, frmN, frmUn: string;
    { = ULx, TULxObj, ULxObju, TULxForm, ULxFrmu }
  line: string;
    { current line from inn }
  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) }
  fldn: TStringList;
    { list of field names found in record }
  fldt: TStringList;
    { list of field pascal types found in record }
  flda: 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) }
  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 }

const
  inRecord:boolean = false;
    { parsing the record's fields? }
  inAttr:boolean = false;
    { parsing the record's or field's attributes? }

{include files for ULFOBJU.PAS; called only from MakeObjs }
var
  xu, xo, xf, xc, xd, xr: text;
  ulst: TStringList;{unit prefixes list}
  urecattr: TStringList;{rec attributes for units}
  fclst: TStringList;
    { list of root records (ulFid Childs) }

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

  assign(xu, 'ULXUNLST.INC');
  rewrite(xu);
  writeln(xu, s);

  assign(xo, 'ULXOCREA.INC');
  rewrite(xo);
  writeln(xo, s);

  assign(xf, 'ULXFCREA.INC');
  rewrite(xf);
  writeln(xf, s);

  assign(xc, 'ULXCNT.INC');
  rewrite(xc);
  writeln(xc, s);

  assign(xd, 'ULXRDESC.INC');
  rewrite(xd);
  writeln(xd, s);

  assign(xr, 'ULFDESC.INC');
  rewrite(xr);
  writeln(xr, s);

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

procedure 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;

    writeln(xu, '  ' + pref + 'Type, {$IFNDEF CONSOLE}' + pref + 'Frmu,{$ENDIF} ' + pref + 'Obju' + ch);

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

procedure IncDone;
begin
  urecattr.Free;
  ulst.Free;
  close(xu);
  close(xo);
  close(xf);
  close(xc);
  close(xd);
  close(xr);
end;
{/include files}

procedure InInit;
begin
  assign(inf, inn);
  reset(inf);
end;

procedure InDone;
begin
  close(inf);
end;

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

procedure ObjInit;
begin
  assign(objF, objFn);
  rewrite(objf);
end;

procedure ObjDone;
var
  i, j: integer;
  s, an, av: string;
  fval:string;
begin
  ow('unit ' + objUn + ';');
  ow('{ Generated by MakeComp ' + Version + ' from ' + inN +
   '. Don' + '''' + 't modify manually !!! }');
  ow('interface');
  ow('uses Classes, UlanType, ULRecTyp, ULObju, ');
  if usesStr <> '' then
    ow('  ' + usesStr + ',');
  ow('  ' + prefix + 'Type;');
  ow('');
  ow('type');
  ow('  ' + objn + ' = class(TULObj)');
  {
  ow('  private');
  for i := 0 to fldn.Count -1 do begin
    ow('    F' + fldn[i] + ': ' + fldt[i] + ';');
  end;
  }
  ow('  protected');
  for i := 0 to fldn.Count - 1 do begin
    ow('    function Get' + fldn[i] + ': ' + fldt[i] + ';');
    ow('    procedure Set' + fldn[i] + '(A'+ fldn[i] + ': ' +
      fldt[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 fldn.Count - 1 do begin
    ow('    property ' + fldn[i] + ': ' + fldt[i]);
    ow('      read Get' + fldn[i] + ' write Set' + fldn[i] + ';');
  end;
  ow('  end;');
  ow('');

  if recattr <> '' then begin
    with recdesc do begin
      ow('const');
      if recdesc.ChildRecIDCount > 0 then begin
        ow('  ' + prefix + '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;
      if recdesc.FldCount > 0 then begin
        ow('  ' + prefix + 'FldDescs: array[0..' + IntToStr(recdesc.FldCount - 1) +
         '] of TULFldDesc = (');
        for i := 0 to recdesc.FldCount - 1 do begin
          ow('    (');
          ow('     Caption: ' + '''' + recdesc.Flds^[i].Caption + '''' + ';');
          ow('     Hint: ' + '''' + recdesc.Flds^[i].Hint + '''' + ';');
          ow('     EditWidth: ' + IntToStr(recdesc.Flds^[i].EditWidth) + ';');
          ow('     BrowseWidth: ' + IntToStr(recdesc.Flds^[i].BrowseWidth) + ';');
          ow('     Flags: ' + IntToStr(recdesc.Flds^[i].Flags) + ';');
          fval := FloatToStrF(recdesc.Flds^[i].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(recDesc.Flds^[i].NumDec) + ';');
          {v0.14}
          if recDesc.Flds^[i].ValuesSourceRecID <> 0 then begin
            ow('     ValuesSourceRecID: ' + ULRecIDToStrStrip(recDesc.Flds^[i].ValuesSourceRecID) + 'ID' + '');
          end else begin
            ow('     ValuesSourceRecID: 0' + '');
          end;
          {/v0.14}
          if i = recdesc.FldCount - 1 then
            ow('    )')
          else
            ow('    ),');
        end;
        ow('  );');
      end;

      ow('  ' + prefix + 'RecDesc: TULRecDesc = (');
      ow('    Caption: ' + '''' + recdesc.Caption + '''' + ';');
      ow('    ChildRecIDsStr: ' + '''' + recdesc.ChildRecIDsStr + '''' + ';');
      if recdesc.ChildRecIDCount > 0 then begin
        ow('    ChildRecIDs: @' + prefix + '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: @' + prefix + 'FldDescs;');
      end else begin
        ow('    Flds: nil;');
      end;
      s := '';
      if (Flags and rfChildAllowed) <> 0 then
        s := s + 'rfChildAllowed + ';
      if (Flags and rfDataChild) <> 0 then
        s := s + 'rfDataChild + ';
      if (Flags and rfRootChild) <> 0 then begin
        fclst.Add(prefix + 'ID');
        s := s + 'rfRootChild + ';
      end;
      if (Flags and rfChildSorted) <> 0 then
        s := s + 'rfChildSorted + ';
      if (Flags and rfHasRecName) <> 0 then
        s := s + 'rfHasRecName + ';
      if (Flags and rfTemporary) <> 0 then
        s := s + 'rfTemporary + ';
      if (Flags and rfEnabled) <> 0 then
        s := s + 'rfEnabled + ';
      if (Flags and rfVisible) <> 0 then
        s := s + 'rfVisible + ';
      if (Flags and rfFileDataStream) <> 0 then
        s := s + 'rfFileDataStream + ';
      if (Flags and rfBrowseOnEdit) <> 0 then
        s := s + 'rfBrowseOnEdit + ';
      if (Flags and rfSortedByNumber) <> 0 then
        s := s + 'rfSortedByNumber + ';

      if s = '' then
        s := '0';
      while s[length(s)] in [' ','+'] do SetLength(s, length(s) - 1);
      ow('    Flags: ' + s + ';');
      ow('    SortExp: ' + '''' + SortExp + '''' + ';');
      ow('    EditFieldList: ' + '''' + EditFieldList + '''' + ';');
      ow('    BrowseFieldList: ' + '''' + BrowseFieldList + '''' + '');
      ow('   );');
      ow('');
    end;
  end;

  ow('implementation');
  ow('');
  ow('{' + objN + '}');
  ow('function ' + objN + '.GetMinRecLen: TULRecLen;');
  ow('begin');
  ow('  GetMinRecLen := sizeof(T' + prefix + 'Rec);');
  ow('end;');
  ow('');
  ow('constructor '+ objN + '.Create(AOwner: TULObj);');
  ow('begin');
  ow('  inherited Create(TComponent(AOwner), ' + prefix + 'ID);');
  s := recattr;
  while GetNextAttrib(s, an, av) do begin
    if pos('Create', an) = 1 then begin
      ow('  ' + av);
    end;
  end;
  ow('end;');
  ow('');
  if recattr <> '' then begin
    ow('function ' + objN + '.GetULRecDesc: PULRecDesc;');
    ow('begin');
    ow('  Result := @' + prefix + 'RecDesc;');
    ow('end;');
    ow('');
  end;

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

  for i := 0 to fldn.Count - 1 do begin
    ow('procedure ' + objN + '.Set' + fldn[i] + '(A' + fldn[i] + ': ' + fldt[i] + ');');
    ow('begin');
    ow('  if P' + prefix + 'Rec(Rec)^.' + fldn[i]+ ' <> A' + fldn[i] + ' then begin');
    ow('    P' + prefix + 'Rec(Rec)^.' + fldn[i]+ ' := A' + fldn[i] + ';');
    ow('    DoChange;');
    ow('  end;');
    ow('end;');
    ow('');
    ow('function ' + objN + '.Get' + fldn[i] + ': ' + fldt[i] + ';');
    ow('begin');
    ow('  Get' + fldn[i] + ' := P' + prefix + 'Rec(Rec)^.' + fldn[i] + ';');
    ow('end;');
    ow('');
  end;
  ow('{/' + objN + '}');
  ow('');
  ow('end.');
  close(objf);
end;

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

procedure FrmInit;
begin
  assign(frmF, frmFN);
  rewrite(frmF);
end;

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

  procedure DoFld(i:integer);
  begin
    fw('    ' + fldn[i] + 'Lbl: TLabel;');
    a := flda[i];
    if fldt[i] = 'boolean' then begin
      fw('    ' + fldn[i] + 'Edit: TCheckBox;');
    end else if (FindAttrib(a, pnType, av, false) and  ((av = pvEnum))
      {v0.14} or (av = pvULEnum) {/v0.14})
    then
    begin
      fw('    ' + fldn[i] + 'Edit: TComboBox;');
    end else begin
      fw('    ' + fldn[i] + 'Edit: TEdit;');
    end;
  end;

begin
  fw('unit ' + prefix + 'Frmu;');
  fw('{ Generated by MakeComp ' + Version + ' from ' + inN +
   '. Don' + '''' + 't modify manually !!! }');
  fw('interface');
  fw('');
  fw('uses');
  fw('  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,');
  fw('  IniObj, StdCtrls, ULObju, ULEdFrm;');
  fw('');
  fw('type');
  fw('  T' + prefix + 'Form = class(TULEditForm)');
  for p := 0 to editflds.Count - 1 do begin
    i := fldn.IndexOf(editflds[p]);
    if i >= 0 then
      DoFld(i)
    else begin
      writeln('Error: ' + prefix + ' 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('    ' + prefix + '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('  ' + prefix + 'Form: T' + prefix + 'Form;');
  fw('');
  fw('implementation');
  fw('{$R *.DFM}');
  fw('');
  if recdesc.ChildRecIDCount > 0 then begin
    fw('procedure T' + prefix + 'Form.ParamsBtnClick(Sender: TObject);');
    fw('begin');
    fw('  if Obj <> nil then');
    fw('    Obj.Browse;');
    fw('end;');
    fw('');
  end;
  fw('procedure T' + prefix + 'Form.FormCreate(Sender: TObject);');
  fw('begin');
{  fw('  Obj := CurULObj;');
  fw('  CurULObj := nil;');}
  fw('end;');
  fw('');
  fw('procedure T' + prefix + '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 dw(s:string);
begin
  writeln(frdF, s);
end;

procedure FrdInit;
begin
  assign(frdF, frdFn);
  rewrite(frdF);
end;

procedure FrdDone;
const
  compSize = 30;
    { what is the nonvisual component visual size during designing }
  fcheight = 24;
    { from caption height }
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 fldn }
  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;
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;

  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);
  fheight := ltop + editflds.Count * rheight + 2 * hdist + bheight + fcheight;{168}

  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 ' + prefix + 'Form: T' + prefix + 'Form');
  dw('  Left = ' + IntToStr(left));
  dw('  Top = ' + IntToStr(top));
  dw('  Width = ' + IntToStr(width));
  dw('  Height = ' + IntToStr(height));
  dw('  Caption = ' + '''' + prefix + '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');

  for pi := 0 to editflds.Count - 1 do begin
    i := fldn.IndexOf(editflds[pi]);
    if i >= 0 then begin
      left := lleft;
      top := ltop + pi * rheight;
      width := lwidth;
      height := lheight;
      dw('  object ' + fldn[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(fldn[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 = ' + fldn[i] + 'Edit');
      dw('  end');
    end;
  end;

  for pi := 0 to editflds.Count - 1 do begin
    i := fldn.IndexOf(editflds[pi]);
    if i >= 0 then begin
      left := eleft;
      top := etop + pi * rheight;
      width := ewidth;
      height := eheight;
      a := flda[i];
      if fldt[i] = 'boolean' then begin
        dw('  object ' + fldn[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 FindAttrib(a, pnType, av, false) and ((av = pvEnum)
        {v0.14} or (av = pvULEnum){/v0.14})
      then begin
        dw('  object ' + fldn[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 begin
        dw('  object ' + fldn[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
          dw('    Enabled = False');
        end;
      end;
      {v0.14}
      if (recdesc.Flds <> nil) and ((recdesc.Flds^[i].Flags and ffReadOnly) <> 0) then begin
        dw('    ReadOnly = True');
      end;

      {/v0.14}
        inc(tabord);
      {dw('    Text = ' + '''' + '''');}
      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 ' + prefix + 'FormIni: TIniObject');
  dw('    FormNameIsIniName = False');
  dw('    Disabled = True');
  dw('    Left = ' + IntToStr(left));
  dw('    Top = ' + IntToStr(top));
  dw('  end');
  dw('end');

  close(frdF);
  convfn := 'c:\PROGRA~1\Borland\Delphi4\Bin\convert';
  res := WinExec(StrPCopy(p,convfn + ' ' + frdFn), 0);
  if (res <= 31) then begin
    writeln(convfn + ' ' + frdFn + ' failed ' + IntToStr(res));
    readln;
  end;
end;

function 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(flda[flda.Count - 1] + ' ' + s);
          flda[flda.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
            fldn.Add(s);
            s := Trim(copy(Line, i + 1, 255));
            GetAttributesLine(s, '{<','>}', inAttr, ats);
            s := copy(s, 1, length(s) - 1);
              { strip ';' }
            fldt.Add(s);
            flda.Add(ats);
          end;
        end;
      end;
    end;
  end else begin
    if (pos('T' + prefix + '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 ParseAttr;
var
  av, s: string;
  i, p: integer;

  procedure SetFlags(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;
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
        SetFlags(rfRootChild, (av = '1'));
      if FindAttrib(recattr, pnChildSorted, av, false) then
        SetFlags(rfChildSorted, (av = '1'));
      if FindAttrib(recattr, pnHasRecName, av, false) then
        SetFlags(rfHasRecName, (av = '1'));
      if FindAttrib(recattr, pnDataChild, av, false) then begin
        SetFlags(rfDataChild, (av = '1'));
        if (Flags and rfDataChild) <> 0 then
         SetFlags(rfChildAllowed, true);
      end;
      if FindAttrib(recattr, pnTemporary, av, false) then
        SetFlags(rfTemporary, (av = '1'));
      if FindAttrib(recattr, pnEnabled, av, false) then
        SetFlags(rfEnabled, (av = '1'));
      {v0.14}
{      if FindAttrib(recattr, pnReadOnly, av, false) then
        SetFlags(rfReadOnly, (av = '1'));}
      {/v0.14}
      if FindAttrib(recattr, pnVisible, av, false) then
        SetFlags(rfVisible, (av = '1'));
      if FindAttrib(recattr, pnFileDataStream, av, false) then
        SetFlags(rfFileDataStream, (av = '1'));
      if FindAttrib(recattr, pnBrowseOnEdit, av, false) then
        SetFlags(rfBrowseOnEdit, (av = '1'));
      if FindAttrib(recattr, pnSortedByNumber, av, false) then
        SetFlags(rfSortedByNumber, (av = '1'));
      if FindAttrib(recattr, pnEditFieldList, av, false) then
        EditFieldList := av;
      if FindAttrib(recattr, pnBrowseFieldList, av, false) then
        BrowseFieldList := av;
      if FindAttrib(recattr, pnChildRecIDs, av, false) then begin
        Flags := (Flags or rfChildAllowed) and (not rfDataChild);
        ChildRecIDsStr := av;
        i := 1;
        repeat
          s := FindWord([' ',','], av, i, true);
          if s = '' then
            break;
          inc(ChildRecIDCount);
        until false;
      end;
      FldCount := 0;{for now}
      Flds := nil;
    end;
  end;

  if flda.Count > 0 then begin
    recdesc.FldCount := flda.Count;
    GetMem(recdesc.Flds, sizeof(TULFldDesc)* flda.Count);
    FillChar(recdesc.Flds^, sizeof(TULFldDesc)* flda.Count, 0);
    for i := 0 to flda.Count - 1 do begin
      with recdesc.Flds^[i] do begin
        s := flda[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.14}
        if FindAttrib(s, pnReadOnly, av, false) then begin
          SetFieldFlag(Flags, ffReadOnly, (av = '1'));
        end;
        {/v0.14}
        if FindAttrib(s, pnType, av, false) then begin
          if av = pvFileName then begin
            SetFieldFlag(Flags, ffFileName, true);
          end;
          {v0.14}
          if av = pvULEnum then begin
            SetFieldFlag(Flags, ffULEnum, true);
          end;
          if av = pvFileDateTime then begin
            SetFieldFlag(Flags, ffFileDateTime, true);
          end;
          {/v0.14}
        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);
        end;
        {/v0.14}
      end;
    end;
  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 fldn.Count - 1 do begin
      editflds.Add(fldn[i]);
    end;
  end;

end;

procedure MakeObj(fn:string);
var i: integer;
begin
  i := pos('TYPE', UpperCase(fn));
  prefix := UpperCase(copy(fn, 1, i - 1));
  inn := UpperCase(fn) + '.PAS';
  usesStr := '';

  objFn := prefix + 'OBJU.PAS';
  objN := 'T' + prefix + 'Obj';
  objUn := prefix + 'Obju';

  frmFn := prefix + 'FRMU.PAS';
  frmN := 'T' + prefix + 'Form';
  frmUn := prefix + 'Frmu';

  frdFn := prefix + 'FRMU.TXT';

  editflds := TStringList.Create;
  fldn := TStringList.Create;
  fldt := TStringList.Create;
  flda := TStringList.Create;


  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 := '';

  InInit;

  ObjInit;
  FrmInit;
  FrdInit;

  while not eof(inf) do begin
    readln(inf, Line);
    if not ParseLine then
      break;
  end;
  urecattr.Add(recattr);
  ParseAttr;

  InDone;

  ObjDone;
  FrdDone;
  FrmDone;

  editflds.Free;
  fldn.Free;
  fldt.Free;
  flda.Free;
  if recdesc.FldCount > 0 then begin
    FreeMem(recdesc.Flds);
  end;
end;

procedure MakeObjs(ListFn:string);
var
  f:text;
  s:string;
  i:integer;
  pref:string;
begin
  IncInit;
  assign(f, ListFn);
  reset(f);
  while not eof(f) do begin
    readln(f, 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;
  close(f);
  IncWrite;
  IncDone;
end;

procedure Help;
begin
  writeln('Usage: MakeComp xxxxTYPE');
  writeln('Creates TxxxxObj object declaration/definition units xxxxOBJU.PAS');
  writeln('and objects' + '''' + ' editing form xxxxFRMU.PAS and xxxFRMU.DFM');
  writeln('(Uses Delphi CONVERT.EXE program)');
  writeln('Using fields from "TxxxxRec = packed record" found in xxxxTYPE.PAS file.');
  writeln('xxxx is 1-4 uppercase chars. Ulan projects uses ULxx.');
end;


var s: string;
begin
  if paramcount = 0 then
    Help
  else begin
    s := paramstr(1);
    if s[1] = '@' then begin
      s := copy(s, 2, 255);
      MakeObjs(s);
    end else
      MakeObj(s);
  end;
  writeln('Press Enter to finish.');
  readln;
end.
