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.

    !!! keep in sync with ULREC.LST !!! }

interface
uses
  SysUtils, Classes,
  MyType, TVType,
  UlanType, ULRecUtl, ULRecTyp, ULObju, PropUtl,
  {$IFNDEF CONSOLE}
  Forms, StdCtrls, Controls, Dialogs, Messages, Windows,
  ShowMsg,
  ULBrowu, {v0.18} ClipUtl, Clipbrd,{/v0.18}
  {$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);
}

type
  TULFObj = class(TULObj)
  private
    {$IFNDEF CONSOLE}
    CurEditObj: TULObj;
    {$ENDIF}
  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;

  public
    constructor Create(AOwner: TComponent); reintroduce;
    function GetULRecDescOf(ARecID: TULRecID): PULRecDesc; override;
  end;

procedure Test;

{$I ULFDESC.INC}

implementation

{TULFObj}
constructor TULFObj.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, ULFID);
end;

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;
  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
      AOwner.ChildList.Add(o);
    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
      f := Application.MainForm.ActiveMDIChild;
      if f <> nil then begin
        if f.WindowState = wsMaximized then
          f.WindowState := wsNormal;
      end;
    end;
    {/v0.09}

    if (AObj <> CurEditObj) and (not AObj.IsFlagSet(rfJustCreated)) 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;
    case AObj.RecID of
      {ULREC.LST}
      {$I ULXFCREA.INC}
      {
      ULUID: f := TULUForm.Create(Application);
      ULIID: f := TULIForm.Create(Application);
      ULGCID: f := TULGCForm.Create(Application);
      ULGFID: f := TULGFForm.Create(Application);
      ULMID: f := TULMForm.Create(Application);
      ULDID: f := TULDForm.Create(Application);
      }
    end;
    if f <> nil then begin
      Result := mrCancel;
      {v0.16}
      if Modal then begin
        f.FormStyle := fsNormal;
        f.Visible := false;
        Result := f.ShowModal;
      end else
      {/v0.16}
      begin
        f.Show;{Modal;}
        Result := mrOK;
      end;
      (*
      try
        i := 0;
        f.Caption := AObj.ObjDesc.Caption;
        while ClassGetPropStr(AObj, i, pn, v) do begin
          n := pn + 'Edit';
          for j := 0 to f.ComponentCount - 1 do begin
            c := f.Components[j];
            if c is TEdit then begin
              with c as TEdit do begin
                if Name = n then
                  Text := v;
              end;
            end else if c is TComboBox then begin
              with c as TComboBox do begin
                if Name = n then begin
                  FillEnumNames(AObj, pn, Items);
                  Text := v;
                end;
              end;
            end else if c is TCheckBox then begin
              with c as TCheckBox do begin
                if Name = n then begin
                  Checked := (v = 'True');
                end;
              end;
            end;
          end;
          inc(i);
        end;
        res := f.ShowModal;
        {$IFDEF DEBUG}
        if AObj.CanDestroy then begin
          {i := 0;}
        end;
        {$ENDIF}
        if res = mrOK then begin
          for i := 0 to f.ComponentCount - 1 do begin
            c := TObject(f.Components[i]);
            if c is TEdit then begin
              with c as TEdit do begin
                n := copy(Name, 1, length(Name) - 4);
                v := Text;
                ClassSetPropStr(AObj, n, v);
              end;
            end else if c is TComboBox then begin
              with c as TComboBox do begin
                n := copy(Name, 1, length(Name) - 4);
                v := Text;
                ClassSetPropStr(AObj, n, v);
              end;
            end else if c is TCheckBox then begin
              with c as TCheckBox do begin
                n := copy(Name, 1, length(Name) - 4);
                if Checked then
                  v := 'True'
                else
                  v := 'False';
                ClassSetPropStr(AObj, n, v);
              end;
            end;
          end;
        end;
        Result := res;
      finally
        {$IFDEF DEBUG}
        AObj.UsersUpdate;
        {$ENDIF}
        SendMessage(Application.MainForm.Handle, WM_APPMESSAGE, cmULObjAfterEdit,
          longint(AObj));
        f.Free;
        {$IFDEF DEBUG}
        if AObj.CanDestroy then begin
          {i := 0;}
        end;
        {$ENDIF}
      end;
      *)
    end;
  finally
    CurULObj := nil;
{ex:}
    CurEditObj := ceditObj;
  end;
end;

function TULFObj.BrowseObj(AObj: TULObj):integer;
var f: TBrowseForm;
begin
  Result := mrCancel;
  CurULObj := AObj;
  try
    if AObj.UsersNotify(cmULObjBrowseFormBringToFront) = 0 then begin
      f := TBrowseForm.Create(Application);
      BrowseObj := mrOK;
      f.Show;{Modal;}
    end;
  finally
    CurULObj := nil;{just to be sure, should be set nil in TBrowserForm.Create }
    {f.Free;}
  end;
end;

{v0.18}
const
  ULObjFormat = 'ULObjFormat';

function TULFObj.ObjCopyToClipboard(o: TULObj): boolean;
var
  f: UINT;
  s: TMemoryStream;
  so: TStreamOptions;
  fo: TULFObj;
  dch,sch: TULObj;
  i:integer;
begin
  Result := false;
  if o.ChildWithFlagCount(rfSelected) = 0 then begin
    Result := true;
    exit;
  end;
  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;
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;
    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
  Result := @ULFRecDesc;
end;

function TULFObj.GetULRecDescOf(ARecID: TULRecID): PULRecDesc;
begin
  case ARecID of
    {$I ULXRDESC.INC}
  else
    Result := nil;
  end;
end;
{/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.
