unit ULFObju;
  { Top owner of all TULxxObj objects, TULObj descendants.
    Used to create the objects, load/save them from/to file
    and to edit them interactively in ULxxFrmu.TULxxForm forms.

    !!! kept in sync with \ULAN\UlanDef\UlanRecs.LST using MakeCom2.exe !!! }

interface
uses
  SysUtils, Classes,

  UtlType, {UlanType, }ULRecUtl, ULRecTyp, ULObju, PropUtl,
  {$IFNDEF CONSOLE}
  Forms, StdCtrls, Controls, Dialogs, Messages, Windows,

  ULBrowseFrm, ClipUtl, Clipbrd, ULObjDes,
  {v0.61}
  ULBrowseModalFrm,
  {/v0.61}
  {$ENDIF}
    {see ULREC.LST}
  {$I ULXUNLST.INC}
  ;

  {$I ULXCNT.INC}
{const
  ULRecIDCount = 6;
  ULRecIDs : array[0..ULRecIDCount - 1] of TULRecID =
    (ULIID, ULGCID, ULGFID, ULUID, ULMID, ULDID);
}

{v0.65}
type
  TULFRec = packed record
    Head: TULRecHead;
    Info: TULRecInfo;

    Version: integer;
  end;
  PULFRec = ^TULFRec;

const
  ULFFldCount = 1;
  ULFFldDescs: array[0..ULFFldCount - 1] of TULFldDesc = (
    (
     Caption: 'Version';
     Hint: 'Version of the ULF file format';
     EditWidth: 0;
     BrowseWidth: 0;
     Flags: 0;
     UserCoef: 0.00;
     NumDec: 0;
     ValuesSourceRecID: 0;
     FieldColorCount : 0;
     FieldColors : nil;
     Filter: '';
     DefDir: '';
     StripPrefix: '';
     EditMask: '';
     MaxID: 0;
     FieldName: 'Version';
     KeyFieldName: '';
     ListFieldName: ''
    )
  );

{/v0.65}
type

  TULFObj = class(TULObj)
  private
    {$IFNDEF CONSOLE}
    CurEditObj: TULObj;
    {$ENDIF}
    {v0.65}
    function GetVersion: integer;
    procedure SetVersion(AVersion: integer);
    {/v0.65}
  protected
    function CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj; override;
    {$IFNDEF CONSOLE}
    function EditObj(AObj: TULObj{v0.16}; Modal: boolean{/v0.16}):integer; override;
      { creates TForm descendant for given ARecID and returns Form.ShowModal
        result }
    function BrowseObj(AObj: TULObj):integer; override;
      { Browser for AObj's child records }
    {v0.18}
    function ObjCopyToClipboard(o: TULObj): boolean; override;
    function ObjCopyFromClipboard(o: TULObj): boolean; override;
    {/v0.18}
    {$ENDIF}
    function GetULRecDesc: PULRecDesc; override;
    function ULFindObjFn(AObj: TULObj; uf: TULRecFnID; var fn: TULRecFn):boolean;
    {v0.24}
    procedure DoOnCreate{v0.24}(ARecID: TULRecID){/v0.24};override;
    {/v0.24}
    {v0.31}
    {$IFNDEF CONSOLE}
    function ObjCopyToStreamInULObjFormat(o: TULObj; s: TStream): boolean;
    function ObjCopyToStreamInTXTFormat(o: TULObj; s: TStream): boolean;
    {$ENDIF}
    {/v0.31}
    {v0.65}
    function GetMinRecLen: integer; override;//ulaobju
    {/v0.65}
  public
    constructor Create(AOwner: TComponent); reintroduce;
    function GetULRecDescOf(ARecID: TULRecID): PULRecDesc; override;
    {v0.23}
    destructor Destroy;override;
    {/v0.23}
    {v0.25}
    function Clone: TULObj; override;
    {/v0.25}//ulprobju
  {v0.65}
  published
    property Version: integer read GetVersion write SetVersion;
  {/v0.65}
  end;

{v0.23}
{
  TULFKeeper = class(TList)
  public
    procedure CheckIn(AULFObj:TULFObj);
    procedure CheckOut(AULFObj:TULFObj);
    function FindByULObjPath(const AULObjPath: string; fo:TULRecFindOptions;
     var AObj: TULObj): boolean;
  end;
}
{v0.23}
procedure Test;

{$I ULFDESC.INC}

implementation
{v0.72}
uses
  ULObjUsrNodeu, ULObjUsrTreeFrm;
{/v0.72}

{TULFObj}
constructor TULFObj.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, ULFID);
  {v0.65}
  Version := ULObjFileVersion;
  {/v0.65}
  {v0.23}
  {v0.24 moved to DoOnCreate}
  {/v0.24
  ULFKeeper.CheckIn(TULObj(Self));}
  {/v0.23}
end;

{v0.24}
procedure TULFObj.DoOnCreate{v0.24}(ARecID: TULRecID){/v0.24};
begin
  inherited;
  ULFKeeper.CheckIn(TULObj(Self));
end;
{/v0.24}

function TULFObj.CreateObj(AOwner: TULObj; ARecID: TULRecID): TULObj;
var
  o{, c}: TULObj;
{  i: integer;}
{  ins:boolean;}

begin
  {o := nil;}
  case ARecID of
    {ULREC.LST}
    {$I ULXOCREA.INC}
    {
    ULBID : o := TULBObj.Create(AOwner);
    ULBRID : o := TULBRObj.Create(AOwner);
    ULDID : o := TULDObj.Create(AOwner);
    ULEID : o := TULEObj.Create(AOwner);
    ULGCID : o := TULGCObj.Create(AOwner);
    ULGFID : o := TULGFObj.Create(AOwner);
    ULIID : o := TULIObj.Create(AOwner);
    ULMID : o := TULMObj.Create(AOwner);
    ULPID : o := TULPObj.Create(AOwner);
    ULPRID : o := TULPRObj.Create(AOwner);
    ULUID : o := TULUObj.Create(AOwner);
    }
  else
    o := nil;
    SetResult(orInvalidRecID, 'Invalid RecID ' + ULRecIDToStr(ARecID));
    {o := TULObj.Create(nil, ARecID);}
  end;

  {v0.24 moved to ULObj, added InsertNextChild }
  {/v0.24
  if (AOwner <> nil) then begin
    if AOwner.IsFlagSet(rfChildSorted) then begin
      ins := false;
      for i := 0 to AOwner.ChildCount - 1 do begin
        c := AOwner.Childs[i];
        if o.GetSortStr < c.GetSortStr then begin
          AOwner.ChildList.Insert(i, o);
          ins := true;
          break;
        end;
      end;
      if not ins then
        AOwner.ChildList.Add(o);
    end else begin
      if AOwner.InsertNextChild then begin
        i := AOwner.ActiveChildIndex;
        if i >= 0 then
          AOwner.ChildList.Insert(i, o)
        else
          AOwner.ChildList.Add(o);
        AOwner.InsertNextChild := false;
      end else
      begin
        AOwner.ChildList.Add(o);
      end;
    end;
  end else begin
    SetResult(orMustHaveOwner,'Must have owner ' + IntToStr(ARecID));
  end;
  }

  CreateObj := o;
end;

function TULFObj.ULFindObjFn(AObj: TULObj; uf: TULRecFnID; var fn: TULRecFn):boolean;
{$IFNDEF CONSOLE}
var
  exen, procn: array[0..255] of char;
  suf: string;
  idstr:string;
begin                                                                                   
  Result := false;
  StrPCopy(exen, Application.ExeName);
  case uf of
    ufEdit: suf := 'EDIT';
  else
    exit;
  end;
  idstr := ULRecIDToStr(AObj.RecID);
  if idstr[length(idstr)] = #0 then
    idstr := copy(idstr, 1, length(idstr)-1);
  StrPCopy(procn, idstr + suf);
  @fn := GetProcAddress(GetModuleHandle(exen), procn);
  Result := Assigned(fn);
end;
{$ELSE}
begin
  Result := false;
end;
{$ENDIF}

{$IFNDEF CONSOLE}
function TULFObj.EditObj(AObj: TULObj{v0.16}; Modal: boolean{/v0.16}):integer;
var
  f: TForm;
  {
  c: TObject;
  pn, n: shortstring;
  v: string;
  i, j: integer;
  res: integer;}
  editfn: TULRecFn;
  ceditobj: TULObj;
{label ex;}
begin
  Result := mrCancel;
  ceditObj := CurEditObj;
  try
    if SendMessage(Application.MainForm.Handle, WM_APPMESSAGE, cmULObjBeforeEdit,
      longint(AObj)) <> 0 then
    begin
      exit;{goto ex;}
    end;
    if AObj.UsersNotify(cmULObjEditFormBringToFront) <> 0 then
      exit;
    {v0.09}
    if (Application.MainForm <> nil) then begin
      {v0.21}
      if not Modal then
      {/v0.21}
      begin
        f := Application.MainForm.ActiveMDIChild;
        if f <> nil then begin
          if f.WindowState = wsMaximized then
            f.WindowState := wsNormal;
          {v0.24}
          if fsModal in Screen.ActiveForm.FormState then
            Modal := true;
          {/v0.24}
        end;
      end;
    end;
    {/v0.09}

    if (AObj <> CurEditObj) {v0.24}{/v0.24 and (not AObj.JustCreated)} then begin
      { prevent infinite recursion if from exported ULxxEDIT method called again .Edit }
      CurEditObj := AObj;
      if ULFindObjFn(AObj, ufEdit, editfn) then begin
        Result := editfn(AObj);
        exit;{goto ex;}
      end;
    end;
    {f := nil;}
    CurULObj := AObj;

    {v0.72}
    if FUseTreeViews and (not Modal) then begin
      f := TULObjUsrTreeForm.Create(Application);
      TULObjUsrTreeForm(f).ULObjUsr := TULObjUsrNode.Create(nil, AObj, AObj.RecID);
    end else
    {/v0.72}
    begin
      f := AObj.ObjDesc.EditFormCreate(AObj);
    end;
    if f <> nil then begin
      Result := mrCancel;
      f.Caption := AObj.GetWindowCaption(f);
      if Modal then begin
        {v0.73}
        {f.FormStyle := fsStayOnTop;}
        {/v0.73}
        f.FormStyle := fsNormal;
        f.Visible := false;
        Result := f.ShowModal;{uledfrm}
        f.Free;
      end else begin
        if (Application.MainForm <> nil) and (Application.MainForm.FormStyle = fsMDIForm) then
        begin
          f.FormStyle := fsMDIChild;
        end;
        f.Show;
        f.BringToFront;
        Result := mrOK;
      end;
    end;
  finally
    {v0.48}
    AObj.NextEditEnableAll := false;
    {/v0.48}
    CurULObj := nil;
    CurEditObj := ceditObj;
  end;
end;

function TULFObj.BrowseObj(AObj: TULObj):integer;
var
  {v0.24}
  f: TULBrowseForm;
{  af: TForm;}
  modal:boolean;
  {/v0.24
  f: TBrowseForm;}
begin
  Result := mrCancel;
  CurULObj := AObj;
  try
    if AObj.UsersNotify(cmULObjBrowseFormBringToFront) = 0 then begin
      modal := false;
      if (Screen <> nil) and (Screen.ActiveForm <> nil) and
         (fsModal in Screen.ActiveForm.FormState)
      then
        modal := true;

      {v0.61}{/v0.61
      f := TULBrowseForm.Create(Application);
      BrowseObj := mrOK;}
      {v0.23}
      if AObj.IsFlagSet(rfBrowseModal) {v0.24} or modal{/v0.24} then begin
        {v0.61}
        f := TULBrowseModalForm.Create(Application);
        {v0.73}
        f.FormStyle := fsNormal;
        {/0.73}
        {/v0.61
        f.FormStyle := fsNormal;
        f.Visible := false;}
        CurULObj := nil;{aapgobju}
        Result := f.ShowModal;
        f.Free;
      end else
      {/v0.23}
      begin
        {v0.61}
        f := TULBrowseForm.Create(Application);
        Result := mrOK;
        {/v0.61}
        f.Show;{Modal;}
        {v0.24}
        f.BringToFront;
        {/v0.24}
      end;
    end;
  finally
    CurULObj := nil;{just to be sure, should be set nil in TBrowserForm.Create }
  end;
end;

{v0.18}
{v0.24 moved to ULRecTyp}
{/v0.24
const
  ULObjFormat = 'ULObjFormat';}

{v0.31}
function TULFObj.ObjCopyToStreamInULObjFormat(o: TULObj; s: TStream): boolean;
var
  so: TStreamOptions;
  fo: TULFObj;
  dch,sch: TULObj;
  i:integer;
begin
  fillchar(so, sizeof(so),0);
  fo := TULFObj.Create(nil);
  try
    {v0.50}
    o.CountFieldsLen(true);
    {/v0.50}
    for i := 0 to o.ChildCount - 1 do begin
      sch := o.Childs[i];
      if sch.IsFlagSet(rfSelected) then begin
        dch := fo.Add(sch.RecID);
        dch.Assign(sch);
      end;
    end;
    fo.SaveToStream(s, so);
    Result := true;
  finally
    fo.Free;
  end;
end;

function TULFObj.ObjCopyToStreamInTXTFormat(o: TULObj; s: TStream): boolean;
var
  ss: TStringStream;
  c: TULObj;
  cd: TULObjDesc;
  i: integer;
  fi: integer;
  fcnt: integer;
  line: string;
  fv: string;
begin
  ss := TStringStream.Create('');
  try
    for i := 0 to o.ChildCount - 1 do begin
      c := o.Childs[i];
      if c.IsFlagSet(rfSelected) then begin
        cd := c.ObjDesc;
        line := '';
        fcnt := cd.BrowseFieldCount;
        for fi := 0 to fcnt - 1 do begin
          if UserMode = umSysOp then begin
            fv := c.Fields[cd.BrowseFields[fi].ULIndex].AsString;
          end else begin
            fv := c.Fields[cd.BrowseFields[fi].ULIndex].AsUsrString;
          end;
          if line = '' then
            line := fv
          else
            line := line + #9 + fv;
        end;
        ss.WriteString(line + #13#10);
      end;
    end;
    ss.WriteString(#0);
    s.CopyFrom(ss, 0);
    Result := true;
  finally
    ss.Free;
  end;
end;
{/v0.31}

function TULFObj.ObjCopyToClipboard(o: TULObj): boolean;
var
  f: UINT;
  s: TMemoryStream;
{v0.31}{/v0.31
  so: TStreamOptions;
  fo: TULFObj;
  dch,sch: TULObj;
  i:integer;  }{v0.50}fs: TFileStream;{/v0.50}
begin
  Result := false;
  if o.ChildWithFlagCount(rfSelected) = 0 then begin
    Result := true;
    exit;
  end;
  {v0.31}
  Clipboard.Open;
  try
    Clipboard.Clear;
    s := TMemoryStream.Create;
    try
      if ObjCopyToStreamInULObjFormat(o, s) then begin
        {v0.50}
        try
          fs := TFileStream.Create('debugtoclip.dat', fmCreate);
          try
            s.Position := 0;
            fs.CopyFrom(s, s.Size);
          finally
            fs.Free;
            s.Position := 0;
          end;
          s.Position := 0;
        except
        end;
        {/v0.50}
        f := RegisterClipboardFormat(ULObjFormat);
        if f <> 0 then begin
          Result := StreamToClip(f, s) = 0;
          if Result then begin
            s.Size := 0;
            if ObjCopyToStreamInTXTFormat(o, s) then begin
              {f := RegisterClipboardFormat(CF_TEXT);}
              Result := StreamToClip(CF_TEXT, s) = 0;
            end;
          end;
        end;
      end;
    finally
      s.Free;
    end;
  finally
    Clipboard.Close;
  end;
  {/v0.31
  f := RegisterClipboardFormat(ULObjFormat);
  if f <> 0 then begin
    fillchar(so, sizeof(so),0);
    s := nil;
    fo := TULFObj.Create(nil);
    try
      for i := 0 to o.ChildCount - 1 do begin
        sch := o.Childs[i];
        if sch.IsFlagSet(rfSelected) then begin
          dch := fo.Add(sch.RecID);
          dch.Assign(sch);
        end;
      end;
      s := TMemoryStream.Create;
      fo.SaveToStream(s, so);
      Result := StreamToClip(f, s) = 0;
    finally
      s.Free;
      fo.Free;
    end;
  end;}
end;

(*
var
  f: UINT;
  s: TMemoryStream;
  mh: THandle;
  m: PByteArray;{ointer;}
  so: TStreamOptions;
  ssize, msize:longint;
  fo: TULFObj;
  dch,sch: TULObj;
  i:integer;
begin
  Result := false; {windows}

  if o.ChildWithFlagCount(rfSelected) = 0 then begin
    Result := true;
    exit;
  end;
  f := RegisterClipboardFormat(ULObjFormat);
  if f <> 0 then begin

    s := nil;
    fo := nil;
    mh := 0;
    m := nil;
    fillchar(so, sizeof(so),0);
    {so.Flags := sfOnlySelectedChilds;}
    Clipboard.Open;
    try
      fo := TULFObj.Create(nil);
      for i := 0 to o.ChildCount - 1 do begin
        sch := o.Childs[i];
        if sch.IsFlagSet(rfSelected) then begin
          dch := fo.Add(sch.RecID);
          dch.Assign(sch);
        end;
      end;

      s := TMemoryStream.Create;
      fo.SaveToStream(s, so);
      ssize := s.Size;
      mh := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, sizeof(ssize) + ssize);
      if mh = 0 then
        exit;
      m := GlobalLock(mh);
      if m = nil then
        exit;
      msize := GlobalSize(mh);
      FillChar(m^, msize, 0);
      move(ssize, sizeof(ssize), m^);
      move(s.Memory^, m^[sizeof(ssize)], ssize);
      GlobalUnlock(mh);
      Clipboard.SetAsHandle(f, mh);
      mh := 0;

      Result := true;
    finally
      Clipboard.Close;
      s.Free;
      if mh <> 0 then
        GlobalFree(mh);
      fo.Free;
    end;
  end;
end;
*)

function TULFObj.ObjCopyFromClipboard(o: TULObj): boolean;
var
  f: UINT;
  fo: TULFObj;
  srcch, ch: TULObj;
  s: TMemoryStream;
  so: TStreamOptions;
  i: integer;
  {v0.50}
  fs: TFileStream;
  {/v0.50}
begin
  Result := false;
  f := RegisterClipboardFormat(ULObjFormat);
  if f = 0 then
    exit;
  fo := nil;
  s := nil;
  FillChar(so, sizeof(so), 0);
  o.DoChangeLock;
  try
    s := TMemoryStream.Create;
    if ClipToStream(f, s) <> 0 then
      exit;
    {v0.50}
    try
      fs := TFileStream.Create('debugfromclip.dat', fmCreate);
      try
        s.Position := 0;
        fs.CopyFrom(s, s.Size);
      finally
        fs.free;
        s.Position := 0;
      end;
    except
    end;
    {/v0.50}
    fo := TULFObj.Create(nil);
    repeat
    until not fo.LoadFromStream(s, so, srcch);
    for i := 0 to fo.ChildCount - 1 do begin
      srcch := fo.Childs[i];
      if o.IsChildRecID(srcch.RecID) then begin
        ch := o.Add(srcch.RecID);
        ch.Assign(srcch);
      end;
      o.Sort;
    end;
    Result := true;
  finally
    o.DoChangeUnlock;
    s.Free;
    fo.Free;
  end;
end;

(*
var
  f: UINT;
  fo: TULFObj;
  srcch, ch: TULObj;
  s: TMemoryStream;
  mh: THandle;
  m: PByteArray;
  so: TStreamOptions;
  msize, ssize: longint;
  i: integer;
begin
  Result := false; {windows}
  f := RegisterClipboardFormat(ULObjFormat);
  if Clipboard.HasFormat(f) then begin
    mh := 0;
    m := nil;
    s := nil;
    fo := nil;
    fillchar(so, sizeof(so), 0);
    Clipboard.Open;
    try
      o.DoChangeLock;

      mh := Clipboard.GetAsHandle(f);
      m := GlobalLock(mh);
      msize := GlobalSize(mh);

      s := TMemoryStream.Create;
      move(m^, ssize, sizeof(ssize));
      s.WriteBuffer(m^[sizeof(ssize)], ssize);
      s.Position := 0;
      fo := TULFObj.Create(nil);
      repeat
      until not fo.LoadFromStream(s, so, srcch);
      for i := 0 to fo.ChildCount - 1 do begin
        srcch := fo.Childs[i];
        ch := o.Add(srcch.RecID);
        ch.Assign(srcch);
      end;
      Result := true;
    finally
      if m <> nil then
        GlobalUnlock(mh);
      s.Free;
      fo.Free;
      Clipboard.Close;
      o.DoChangeUnlock;
    end;
  end;
end;
*)
{/v0.18}
{$ENDIF}

function TULFObj.GetULRecDesc: PULRecDesc;
begin
  ULFRecDesc.Flds := @ULFFldDescs;
  ULFRecDesc.FldCount := ULFFldCount;
  Result := @ULFRecDesc;
end;

function TULFObj.GetULRecDescOf(ARecID: TULRecID): PULRecDesc;
begin
  case ARecID of
    {$I ULXRDESC.INC}
    {v0.65}
    ULFID: Result := GetULRecDesc;
    {/v0.65}
  else
    Result := nil;
  end;
end;

{v0.23}
destructor TULFObj.Destroy;
begin
  ULFKeeper.CheckOut(TULObj(Self));
  inherited Destroy;
end;
{/v0.23}

{v0.25}
function TULFObj.Clone: TULObj;
var f: TULFObj;
begin
  f := TULFObj.Create(nil);
  f.Assign(Self);
  f.FileName := FileName;
  Result := f;
end;
{/v0.25}

{v0.65}
function TULFObj.GetMinRecLen: integer;
begin
  Result := sizeof(TULFRec);
end;

function TULFObj.GetVersion: integer;
begin
  Result := PULFRec(Rec)^.Version;
end;

procedure TULFObj.SetVersion(AVersion: integer);
begin
  if PULFRec(Rec)^.Version <> AVersion then begin
    PULFRec(Rec)^.Version := AVersion;
    //DoChange;
  end;
end;
{/v0.65}
{/TULFObj.}

procedure Test;
const
  testfn = 'TEST.ULF';
  testfn2 = 'TEST2.ULF';
var
  f, f2: TULFObj;
{  o: TULObj;
   res: integer;}
  i:integer;
begin
  if not FileExists(testfn) then begin
    f := TULFObj.Create(nil);
    for i := 0 to f.ObjDesc.ChildRecIDCount - 1 do begin
      f.Add(f.ObjDesc.ChildRecIDs[i]);
    end;
    f.SaveToFile(testfn);
    f.Free;
  end;

  f := TULFObj.Load(testfn);

  f2 := TULFObj.Create(nil);
  f2.Assign(f);
  f2.SaveToFile(testfn2);
  {  o := f2.Add(ULBID);
     o.Add(ULBRID); }
  f2.Browse;
  {
  for i := 0 to ULRecIDCount - 1 do begin
    if f2.FindObj(ULRecIDs[i], foDefault, o) then begin
      if o.Edit = mrOK then
        res := mrOK
      else
        break;
    end;
  end;
  if res = mrOK then }
  f2.SaveToFile(testfn);
  f2.Free;
  f.Free;
end;

end.
