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

  DB, DBTables, DBCtrls, DBGrids,

  UtlType, Msgu, ULRecTyp, ULObju, ULObjDes, Language;

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

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

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

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

{ Create Fields of (existing) ATable according to AObjDesc fields }
procedure ULObjDescFieldsToTable(AObjDesc: TULObjDesc; ATable: 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: 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: 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;
        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 ULObjChildObjToTableRec(AChildObj: TULObj; ATable: TTable);
var
  j: integer;
  ofld: TULObjField;
  tfld: TField;
  c: TULObj absolute AChildObj;
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
        tfld.AsBoolean := boolean(ofld.AsInteger);
      end else if ofld.FldDesc.IsDateOrTime then begin
        if tfld is TDateTimeField then with tfld as TDateTimeField do
          AsDateTime := ofld.AsFloat;
      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: 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
        ofld.AsInteger := integer(tfld.AsBoolean);
      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: TTable);
var
  wasAct: boolean;
  des: TDataSetDesigner;
  i: integer;
  fd: TULObjFldDesc;
  f: TField;
  tfd: TFieldDef;
begin
  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;
{  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;
  AChildObjDesc := AChildObj.ObjDesc;
  AOwnerObjDesc := AOwnerObj.ObjDesc;
  if ADBGrid = nil then
    exit;
{  if ADBGrid.DataSource = nil then
    exit;
  ds := ADBGrid.DataSource.DataSet;
  if ds = nil then
    exit;}

  ADBGrid.Options := ADBGrid.Options + [dgTitles];

  ADBGrid.Columns.State := csCustomized;
  ADBGrid.Columns.Clear;
  for i := 0 to AChildObjDesc.BrowseFieldCount - 1 do begin
    fd := AChildObjDesc.BrowseFields[i];
    with ADBGrid.Columns.Add do begin
      {tcolumn dbgrids}
      FieldName := fd.Name;
      Title.Caption := fd.Caption;
      ReadOnly := not fd.Enabled;
      {v0.50}
      if not ReadOnly then begin
        if fd.IsEnum then begin
          ButtonStyle := cbsAuto;
          PickList := fd.GridItems;
        end{v0.61} else if fd.IsULEnum then begin
          ButtonStyle := cbsEllipsis;
          {ADBGrid.OnEditButtonClick event should be assinged to something by ULObjUsr}
        end{/v0.61};
      end;
      {/v0.50}
    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;
  }
end;

end.
