{ Conversions TULObj / TTable }
unit ULObjDBu;{v0.48}
interface
uses
  SysUtils, Classes, TypInfo, Forms,

  DB, DBTables, DBCtrls, DBGrids,

  UtlType, WinUtl, Msgu, ULRecTyp, ULObju, ULObjDes, Language {v0.62}, ExeLogu{/v0.62};

{ Create FieldDefs structure of ATable according to AULObj Fields
  (i.e. ATable does not exists yet) }
procedure ULObjDescToTable(AObjDesc: TULObjDesc; ATable: TDataSet{TTable});

{ Appends AObjOwner child objects to ATable as records;
  (copies only values of those fields found also in ATable) }
procedure ULObjChildsToTable(AObjOwner: TULObj; ATable: TDataSet{TTable});

{ App records from ATable to the AObjOwner.Childs }
procedure TableToULObjChilds(ATable: TDataSet; AObjOwner: TULObj);

{ Copy values from current record of ATable to AChildObj }
procedure ULObjTableRecToChildObj(ATable: TDataSet{TTable}; AChildObj: TULObj);

{ Copy value from AChildObj to current record of ATable }
procedure ULObjChildObjToTableRec(AChildObj: TULObj; ATable: TDataSet{TTable});

{ Create Fields of (existing) ATable according to AObjDesc fields. Only
  if ATable.Fields.Count = 0. }
procedure ULObjDescFieldsToTable(AObjDesc: TULObjDesc; ATable: TDataSet{TTable});

{ Copies description specified in AChildObj.ObjDesc to ADBGrid Columns,
  eventually AOwnerObj.GetWindowCaption(AForm) to ADBGrid owner Form }
procedure ULObjToDBGrid(AOwnerObj: TULObj; AChildObj: TULObj; ADBGrid: TDBGrid);

implementation

procedure ULObjDescToTable(AObjDesc: TULObjDesc; ATable: TDataSet{TTable});
var
  i: integer;
  fd: TULObjFldDesc;
  {fn: integer;}
  tfd: TFieldDef;

  procedure CheckFD;
  begin
    if pos('_Ptr', fd.Name) > 0 then
      exit;{runtime assigned pointer field}
    if pos('_SrcPtr', fd.Name) > 0 then
      exit;{runtime assigned pointer field}
    if ATable.FieldDefs.IndexOf(fd.Name) >= 0 then
      exit;
    if fd.PropInfo = nil then         {tfielddef}
      exit;{calculated field}

    tfd := ATable.FieldDefs.AddFieldDef;
    with tfd do begin
      Name := fd.Name;
      {FieldNo := fn;
      inc(fn);}
      if fd.IsBoolean then begin {ulobjdes}
        DataType := ftBoolean;
      end else if fd.IsDateTime then begin
        DataType := ftDateTime
      end else if fd.IsTime then begin
        DataType := ftTime
      end else if fd.IsDate then begin
        DataType := ftDate
      end else begin
        case fd.TypeKind of
          tkInteger, tkEnumeration, tkSet: DataType := ftInteger;{typinfo}
          tkFloat : DataType := ftFloat;
          tkChar: begin
            DataType := ftString;
            Size := 1;
          end;
          tkLString: begin
            DataType := ftString;
            Size := fd.BrowseWidth;
            if Size = 0 then
              Size := 20;
          end;
        else
          {tkString: begin}
          DataType := ftString;
          Size := fd.DataSize;

          {if (Size = 0) and (fd.PropInfo = nil) then
            Size := fd.BrowseWidth;}
        end;
      end;
    end;
  end;

begin      {tfielddefs}
  with ATable do begin
    {FieldDefs.Clear;}
    {fn := 1;}
    for i := 0 to AObjDesc.FieldCount - 1 do begin
      fd := AObjDesc.Fields[i];
      CheckFD;
    end;
    {for i := 0 to AObjDesc.BrowseFieldCount - 1 do begin
      fd := AObjDesc.Fields[i];  // check eventual calculated fields
      CheckFD;
    end;}
  end;
end;

procedure ULObjChildsToTable(AObjOwner: TULObj; ATable: TDataSet{TTable});
  { Appends AObjOwner child objects to ATable }
var
  i{, j}: integer;
  c: TULObj;
  allcnt: integer;
  pb: TProgressBox;
begin
  allcnt := AObjOwner.ChildCount;
  pb := nil;
  if allcnt > 10 then
    ProgressBox(pb, pbShow, GetTxt({#}'Converting ULObj to Table'), 0, 0);

  try
    for i := 0 to AObjOwner.ChildCount - 1 do begin
      c := AObjOwner.Childs[i];
      ATable.Append; {findvalues}
      try
        ULObjChildObjToTableRec(c, ATable);
        ATable.Post;
      except
        ATable.Cancel;{v0.62}ExeLog.LogErr('ULObjChildsToTable Failed');{/v0.62}
        raise;
      end;
      if pb <> nil then
        ProgressBox(pb, pbUpdate, '', i + 1, allcnt);
    end;
  finally
    if pb <> nil then
      ProgressBox(pb, pbHide, '', 0, 0);
  end;
end;

procedure TableToULObjChilds(ATable: TDataSet; AObjOwner: TULObj);
var
  c: TULObj;
  r: TULRecID;
begin
  ATable.First;
  while not ATable.EOF do begin //ulobju
    r := AObjOwner.ObjDesc.ChildRecIDs[0];
    c := AObjOwner.Add(r);
    ULObjTableRecToChildObj(ATable, c);
    ATable.Next;
  end;
end;


procedure ULObjChildObjToTableRec(AChildObj: TULObj; ATable: TDataSet{TTable});
var
  j: integer;
  ofld: TULObjField;
  tfld: TField;
  c: TULObj absolute AChildObj;
  {v0.62}
  s: string;
  dt: TDateTime;
  {/v0.62}
begin
  for j := 0 to c.FieldCount - 1 do begin
    ofld := c.Fields[j];
    tfld := ATable.FindField(ofld.FldDesc.Name);
    if tfld <> nil then begin
      if ofld.FldDesc.IsBoolean then begin
        if tfld.DataType = ftBoolean then begin
          tfld.AsBoolean := boolean(ofld.AsInteger);
        end else begin
          tfld.AsInteger := ofld.AsInteger;
        end;
      end else if ofld.FldDesc.IsDateOrTime then begin
        if tfld is TDateTimeField then with tfld as TDateTimeField do begin
          {v0.62}
          s := ofld.AsString;
          dt := ofld.AsFloat;
          AsDateTime := dt;
          {/v0.62
          AsDateTime := ofld.AsFloat;}
        end;
      end else begin
        case ofld.FldDesc.TypeKind of
          tkInteger, tkEnumeration, tkSet: tfld.AsInteger := ofld.AsInteger;
          {tkFloat : DataType := ofld.AsFloat;}
        else
          tfld.AsString := ofld.AsString;
        end;
      end;
    end;
  end;
end;

procedure ULObjTableRecToChildObj(ATable: TDataSet{TTable}; AChildObj: TULObj);
  { Copy values from current record of ATable to AChildObj }
var
  j: integer;
  c: TULObj absolute AChildObj;
  ofld: TULObjField;
  tfld: TField;
begin
  for j := 0 to c.FieldCount - 1 do begin
    ofld := c.Fields[j];
    tfld := ATable.FindField(ofld.FldDesc.Name);
    if tfld <> nil then begin
      if ofld.FldDesc.IsBoolean then begin
        if tfld.DataType = ftBoolean then
          ofld.AsInteger := integer(tfld.AsBoolean)
        else
          ofld.AsInteger := tfld.AsInteger;
      end else if ofld.FldDesc.IsDateOrTime then begin
        if tfld is TDateTimeField then with tfld as TDateTimeField do
          ofld.AsFloat := AsDateTime;
      end else begin
        case ofld.FldDesc.TypeKind of
          tkInteger, tkEnumeration, tkSet: ofld.AsInteger := tfld.AsInteger;
          {tkFloat : DataType := ofld.AsFloat;}
        else
          ofld.AsString := tfld.AsString;
        end;
      end;
    end;
  end;
end;

{tcolumn}

procedure ULObjDescFieldsToTable(AObjDesc: TULObjDesc; ATable: TDataSet{TTable});
var
  wasAct: boolean;
  des: TDataSetDesigner;
  i: integer;
  fd: TULObjFldDesc;
  f: TField;
  tfd: TFieldDef;
begin
  if ATable.Fields.Count > 0 then
    exit;
  wasAct := ATable.Active;
  ATable.Active := false;
  try
    des := TDataSetDesigner.Create(ATable);
    try
      for i := 0 to ATable.FieldDefs.Count - 1 do begin
        with ATable.FieldDefs[i] do begin
          CreateField(ATable, nil, Name);
        end;
      end;

      for i := 0 to AObjDesc.FieldCount - 1 do begin
        fd := AObjDesc.Fields[i];
        if fd.PropInfo = nil then begin
          tfd := ATable.FieldDefs.AddFieldDef;
          try
            tfd.Name := fd.Name;
            tfd.DataType := ftString;
            tfd.Size := fd.BrowseWidth;
            f := tfd.CreateField(ATable, nil, fd.Name);
            f.Calculated := true;
          finally
            tfd.Free;
          end;
          {f := ATable.FieldByName(fd.Name);
          f.Calculated := true;}
          {f.DataSize := 20;{??}
          {tfield}
        end;
      end;
    finally
      des.Free;
    end;
  finally
    ATable.Active := wasAct;
  end;
end;

procedure ULObjToDBGrid(AOwnerObj: TULObj; AChildObj: TULObj; ADBGrid: TDBGrid);
  { Copies description specified in AChildObj.ObjDesc to ADBGrid Columns,
    eventually AOwnerObj.GetWindowCaption(AForm) to ADBGrid owner Form }
var
  i: integer;
  fd: TULObjFldDesc;
  f: TForm;
  c: TComponent;
  n: TDBNavigator;
  AOwnerObjDesc, AChildObjDesc: TULObjDesc;
  co: TColumn;
  flds: TStringList;
{  ds: TDataSet;
  wasAct:boolean;
  f:TField;
  c: TColumn;
  des: TDataSetDesigner;}

{ function ColumnFind(var c: TColumn): boolean;
  var i: integer;
  begin
    Result := false;
    for i := 0 to ADBGrid.Columns.Count - 1 do begin
      if fd.Name = ADBGrid.Columns[i].FieldName then begin
        Result := true;
        c := ADBGrid.Columns[i];
        break;
      end;
    end;
  end; }

begin
  if AChildObj = nil then
    exit;
  if AOwnerObj = nil then
    exit;
  if ADBGrid = nil then
    exit;
  AChildObjDesc := AChildObj.ObjDesc;
  AOwnerObjDesc := AOwnerObj.ObjDesc;

  ADBGrid.Options := ADBGrid.Options + [dgTitles];
  flds := TStringList.Create; // just list of field names; can be also names not present in BrowseFields[] ulobju
  try
    if AChildObjDesc.ULRecDesc^.BrowseFieldList = '' then begin
      for i := 0 to AChildObjDesc.FieldCount - 1 do begin
        flds.Add(AChildObjDesc.Fields[i].Name);
      end;
    end else begin
      ParseLine([','], AChildObjDesc.ULRecDesc^.BrowseFieldList, flds);
    end;

    ADBGrid.Columns.State := csCustomized;
    ADBGrid.Columns.Clear;// should be done just by changing the State in the above line
    for i := 0 to flds.count - 1 do begin
      AChildObjDesc.HasFldDesc(flds[i], fd);
      co := ADBGrid.Columns.Add;  //tcolumn
      //with do begin
        {tcolumn dbgrids}
        co.FieldName := flds[i];
        if fd <> nil then begin
          co.Title.Caption := StringReplace(fd.Caption, '_', ' ', [rfReplaceAll]);
          if length(co.Title.Caption) > 1 then begin
            if co.Title.Caption[1] = ' ' then
              co.Title.Alignment := taCenter;
          end;
          co.ReadOnly := not fd.Enabled;

          f := TForm(GetParentForm(ADBGrid));
          if f is TForm then begin //tpanel     tcolumn guiutl
            co.Width := f.Canvas.TextWidth(fd.Caption + '  ');
          end;

          if not co.ReadOnly then begin
            if fd.IsEnum then begin
              co.ButtonStyle := cbsAuto;
              co.PickList := fd.GridItems;
            end{v0.61} else if fd.IsULEnum then begin
              co.ButtonStyle := cbsEllipsis;
              {ADBGrid.OnEditButtonClick event should be assinged to something by ULObjUsr}
            end{/v0.61};
          end;
        end else begin
          { if no fd present for the field, then it must be readonly }
          co.Title.Caption := co.FieldName;
          co.ReadOnly := true;
        end;
      //end;
    end;

    if ADBGrid.Owner is TForm then begin
      f := TForm(ADBGrid.Owner);
      f.Caption := AOwnerObj.GetWindowCaption(f);

      n := nil;
      for i := 0 to f.ComponentCount - 1 do begin
        c := f.Components[i];
        if (c is TDBNavigator) and (TDBNavigator(c).DataSource = ADBGrid.DataSource) then begin
          n := TDBNavigator(c);
          break;
        end;
      end;

      if n <> nil then begin
        if UserMode = umUser then begin
          if (omChildAdd in AOwnerObjDesc.ExcludedMenuItems) then
            n.VisibleButtons := n.VisibleButtons - [nbInsert];{tbuttonset}
          if (omChildDelete in AOwnerObjDesc.ExcludedMenuItems) then
            n.VisibleButtons := n.VisibleButtons - [nbDelete];
          {[omHeader, omFocused, omGridOptions, omCopy, omSaveAs,
           omPaste, omDeleteSelected, omDeleteAll, omSort, omChildAdd, omChildInsert,
           omChildDelete, omChildFileSelect, omPrintOptions, omPrint];}
        end;
      end;

    end;

    {
    for i := 0 to ADBGrid.Columns.Count - 1 do
      ADBGrid.Columns[i].Visible := false;

    for i := 0 to AObjDesc.BrowseFieldCount - 1 do begin
      fd := AObjDesc.BrowseFields[i];
      if ColumnFind(c) then begin
        c.Title.Caption := fd.Caption;
        c.Visible := true;
        c.ReadOnly := not fd.Enabled;
      end;
    end;
    }
  finally
    flds.Free;
  end;
end;

end.
