unit DataFileu;{v0.64}{v0.66 really used}
{ Common ancestor for acquisition related data holding files:
  Spectrum . TAcqData and CalDatau . TCalData }
interface
uses
  Windows, Messages, SysUtils, Classes, {$IFNDEF CONSOLE} Forms, {$ENDIF}
  UtlType, Language,  {$IFNDEF CONSOLE} FileMenuHdl, {$ENDIF} Msgu,

  UlanType, UlanGlob, ULRecTyp, ULObju, ULFObju,
  ULAType, ULAObju, ULSQType, ULSQObju, ULADType, ULADObju, UDLRType, UDLRObju,
  UDLSType, UDLSObju, ULIType, ULIObju;

type
  { Exclusive owner of FULF object (root of all ULObj objects tree), exists
    only if FULF is non nil, gets destroyed automatically, if FULF destroyed. }
  TDataFile = class(TObject)
  private
    FIsInULFFree: boolean;
  protected
    { TULFObj root (all ULObj files have it); owner of data root objects in
      descendants (ULA, ULC); created by reading  FileName }
    FULF: TULFObj;
    { omCreate - creating (acquiring for TAcqData) data;
      omRead - reading (eventually modifying);
      omReadOnly - only reading data }
    FMode: TOpenMode;

    {$IFNDEF CONSOLE}
    FOwnerForm: TForm;
      { if non nil, then this form will destroy the data upon its destroying }
    {$ENDIF}

    { Set at the end of constructor true, prevents saving incorrectly read
      file during destroy }
    FCreatedOK: boolean;

    property CreatedOK: boolean read FCreatedOK write FCreatedOK;
    procedure WMAppMessage(var Message: TMessage); message WM_APPMESSAGE;
    procedure ObjUpdated(AObj: TULObj); virtual;
    procedure ObjDestroyed(AObj: TULObj); virtual;
    procedure ULFFree; virtual;
    procedure ULFCreate; virtual;
    procedure ULFCreated; virtual;
    function GetNonameFileName: string; virtual;
    { Calls GetNonameFileName by default. Can be changed to generate
      file names e.g. according to some mask, ... }
    function GetNewFileName: string; virtual;
    function GetFileExt: string; virtual; abstract;
    function GetTemplateExt: string; virtual; abstract;
    function IsAllowedExt(const AExt: string): boolean; virtual;
    function HasData: boolean; virtual; abstract;
    procedure DiscardData; virtual; abstract;
    function ShouldBeAutoSaved: boolean; virtual;
    {v0.69}
    { Called from constructor to set default values (independant to any
      other properties). }
    procedure SetDefaults; virtual;
    { Called when data loaded from file (to do eventual postprocessing). }
    procedure DataLoaded; virtual;
    {/v0.69}

    function GetFileName: string;
  public
    constructor Create(const AFileName: string; AMode: TOpenMode); virtual;
    { Closes current data/file, opens the file of AFileName or creates it. }
    procedure SetFileName(const AFileName: string; AMode: TOpenMode); virtual;
    { Just change ULF.FileName without any immediate saving (used after
      starting from template, when name of the file to be acquired
      is already known (AAA). Extension will be automatically be changed
      to .ULF }
    procedure ChangeFileName(const AFileName: string); virtual;
    { Saves current data to AFileName and set it as the current file. }
    procedure SaveTo(const AFileName: string); virtual;
    destructor Destroy; override;
    function CanClose: boolean; virtual;
    procedure CreateTemplate(const AFileName: string); virtual;
    { Calls ULF.Save. If FileName empty, raises exception. }
    procedure Save;
    {v0.67}
    { If FileName is emptpy or NONAME, calls Childs[0]. (or ULF.) FileSaveAs,
      otherwise ULF.Save. }
    function DoFileSave: boolean;
    {/v0.67}

    property ULF: TULFObj read FULF;
    property Mode: TOpenMode read FMode;
    {$IFNDEF CONSOLE}
    property OwnerForm: TForm read FOwnerForm write FOwnerForm;
    {$ENDIF}
    property FileExt: string read GetFileExt;
    property TemplateExt: string read GetTemplateExt;
    property FileName: string read GetFileName;
  end;

{$IFNDEF CONSOLE}
type
  TObjHandler = class(TObject)
    procedure ValuesSourceNeeded(Sender: TObject);
    procedure ChildCreated(Sender: TObject);
    procedure CheckIn(AObj: TULObj);
  end;

function ObjHandler: TObjHandler;
{$ENDIF}

implementation
uses
  Modulu;
  
{TDataFile.}
constructor TDataFile.Create(const AFileName: string; AMode: TOpenMode);
begin
  inherited Create;
  {v0.69}
  SetDefaults;
  {/v0.69}
  if AMode = omCreateTemplate then begin
    CreateTemplate(AFileName);
  end else begin
    SetFileName(AFileName, AMode);
  end;
  {v0.69}{/v0.69
  FMode := AMode;}
  FCreatedOK := true;
end;

procedure TDataFile.ULFCreate;
begin
  FULF := TULFObj.Create(nil);
end;

procedure TDataFile.ULFCreated;
begin
end;

procedure TDataFile.ULFFree;
begin
  FIsInULFFree := true;
  try
    FULF.Free;
    FULF := nil;
  finally
    FIsInULFFree := false;
  end;
end;

procedure TDataFile.CreateTemplate(const AFileName: string);
begin
  ULFFree;
  ULFCreate;
  ULFCreated;
  ULF.FileName := ChangeFileExt(AFileName, GetTemplateExt);
  {v0.69}
  DataLoaded;
  {/v0.69}
end;

//function TDataFile.GetFileExt: string;
//begin
//  Result := ULFExt;
//end;

//function TDataFile.GetTemplateExt: string;
//begin
//  Result := ULTExt;
//end;

function TDataFile.IsAllowedExt(const AExt: string): boolean;
begin
  Result := (UpperCase(AExt) = UpperCase(FileExt))
    {v0.67}or (UpperCase(AExt) = UpperCase(TemplateExt)){/v0.67};
end;

function TDataFile.GetNewFileName: string;
begin
  Result := GetNonameFileName;
end;

function TDataFile.GetNonameFileName: string;
begin
  Result := {v0.67}{/v0.67 DataDir + }'NONAME' + GetFileExt;
end;

procedure TDataFile.SetFileName(const AFileName: string; AMode: TOpenMode);
var
  e: string;
begin
  e := ExtractFileExt(AFileName);
  if AMode <> omCreate then begin
    if not FileExists(AFileName) then
      raise EFOpenError.Create(GetTxt({#}'Can not open file') + ' ' + AFileName);
    if not IsAllowedExt(e) then
      raise EInvalidFileExt.Create(GetTxt({#}'Invalid file extension') + ': ' + AFileName);
    ULFFree;
    ULFCreate;
    ULF.LoadFromFile(AFileName);
    if AMode = omReadOnly then
      ULF.ReadOnly := true;
    ULFCreated;
  end else begin
    if AFileName <> '' then begin
      // i.e. create file based on the template file
      if not IsAllowedExt(e) then
        raise EInvalidFileExt.Create(GetTxt({#}'Invalid file extension') + ': ' + AFileName);
      if not FileExists(AFileName) then
        raise ETemplateNotFound.Create(GetTxt({#}'Template Not Found') + ': ' + AFileName);
      ULFFree;
      ULFCreate;
      ULF.LoadFromFile(AFileName);
    end else begin
      ULFFree;
      ULFCreate;
    end;
    ULF.FileName := GetNewFileName;
    ULFCreated;
  end;
  FMode := AMode;
  {v0.69}
  DataLoaded;
  {/v0.69}
  {$IFNDEF CONSOLE}
  ObjHandler.CheckIn(ULF);
  {$ENDIF}
end;

procedure TDataFile.WMAppMessage(var Message: TMessage);
begin
  case Message.wParam of
    cmULObjUpdated: ObjUpdated(TULObj(Message.LParam));
    cmULObjDestroyed: ObjDestroyed(TULObj(Message.LParam));
  end;
//  inherited;
end;

procedure TDataFile.ObjUpdated(AObj: TULObj);
begin
end;

procedure TDataFile.ObjDestroyed(AObj: TULObj);
begin
  {v0.67}
  if (AObj = FULF) and (not FIsInULFFree) then begin
    FULF := nil;
    Free;
  end;
  {/v0.67}
end;

procedure TDataFile.ChangeFileName(const AFileName: string);
begin
  {v0.67}
  if AFileName = '' then begin
    ULF.FileName := GetNewFileName;
  end else
  {/v0.67}
  begin
    ULF.FileName := ChangeFileExt(AFileName, FileExt);
  end;
end;

procedure TDataFile.SaveTo(const AFileName: string);
{ Saves current data to AFileName and set it as the current file. }
var
  ext: string;
begin
  ext := UpperCase(ExtractFileExt(AFileName));
  if not IsAllowedExt(ext) then begin
    raise EInvalidFileExt.Create(GetTxt({#}'Unsupported file extension') + ': ' + AFileName);
  end else begin
    ULF.SaveToFile(AFileName);
  end;
end;

function TDataFile.ShouldBeAutoSaved: boolean;
begin
  Result := false;
  if (ULF = nil) then
    exit;
  if (ULF.FileName = '') then
    exit;
  if not ULF.Modified  then
    exit;
  if ULF.ReadOnly then
    exit;
  if not FCreatedOK then
    exit;
  Result := true;
end;

destructor TDataFile.Destroy;
begin
  if ShouldBeAutoSaved then
    Save;
  ULFFree;
  inherited;
end;

function TDataFile.CanClose: boolean;
begin
  Result := true;
  {$IFNDEF CONSOLE}
  if (ULF <> nil) then begin
    if (pos('NONAME', ULF.FileName) <> 0) then
    begin
      if HasData then begin
        if not FMH.SaveAs then begin
          if ShowMessage(GetTxt({#}'Discard data?'), smNoYes, 0) <> cmYes then begin
            Result := false;
          end else begin
            DiscardData;
          end;
        end;
      end else begin
        if ULF.Modified then begin
          if not FMH.SaveAs then begin
            if ShowMessage(GetTxt({#}'Discard changes?'), smNoYes, 0) <> cmYes then begin
              Result := false;
            end else begin
              ULF.Modified := false;
            end;
          end;
        end;
      end;
    end else begin
      if ULF.Modified then begin
        if ULF.ReadOnly then begin
          case ShowMessage(ULF.FileName + ' ' + GetTxt({#}'was opened Read Only but modified.') +
            ' ' + GetTxt({#}'Save to other file?'), smYesNoCancel, 0) of
            cmCancel: CanClose := false;
            cmYes: begin
              try
                if not FMH.SaveAs then begin
                  CanClose := false;
                end else begin
                  ULF.Modified := false;
                end;
              finally
              end;
            end;
            cmNo: ULF.Modified := false;
          end;
        end else begin
          case ShowMessage(ULF.FileName, smFileModifiedSave,0) of
            cmCancel: CanClose := false;
            cmNo: ULF.Modified := false;
          end;
        end;
      end;
    end
  end;
  {$ENDIF}
end;

function TDataFile.GetFileName: string;
begin
  Result := '';
  if ULF <> nil then
    Result := ULF.FileName;
end;

function TDataFile.DoFileSave: boolean;
var c: TULObj;
begin
  Result := false;
  if ULF = nil then
    exit;
  if ULF.ChildCount > 0 then begin
    c := ULF.Childs[0];
  end else begin
    c := ULF;
  end;
  Result := c.DoFileSave;{ulctype}
end;

procedure TDataFile.Save;
begin        //ulobju
  if ULF <> nil then
    ULF.Save;
end;

{v0.69}
procedure TDataFile.SetDefaults;
begin
end;

procedure TDataFile.DataLoaded;
begin
end;
{/v0.69}
{/TDataFile.}

{TObjHandler.}
{$IFNDEF CONSOLE}
procedure TObjHandler.CheckIn(AObj: TULObj);
var
  o: TULObj;
  i: integer;

begin
  if (AObj is TULADObj) then begin
    AObj.ObjDesc.OnValuesSourceNeeded := ValuesSourceNeeded;
  end else if (AObj is TUDLRObj) then begin
    AObj.ObjDesc.OnValuesSourceNeeded := ValuesSourceNeeded;
  end else if (AObj is TULAObj) or (AObj is TUDLSObj) {v0.66}or (AObj is TULFObj){v0.66} then begin
    AObj.ObjDesc.OnChildCreated := ChildCreated;
    for i := 0 to AObj.ChildCount - 1 do begin
      o := AObj.Childs[i];
      if (o.RecID = ULADID) or (o.RecID = UDLRID) then
        CheckIn(o);
      if o.RecID = ULIID then
        CheckIn(o.FindOrAdd(UDLSID, ''));
    end;
  end;
end;

procedure TObjHandler.ChildCreated(Sender: TObject);
begin
  if (Sender is TULADObj) or (Sender is TUDLRObj) then
    CheckIn(TULObj(Sender))
end;

procedure TObjHandler.ValuesSourceNeeded(Sender: TObject);
var
  obj, o: TULObj;
  devicef, valuef: TULObjField;
begin
  if (Sender is TULADObj) or (Sender is TUDLRObj) then begin
    obj := TULObj(Sender);
    valuef := obj.Fields[obj.MessageInfo];
    if valuef.FldDesc.Name = 'PropDesc' then begin
      devicef := Obj.FindField('DeviceName');
      if Modules.ULD.HasChildWithFieldUsrValue('DeviceName', devicef.AsUsrString, o) then
        valuef.FldDesc.ValuesSource := o;
    end;
  end;
end;

const
  FObjHandler: TObjHandler = nil;

function ObjHandler: TObjHandler;
begin
  if FObjHandler = nil then
    FObjHandler := TObjHandler.Create;
  Result := FObjHandler;
end;
{$ENDIF}
{/TObjHandler.}

end.
