unit ULObjTblUsru;{v0.48}

interface
uses
  SysUtils, Classes, Menus, Controls, DB, DBTables,
  ULRecTyp, ULObju, ULObjUsru, ULObjDBu, DBUtl, DBGridFrm,
  Language{v0.50},ULObjDes, GPTimeZone{/v0.50}{v0.61}, ObjList{/v0.61};

type
  {v0.61}
  TULObjTblUsr = class;
  TULObjTblUsrFields = class;

  TULObjTblUsrField = class(TObject)
  private
    FTblUsrFields: TULObjTblUsrFields;
    FField: TField;
    FFldDesc: TULObjFldDesc;
    procedure OnEnumGetText(Sender: TField; var Text: string; DisplayText: Boolean);
    procedure OnEnumSetText(Sender: TField; const Text: string);
  public
    constructor Create(AULObjTblUsrFields: TULObjTblUsrFields; AField: TField; AFldDesc: TULObjFldDesc); reintroduce;
    property Field: TField read FField;
    property FldDesc: TULObjFldDesc read FFldDesc;
  end;

  TULObjTblUsrFields = class(TObjList)
  private
    FTblUsr: TULObjTblUsr;
    FCalcFieldCount: integer;
    function GetUsrField(Index: integer): TULObjTblUsrField;
  public
    constructor Create(AULObjTblUsr: TULObjTblUsr); reintroduce;
    procedure FieldAdd(AField: TField; AFldDesc: TULObjFldDesc);
    function Find(AField: TField; var AUsrField: TULObjTblUsrField): boolean;
    property CalcFieldCount: integer read FCalcFieldCount;
    property UsrFields[Index: integer]: TULObjTblUsrField read GetUsrField; default;
  end;

  {/v0.61}

  TULObjTblUsr = class(TULObjUsr)
  private
    FTable: TTable;
    FForm: TDBGridForm;
    FTmpChild: TULObjUsr;
    FIsInSetText: boolean;
    {v0.61}
    FUsrFields: TULObjTblUsrFields;
      { list of TULObjTblUsrField, of fields that should eventually get
        special treatment; created automatically in TableFieldsCreated;
        can be modified in overriden method. }
    {/v0.61}
    function GetTmpChild: TULObjUsr;
    procedure DoOnMenuPopup(Sender: TObject);
    procedure DoOnFieldChanged(Sender: TObject);
      { called when field changed in browser; calls DoFieldChanged }
    {v0.61}
    procedure DoOnEditButtonClick(Sender: TObject);
      { called when ellipsis button in grid cell pressed (for SelectedField) }
    function GetUsrFields: TULObjTblUsrFields;
    {/v0.61}
    function GetTable: TTable;
  protected
    function GetChildRecID: TULRecID; virtual; abstract;
    procedure TableCreate(ATable: TTable); virtual;
      { create FieldDefs, IndexesDefs; called if table does not exists, after
        the call table will be created using the specified Defs;
        can be overriden to add some indexdefs }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoCalcFields(ADataSet: TDataSet); virtual;
    procedure DoFieldChanged(AField: TField); virtual;
      { called when field changed in browser from DoOnFieldChanged }
    procedure ChildDestroyed(AChild: TULObjUsr);override;
    function ChildObjAdd: TULObjUsr;
    procedure OnBooleanGetText(Sender: TField; var Text: string; DisplayText: Boolean);
    procedure OnBooleanSetText(Sender: TField; const Text: string);
    {v0.50}
    procedure OnDateTimeGetText(Sender: TField; var Text: string; DisplayText: Boolean);
    {v0.61}
    procedure OnDateTimeSetText(Sender: TField; const Text: string);
    {/v0.61}
    procedure OnFloatGetText(Sender: TField; var Text: string; DisplayText: Boolean);
    {procedure OnFloatSetText(Sender: TField; const Text: string);}
    {procedure OnEnumGetText(Sender: TField; var Text: string; DisplayText: Boolean);}
    {procedure OnEnumSetText(Sender: TField; const Text: string);}
    {/v0.50}
    procedure TableFieldsCreated; virtual;
      { called when Table.Fields created, after TableOpen;
        assigns ftBoolean fields OnGetText,OnSetText;
        call inherited if overriden; can scan fields and  assign OnGetTxt/SetText
        to other fields }
    {v0.61}
    procedure UsrFieldAdd(AField: TField; AFldDesc: TULObjFldDesc);
    {/v0.61}
  public
    procedure TableOpen; virtual;
    destructor Destroy; override;
    procedure Browse; override;
    procedure Save; override;
    procedure AddChildsToTable;

    property TmpChild: TULObjUsr read GetTmpChild;
    property Table: TTable read GetTable;
    {v0.61}
    property UsrFields: TULObjTblUsrFields read GetUsrFields;
    {/v0.61}
  end;

implementation

const
  FCurTblUsr: TULObjTblUsr = nil;

procedure TblUsrTableCreate(ATable: TTable);
{var
  added: boolean;}
begin
  if FCurTblUsr = nil then
    exit;
  FCurTblUsr.TableCreate(ATable);
end;

procedure TULObjTblUsr.TableCreate(ATable: TTable);
var added: boolean;
begin
  with ATable do begin
    // Next, describe the fields in the table
    added := false;
    try
      if ChildCount = 0 then begin
        ChildObjAdd;
        added := true;
      end;
      ULObjDescToTable(Childs[0].Obj.ObjDesc, ATable);
    finally
      if added then begin
        Childs[0].Free
      end;
    end;

    {with ATable.FieldDefs.Find('UsrID') do begin
      Required := true;
    end;}

    {
    with FieldDefs do
    begin
      with AddFieldDef do begin
        Name := 'UsrID';
        DataType := ftInteger;
        Required := true;
      end;
      with AddFieldDef do begin
        Name := 'UsrName';
        DataType := ftString;
        Required := true;
        Size := UsrNameLen;
      end;
    end;
    }
    //  Next, describe any indexes
    with IndexDefs do
    begin
      // Name := xx
      // Fields :=
      // Options :=

// TIndexOption = (ixPrimary, ixUnique, ixDescending, ixCaseInsensitive, ixExpression, ixNonMaintained);

      // The first index has no name because it is a Paradox primary key
      //Add('', 'UsrID', [ixPrimary, ixUnique]);
      //Add('UsrName', 'UsrName', [ixCaseInsensitive]);

    end;
  end;
end;

procedure TULObjTblUsr.TableOpen;
var
  c: TULObjUsr;
  added: boolean;
begin
  FCurTblUsr := Self;
  try {db dbtables}
    FTable := DBUtl .TableOpen(Self, ExtractFilePath(FileName){DataDir}, FileName, TblUsrTableCreate);

    added := false;
    if ChildCount = 0 then begin
      c := ChildObjAdd;
      added := true;
    end else
      c := Childs[0];

    try
      ULObjDescFieldsToTable(c.Obj.ObjDesc, FTable);
      TableFieldsCreated;
    finally
      if added then
        c.Free;
    end;
{language}
    FTable.AutoCalcFields := true;
    FTable.OnCalcFields := DoCalcFields;
    if ChildCount > 2 then begin
      { converting }
      ULObjChildsToTable(Obj, Table);
      Clear;
      Save;
    end;
  finally
    FCurTblUsr := nil;
  end;
end;

function TULObjTblUsr.ChildObjAdd: TULObjUsr;
begin
  Result := ChildAdd(nil, GetChildRecID, '');
end;

function TULObjTblUsr.GetTmpChild: TULObjUsr;
begin
  if FTmpChild = nil then
    FTmpChild := ChildObjAdd;
  Result := FTmpChild;
end;

procedure TULObjTblUsr.TableFieldsCreated;
var
  i: integer;
  f: TField;
  {v0.50}
  fd: TULObjFldDesc;
  {/v0.50}
begin
  for i := 0 to Table.Fields.Count - 1 do begin
    f := Table.Fields[i];
    {v0.50}
    fd := nil;
    TmpChild.Obj.ObjDesc.HasFldDesc(f.FieldName, fd);
    {/v0.50}
    if f.DataType = ftBoolean then begin
      f.OnGetText := OnBooleanGetText;
      f.OnSetText := OnBooleanSetText;
    end
    {v0.50}
    else if fd <> nil then begin
      if fd.IsDateOrTime then begin
        if fd.IsDateTime then begin
          if UserMode = umUser then begin
            f.OnGetText := OnDateTimeGetText;
            {v0.61}
            f.OnSetText := OnDateTimeSetText;
            {/v0.61}
          end;
        end;
        {f.OnSetText := OnDateTimeSetText;}
      end else if fd.IsFloat then begin
        f.OnGetText := OnFloatGetText;
        {f.OnSetText := OnFloatSetText;}
      end {v0.61} else begin
        UsrFieldAdd(f, fd);
      end {/v0.61};
    end;
    {/v0.50};
  end;
end;
{tdbgrid}
procedure TULObjTblUsr.Browse;
begin
  if FForm = nil then begin
    FForm := DataSetBrowse(Table);
    FForm.OnMenuPopup := DoOnMenuPopup;
    FForm.OnFieldChanged := DoOnFieldChanged;
      { called when field changed in browser }
    {v0.61}
    FForm.DBGrid.OnEditButtonClick := DoOnEditButtonClick;
    {/v0.61}
    FForm.FreeNotification(Self);
    ULObjToDBGrid(Obj, TmpChild.Obj, FForm.DBGrid);
  end else begin
    FForm.BringToFront;
  end;
end;

procedure TULObjTblUsr.AddChildsToTable;
begin
  ULObjChildsToTable(Obj, Table);
end;

procedure TULObjTblUsr.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if AComponent = FForm then
      FForm := nil;
  end;
end;

procedure TULObjTblUsr.DoCalcFields(ADataSet: TDataSet);
var
  uf: TULObjTblUsrField;
  i: integer;
begin
  {v0.61}
  if UsrFields.CalcFieldCount > 0 then begin
    ULObjTableRecToChildObj(Table, TmpChild.Obj);
    for i := 0 to UsrFields.Count - 1 do begin
      uf := UsrFields[i];
      if uf.FldDesc.IsCalcField then begin
        uf.Field.AsString := TmpChild.Obj.FindField(uf.FldDesc.Name).AsString;
      end;
    end;
  end;
  {/v0.61}
end;

procedure TULObjTblUsr.DoOnFieldChanged(Sender: TObject);
begin
  DoFieldChanged(TField(Sender));
end;

procedure TULObjTblUsr.DoFieldChanged(AField: TField);
begin

end;

procedure TULObjTblUsr.DoOnMenuPopup(Sender: TObject);
begin
  Obj.Actions.CurMenu := TMenu(Sender);
  FirstMenuActionNeeded;
  Obj.Actions.CurMenu := nil;
end;

destructor TULObjTblUsr.Destroy;
begin
  if FForm <> nil then begin
    FForm.OnMenuPopup := nil;
    {FForm.RemoveFreeNotification(Self);}
  end;
  if ChildCount > 0 then begin
    {i.e. has some temporary child objects; clear them}
    Clear;
    Save;
  end;
  {v0.61}
  FUsrFields.Free;
  {/v0.61}
  inherited;
end;

procedure TULObjTblUsr.OnBooleanGetText(Sender: TField; var Text: string; DisplayText: Boolean);
begin
  {if DisplayText then}
  if FIsInSetText then
    exit;
  begin
    Text := Sender.AsString;
    if (Text = '') then begin
      Text := GetTxt({#}'False')
    end else begin
      if upcase(Text[1]) in ['Y','T','1','A'] then
        Text := GetTxt({#}'True')
      else
        Text := GetTxt('False');
    end;
  end;
end;

procedure TULObjTblUsr.OnBooleanSetText(Sender: TField; const Text: string);
{var s: string;}
begin
  FIsInSetText := true;
  try
  if (Text = '') then begin
    Sender.AsString := 'False';
  end else begin
    if upcase(Text[1]) in ['Y','T','1','A'] then
      Sender.AsString := 'True'
    else
      Sender.AsString := 'False';
  end;
  finally
    FIsInSetText := false;
  end;
end;

{v0.61}
procedure TULObjTblUsr.OnDateTimeSetText(Sender: TField; const Text: string);
begin
  FIsInSetText := true;
  try
    if Text = '' then begin
      Sender.AsFloat := 0;
    end else begin
      Sender.AsFloat := UsrStrToStdDateTime(Text);
    end;
  finally
    FIsInSetText := false;
  end;
end;
{/v0.61}

{v0.50}
procedure TULObjTblUsr.OnDateTimeGetText(Sender: TField; var Text: string; DisplayText: Boolean);
{var
  fd: TULObjFldDesc;}
begin
  if FIsInSetText then
    exit;
  begin
    {v0.61}
    if Sender.AsFloat = 0 then begin
      Text := '';
    end else
    {/v0.61}
    begin
      Text := StdDateTimeToUsrStr(Sender.AsFloat);
    end;
  end;
end;

procedure TULObjTblUsr.OnFloatGetText(Sender: TField; var Text: string; DisplayText: Boolean);
var
  fd: TULObjFldDesc;
begin
  if FIsInSetText then
    exit;
  begin
    fd := TmpChild.Obj.ObjDesc.FindFldDesc(Sender.FieldName);
    if fd.BrowseWidth <> 0 then begin
      Text := FloatToStrF(Sender.AsFloat, ffFixed, fd.BrowseWidth, fd.NumDec);
      {ulrectyp}
    end else begin
      Text := Sender.AsString;
    end;
  end;
end;

{procedure TULObjTblUsr.OnFloatSetText(Sender: TField; const Text: string);
begin
  FIsInSetText := true;
  try
  finally
    FIsInSetText := false;
  end;
end;}

function TULObjTblUsr.GetTable: TTable;
begin
  if FTable = nil then
    TableOpen;
  Result := FTable;
end;

function TULObjTblUsr.Save;
begin
  inherited;
  if FTable <> nil then begin
    Table.Active := false;
    Table.Active := true;
  end;
end;

procedure TULObjTblUsr.ChildDestroyed(AChild: TULObjUsr);
begin
  if AChild = FTmpChild then
    FTmpChild := nil;
end;

{v0.61}
function TULObjTblUsr.GetUsrFields: TULObjTblUsrFields;
begin
  if FUsrFields = nil then
    FUsrFields := TULObjTblUsrFields.Create(Self);
  Result := FUsrFields;
end;

procedure TULObjTblUsr.UsrFieldAdd(AField: TField; AFldDesc: TULObjFldDesc);
begin
  UsrFields.FieldAdd(AField, AFldDesc);
end;

procedure TULObjTblUsr.DoOnEditButtonClick(Sender: TObject);
      { called when ellipsis button in grid cell pressed (for SelectedField) }
var
  f: TField;
  uf: TULObjTblUsrField;
  vs, ac: TULObj;

begin
  f := FForm.DBGrid.SelectedField;
  if f = nil then
    exit;
  if UsrFields.Find(f, uf) then begin
    if uf.FldDesc.IsULEnum then begin

      vs := TULObj(uf.FldDesc.ValuesSource);
      if vs.HasChildWithFieldUsrValue(f.FieldName, f.AsString, ac) then
        vs.ActiveChild := ac;
      if vs.BrowseForChild = mrOK then begin
        Table.Edit;
        f.AsString := vs.ActiveChild.FindField(f.FieldName).AsString;
        Table.Post;
      end; {ulobju}

    end;
  end;
end;
{/v0.61}

{/TULObjTblUsr.}

{TULObjTblUsrField.}
constructor TULObjTblUsrField.Create(AULObjTblUsrFields: TULObjTblUsrFields;
  AField: TField; AFldDesc: TULObjFldDesc);
begin
  inherited Create;
  FTblUsrFields := AULObjTblUsrFields;
  FField := AField;
  FFldDesc := AFldDesc;
  if FFldDesc.IsCalcField then
    inc(FTblUsrFields.FCalcFieldCount);
  if FFldDesc.IsEnum then begin
    FField.OnGetText := OnEnumGetText;
    FField.OnSetText := OnEnumSetText;
  end;
end;

procedure TULObjTblUsrField.OnEnumGetText(Sender: TField; var Text: string; DisplayText: Boolean);
begin
  if Sender = Field then begin
    Text := FldDesc.GridItems[Sender.AsInteger];
  end;
end;

procedure TULObjTblUsrField.OnEnumSetText(Sender: TField; const Text: string);
var i: integer;
begin
  if Sender = Field then begin
    i := FldDesc.GridItems.IndexOf(Text);
    if i >= 0 then
      Field.AsInteger := i;
  end;
end;

{/TULObjTblUsrField.}

{TULObjTblUsrFields.}
constructor TULObjTblUsrFields.Create(AULObjTblUsr: TULObjTblUsr);
begin
  inherited Create;
  FTblUsr := AULObjTblUsr;
end;

procedure TULObjTblUsrFields.FieldAdd(AField: TField; AFldDesc: TULObjFldDesc);
begin
  Add(TULObjTblUsrField.Create(Self, AField, AFldDesc));
end;

function TULObjTblUsrFields.GetUsrField(Index: integer): TULObjTblUsrField;
begin
  Result := TULObjTblUsrField(Items[Index]);
end;

function TULObjTblUsrFields.Find(AField: TField; var AUsrField: TULObjTblUsrField): boolean;
var i: integer;
begin
  Result := false;
  for i := 0 to Count - 1 do begin
    AUsrField := UsrFields[i];
    if AUsrField.Field = AField then begin
      Result := true;
      exit;
    end;
  end;
end;

{/TULObjTblUsrFields.}

end.
