unit ULObjCtrl;{v0.23 Connector between TWinControl and TULObj properties,
  v0.24 - or properties of TULObj Users }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,
  ULRecTyp, ULObju, TypInfo, PropUtl;

type
  {v0.24}
  TDoAfterLoaded = (doObjToWin, doNothing, doWinToObj);
  {/v0.24}
  {v0.47}
  TDataDirection = (ddObjToWin, ddWinToObj);
  TDataDirections = set of TDataDirection;
  {/v0.47}

  EULObjCtrl = class(Exception);

  TULObjCtrl = class(TULObjBasicUsr)
  private
    { Private declarations }
    FWinCtrl: TWinControl;
      { pointer to window control, that should be connected
        with some ULObj's property }
    FWinCtrlPropName: string;
      { name of the published property of the FWinCtrl, that
        should be connected with ULObj property }
    FWinCtrlPropInfo: PPropInfo;
      { used to get/set value to WinCtrl property that is connected to
        ULObj property named FULObjPropName }
    FULObjPath: TULObjPath;
      { systemwide unique name of the ULObj object; assigned at design time,
        used to look it up at and assign to Obj runtime }
    FULObjPropName: TULObjPropName;
    FULObjField: TULObjField;
      { field that corresponds to Obj FULObjPropName }
    FInWinToObj: boolean;
      { recursion preventer }
    FInObjToWin: boolean;
      { recursion preventer }
    FUserCoef: extended;
      { number used to divide Obj value before assigning to Win property
        (if <> 0) and to multiply Win property before assigning to Obj value;
        Used only for WinCtrl properties of TypeKind = tkInteger, tkFloat }
    FIgnoreFindFail: boolean;
      { If true, no exception will be raised if FObj won't be found runtime.
        Only color of the WinCtrl will be set to red, if no connected object found. }
    {FObj: TULObj; inherited
      { pointer to the ulobj (assinged at runtime by searching objects
        in ULObj tree loaded from file (FULFileName), using FULObjName) }
    {v0.24}
    FDoAfterLoaded: TDoAfterLoaded;
    FULObjUsr: TObject;
    FULObjUsrPropInfo: PPropInfo;
      { if ULObjPropName not found in FObj (i.e.FULObjField is nil), then FObj
        users scanned for property if this name, if found, then this property
        will be connected (scans ALL users, stop scanning at first match, i.e.
        watch so that the property with given name has only in one user, or the
        user earlier registered).
        FObj cmULObjUpdated messages are still used to retrieve this user's
        property value. }
    FNumLen: integer;
    FNumDec: integer;
    {/v0.24}
    {v0.47}
    FDataDirections: TDataDirections;
    function ObjIsReadOnly: boolean;
    {/v0.47}
    {v0.52}
    procedure SetULObjPath(const AValue: TULObjPath);
    procedure DoLoaded;
    procedure FindObjFieldByPath;
    {/v0.52}
  protected
    { Protected declarations }
    procedure WinCtrlValueChanged(Sender: TObject);
      { will be assigned to WinCtrl On[WinCtrlPropName]Change event, so that the ULObj
        gets updated when the property named WinCtrlPropName of WinCtrl
        gets changed manually by user. Calls WinToObj. }
    procedure Loaded;override;
      { Finds the ULObj and WinCtrl PropInfo, raises exception if not found. }
    procedure SetResult(const msg:string);
      { raise exception with given msg }
    procedure ObjUpdated;override;
      { Calls ObjToWin }
    procedure ObjToWin;{update property value from Obj to WinCtrl}
    procedure WinToObj;{update property value from WinCtrl to Obj}
    procedure UpdateColor;
  public
    { Public declarations }
  published
    { Published declarations }
    property ULObjPath: string read FULObjPath write {v0.52}SetULObjPath{/v0.52 FULObjPath};
    property ULObjPropName: string read FULObjPropName write FULObjPropName;
    property WinCtrl: TWinControl read FWinCtrl write FWinCtrl;
    property WinCtrlPropName: string read FWinCtrlPropName write FWinCtrlPropName;
    property UserCoef: extended read FUserCoef write FUserCoef;
    property IgnoreFindFail: boolean read FIgnoreFindFail write FIgnoreFindFail;
    property DoAfterLoaded: TDoAfterLoaded read FDoAfterLoaded write FDoAfterLoaded;
    property NumLen: integer read FNumLen write FNumLen;
    property NumDec: integer read FNumDec write FNumDec;
    {v0.47}
    property DataDirections: TDataDirections read FDataDirections write FDataDirections;
    {/v0.47}
  end;

procedure Register;

implementation

procedure TULObjCtrl.WinCtrlValueChanged(Sender: TObject);
      { will be assigned to WinCtrl OnChange  event, so that the ULObj
        gets updated when the property named WinCtrlPropName of WinCtrl
        gets changed manually by user }
begin
  if FInObjToWin then
    exit;
  WinToObj;
end;

procedure TULObjCtrl.UpdateColor;
{v0.52}
var
  c: TColor;
begin
  if Obj = nil then
    c := clRed
  else
    c := clWhite;
  if WinCtrl is TEdit then begin
    TEdit(WinCtrl).Color := c;
  end else if WinCtrl is TPanel then begin
    TPanel(WinCtrl).Color := c;
  end;
end;
{/v0.52
var
  warnColor: TColor;
begin
  if Obj = nil then begin
    warnColor := clRed;
    if WinCtrl is TEdit then begin
      TEdit(WinCtrl).Color := warnColor;
    end else if WinCtrl is TPanel then begin
      TPanel(WinCtrl).Color := warnColor;
    end;
  end;
end;   }

procedure TULObjCtrl.Loaded;
var
{  o: TULObj;}
  s: string;
  m: TMethod;
begin
  inherited Loaded;
  if csDesigning in ComponentState then
    exit;
  try
    {v0.47}
    if DataDirections = [] then
      DataDirections := [ddObjToWin];
    {/v0.47}
    {o := nil;}
    if WinCtrl = nil then
      SetResult('WinCtrl not assigned');
    if WinCtrlPropName = '' then
      SetResult('WinCtrlPropName not assigned');
    if not ClassGetPropInfo(WinCtrl, WinCtrlPropName, FWinCtrlPropInfo) then
      SetResult('WinCtrlPropName ' + WinCtrlPropName + ' not found in ' +
        WinCtrl.Name);
    {proputl}
    if ULObjPropName = '' then
      SetResult('ULObjPropName not assigned');
    if ULObjPath = '' then begin
      {v0.52}
      if not FIgnoreFindFail then
      {/v0.52}
        SetResult('ULObjPath not assigned');
    end;

    {v0.52}
    FindObjFieldByPath;
    {/v0.52
    if not ULFKeeper.FindByULObjPath(ULObjPath, 0, o) then begin
      if not FIgnoreFindFail then begin
        SetResult('ULObjPath ' + ULObjPath + ' not found');
      end;
    end;

    if o <> nil then begin
      Obj := o;
      if not Obj.HasField(ULObjPropName, FULObjField) then begin
        if not Obj.HasUsrWithProp(ULObjPropName, FULObjUsr, FULObjUsrPropInfo) then
          SetResult('ULObjPropName ' +  ULObjPropName + ' not found in ULObj or its Usrs');
      end;
      // as FindField, but not an error if not found
    end else begin
      UpdateColor;
    end;
    }

    s := 'On' + WinCtrlPropName + 'Change';
    if ClassGetMethod(WinCtrl, s, m) then begin
      TNotifyEvent(m) := WinCtrlValueChanged;
      ClassSetMethod(WinCtrl, s, m);
    end else begin
      s := 'OnChange';
      if ClassGetMethod(WinCtrl, s, m) then begin
        TNotifyEvent(m) := WinCtrlValueChanged;
        ClassSetMethod(WinCtrl, s, m)
      end{v0.44} else begin
        s := 'OnClick';
        if ClassGetMethod(WinCtrl, s, m) then begin
          TNotifyEvent(m) := WinCtrlValueChanged;
          ClassSetMethod(WinCtrl, s, m)
        end;
      end{/v0.44};
    end;

    {v0.52}
    DoLoaded;
    {/v0.52
    UpdateColor;

    case FDoAfterLoaded of
      doWinToObj: WinToObj;
      doObjToWin: ObjToWin;
    end;
    }
  except
  end;
end;

{v0.52}
procedure TULObjCtrl.FindObjFieldByPath;
var
  o: TULObj;
begin
  o := nil;
  if not ULFKeeper.FindByULObjPath(ULObjPath, 0, o) then begin
    if not FIgnoreFindFail then begin
      SetResult('ULObjPath ' + ULObjPath + ' not found');
    end;
  end;

  if o <> nil then begin
    Obj := o;
    if not Obj.HasField(ULObjPropName, FULObjField) then begin
      if not Obj.HasUsrWithProp(ULObjPropName, FULObjUsr, FULObjUsrPropInfo) then
        SetResult('ULObjPropName ' +  ULObjPropName + ' not found in ULObj or its Usrs');
    end;
    // as FindField, but not an error if not found
  end else begin
    UpdateColor;
  end;
end;

procedure TULObjCtrl.DoLoaded;
begin
  UpdateColor;
  case FDoAfterLoaded of
    doWinToObj: WinToObj;
    doObjToWin: ObjToWin;
  end;
end;

procedure TULObjCtrl.SetULObjPath(const AValue: TULObjPath);
begin
  if AValue = FULObjPath then
    exit;
  FULObjPath := AValue;
  if (csDesigning in ComponentState) or (csLoading in ComponentState) then begin
    {do nothing}
  end else begin
    FindObjFieldByPath;
    DoLoaded;
  end;
end;
{/v0.52}

procedure TULObjCtrl.ObjUpdated;
begin
  if FInWinToObj then
    exit;
  ObjToWin;
end;

procedure TULObjCtrl.ObjToWin;
{update property value from Obj to WinCtrl}
var
  l: longint;
  e: extended;
  s: string;
begin
  if FInObjToWin then
    exit;
  if FWinCtrl.Focused{v0.47} and (ddWinToObj in DataDirections){/v0.47} then
    exit;
  FInObjToWin := true;
  try
    case FWinCtrlPropInfo^.PropType^^.Kind of
      tkInteger{, tkChar, tkEnumeration, tkWChar}: begin
        l := 0;
        if FULObjField <> nil then begin
          l := FULObjField.AsInteger;
        end{v0.24} else if FULObjUsr <> nil then begin
          l := GetOrdProp(FULObjUsr, FULObjUsrPropInfo);
        end{/v0.24};
        if UserCoef <> 0 then
          l := round(l / UserCoef);
        SetOrdProp(FWinCtrl, FWinCtrlPropInfo, l);
      end;
      {v0.44}
      tkEnumeration: begin
        l := 0;
        if FULObjField <> nil then begin
          l := FULObjField.AsInteger;
        end else if FULObjUsr <> nil then begin
          l := GetOrdProp(FULObjUsr, FULObjUsrPropInfo);
        end;
        SetOrdProp(FWinCtrl, FWinCtrlPropInfo, l);
      end;
      {/v0.44}

      tkFloat: begin
        e := 0;
        if FULObjField <> nil then begin
          e := FULObjField.AsFloat;
        end{v0.24} else if FULObjUsr <> nil then begin
          e := GetFloatProp(FULObjUsr, FULObjUsrPropInfo);
        end{/v0.24};
        if UserCoef <> 0 then
          e := e / UserCoef;
        SetFloatProp(FWinCtrl, FWinCtrlPropInfo, e);
      end;
    else
      if FULObjField <> nil then begin
        s := FULObjField.AsString
      end {v0.24} else if FULObjUsr <> nil then begin
        s := GetStrProp(FULObjUsr, FULObjUsrPropInfo);
      end{/v0.24} else
        s := 'ERROR';

      {v0.24}
      if NumDec <> 0 then begin
        e := StrToFloat(s);
        if UserCoef <> 0 then begin
          e := e / UserCoef;
        end;
        if NumLen = 0 then
          l := NumDec + 2
        else
          l := NumLen;
        s := FloatToStrF(e, ffFixed, l, NumDec);
        SetStrProp(FWinCtrl, FWinCtrlPropInfo, s);
      end else
      {/v0.24}
      begin
        if UserCoef <> 0 then begin
          l := StrToInt(s);
          l := round(l / UserCoef);
          SetStrProp(FWinCtrl, FWinCtrlPropInfo, IntToStr(l));
        end else begin
          SetStrProp(FWinCtrl, FWinCtrlPropInfo, s);
        end;
      end;
    end;
  finally
    FInObjToWin := false;
  end;
end;

{v0.47}
function TULObjCtrl.ObjIsReadOnly: boolean;
begin
  Result := true;
  if not (ddWinToObj in DataDirections) then
    exit;
  if FULObjField <> nil then begin
    Result := not Assigned(FULObjField.FldDesc.PropInfo^.SetProc);{ulobjdes}
  end else if FULObjUsrPropInfo <> nil then begin
    Result := not Assigned(FULObjUsrPropInfo^.SetProc);
  end;
end;
{/v0.47}

procedure TULObjCtrl.WinToObj;
{update property value from WinCtrl to Obj}
var l:Longint; e: extended;
begin
  {v0.47}
  if ObjIsReadOnly then
    exit;
  {/v0.47}
  if Obj = nil then begin
    if WinCtrl <> nil then
      WinCtrl.Brush.Color := clRed;
    exit;
  end;
  if FInWinToObj then
    exit;
  FInWinToObj := true;
  try
  case FWinCtrlPropInfo^.PropType^^.Kind of
    tkInteger{, tkChar, tkEnumeration, tkWChar}: begin
      l := GetOrdProp(FWinCtrl, FWinCtrlPropInfo);
      if UserCoef <> 0 then
        l := round(l * UserCoef);

      {v0.24}
      if FULObjField <> nil then begin
        FULObjField.AsInteger := l;
      end else if FULObjUsr <> nil then begin
        SetOrdProp(FULObjUsr, FULObjUsrPropInfo, l);
      end;
      {/v0.24
      FULObjField.AsInteger := l;}
    end;
    {v0.44}
    tkEnumeration: begin
      l := GetOrdProp(FWinCtrl, FWinCtrlPropInfo);
      if FULObjField <> nil then begin
        FULObjField.AsInteger := l;
      end else if FULObjUsr <> nil then begin
        SetOrdProp(FULObjUsr, FULObjUsrPropInfo, l);
      end;
    end;
    {/v0.44}
    tkFloat: begin
      e := GetFloatProp(FWinCtrl, FWinCtrlPropInfo);
      if UserCoef <> 0 then
        e := e * UserCoef;
      {v0.24}
      if FULObjField <> nil then begin
        FULObjField.AsFloat := e;
      end else if FULObjUsr <> nil then begin
        SetFloatProp(FULObjUsr, FULObjUsrPropInfo, e);
      end;
      {/v0.24
      FULObjField.AsFloat := e;}
    end;
  else
    if UserCoef <> 0 then begin
      l := round(StrToInt(GetStrProp(FWinCtrl, FWinCtrlPropInfo)) * UserCoef);

      {v0.24}
      if FULObjField <> nil then begin
        FULObjField.AsString := IntToStr(l);
      end else if FULObjUsr <> nil then begin
        SetStrProp(FULObjUsr, FULObjUsrPropInfo, IntToStr(l));
      end;
      {/v0.24
      FULObjField.AsString := IntToStr(l);}

    end else begin
      {v0.24}
      if FULObjField <> nil then begin
        FULObjField.AsString := GetStrProp(FWinCtrl, FWinCtrlPropInfo)
      end else if FULObjUsr <> nil then begin
        SetStrProp(FULObjUsr, FULObjUsrPropInfo, GetStrProp(FWinCtrl, FWinCtrlPropInfo));
      end;
      {/v0.24
      FULObjField.AsString := GetStrProp(FWinCtrl, FWinCtrlPropInfo);}
    end;
  end;
  finally
    FInWinToObj := false;
  end;
end;

procedure TULObjCtrl.SetResult(const msg:string);
  { raise exception with given msg }
begin
  if msg <> '' then
    raise EULObjCtrl.Create('ULObjCtrl ' + msg);
end;

procedure Register;
begin
  RegisterComponents('Chromulan', [TULObjCtrl]);
end;

end.
