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

type
  TULObjTblUsr = class(TULObjUsr)
  private
    FTable: TTable;
    FForm: TDBGridForm;
    FTmpChild: TULObjUsr;
    FIsInSetText: boolean;
    function GetTmpChild: TULObjUsr;
    procedure DoOnMenuPopup(Sender: TObject);
    procedure DoOnFieldChanged(Sender: TObject);
      { called when field changed in browser; calls DoFieldChanged }
    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);
    {procedure OnDateTimeSetText(Sender: TField; const Text: string);}
    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 }
  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;
  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
            f.OnGetText := OnDateTimeGetText;
        end;
        {f.OnSetText := OnDateTimeSetText;}
      end else if fd.IsFloat then begin
        f.OnGetText := OnFloatGetText;
        {f.OnSetText := OnFloatSetText;}
      end;
    end;
    {/v0.50};
  end;
end;

procedure TULObjTblUsr.Browse;
begin
  if FForm = nil then begin
    FForm := DataSetBrowse(Table);
    FForm.OnMenuPopup := DoOnMenuPopup;
    FForm.OnFieldChanged := DoOnFieldChanged;
      { called when field changed in browser }


    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);
begin
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;
  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.50}
procedure TULObjTblUsr.OnDateTimeGetText(Sender: TField; var Text: string; DisplayText: Boolean);
var
  fd: TULObjFldDesc;
begin
  if FIsInSetText then
    exit;
  begin
    Text := StdDateTimeToUsrStr(Sender.AsFloat);
  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;

{/TULObjTblUsr.}
end.
