unit uAddin;

(* CONTENT: This file implements the Delphi version of the interfaces *)
(* Paradox calls to get information about add-ins  (these interfaces  *)
(* are specified in iADDIN.pas).                                      *)

interface

Uses Windows, Classes, SysUtils, OLE2, iAddin, Menus, Forms, TypInfo, PdxForms;

Type

  TMenuInfo = Class
    fMenuNode: TPdxMenuNode;
    fMenu: TMenu;
  End;

  TPdxMenuList = Class( IPdxMenuList )
    private
      fMenuItems :TList;
      Function FindCommand(Command:Word):TMenuItem;
    public
      { IUnknown/IPdxAddinRoot }
      function QueryInterface(const iid: TIID; var obj): HResult; override; 
      function AddRef: Longint; override; 
      function Release: Longint; override; 
      { IPdxInfoList }
      Procedure Clear; override;
      Function GetCount:Integer; override;
      Function GetName(Index:Integer):TBStr; override;
      Function IndexOf(Name:TBStr):Integer; override;
      { IPdxMenuList }
      { Consider using Delphi's TOOLINTF.TIMenuItemIntf??? }
      Procedure DoInit(Index:Integer); override;
(*      Function IsVisible(Index:Integer):Boolean; override;  *)
      Function InSubMenu(Index:Integer; Node:TPdxMenuNode):Boolean; override;
      Function GetHandle(Index:Integer):HMENU; override; 
      Procedure DoClick(Command:Word); override; 
      Procedure DoClickHelp(Command:Word); override; 
      { DELPHI SUPPORT routines }
      Constructor Create;
      Destructor Destroy; Override;
      Procedure Add( aMenuNode:TPdxMenuNode; aMenu:TMenu );
      Function getMenuInfo( Index:Integer ):TMenuInfo;
      Property MenuInfo[ Index:Integer ]:TMenuInfo read getMenuInfo;
    end;

  TFormInfo = Class
    fFormName: String;
    fFormClass: TParadoxFormClass;
    fInstanceVariable :Pointer{PParadoxFormVar};
    Procedure Assign( source:TFormInfo );
  End;

  TPdxFormList = Class( IPdxFormList )
    private
      fFormList :TList;
    public
      { IUnknown/IPdxAddinRoot }
      function QueryInterface(const iid: TIID; var obj): HResult; override;
      function AddRef: Longint; override;
      function Release: Longint; override;
      { IPdxInfoList }
      Procedure Clear; override;
      Function GetCount:Integer; override;
      Function GetName(Index:Integer):TBStr; override;
      Function IndexOf(Name:TBStr):Integer; override;
      { Instance will return an IAddinForm }
      Function Instance(Index:Integer):IUnknown; override;
      Function AttachWindow(wnd:HWND; title:TBSTR):IUnknown; override;
      { DELPHI SUPPORT routines }
      Constructor Create;
      Destructor Destroy; Override;
      Procedure Add( aName:String; aFormClass: TParadoxFormClass; aInstanceVariable :Pointer{PParadoxFormVar} );
      Function getFormInfo( Index:Integer ):TFormInfo;
      Property FormInfo[ Index:Integer ]:TFormInfo read getFormInfo;
    end;

  { Reserved for future use }
  TPdxAutoList = Class( IPdxAutoList )
(*      { IUnknown/IPdxAddinRoot }
      function QueryInterface(const iid: TIID; var obj): HResult; override; 
      function AddRef: Longint; override;
      function Release: Longint; override; 
      { IPdxInfoList }
      Procedure Clear; override; 
      Function GetCount:Integer; override; 
      Function GetName(Index:Integer):TBStr; override;
      Function IndexOf(Name:TBStr):Integer; override;
      { Instance will return an IDispatch }
      Function Instance(Index:Integer):IUnknown; override;
      *)
    end;

  TPdxAddin = Class ( IPdxAddin )
    Private
      fPdxMenuList :TPdxMenuList;
      fPdxFormList :TPdxFormList;
{      fPdxAutoList :TPdxAutoList;   { Reserved for future use }
    Private { Paradox }
      function QueryInterface(const iid: TIID; var obj): HResult; override;
      function AddRef: Longint; override;
      function Release: Longint; override;
    Public { Delphi }
      Constructor Create;
      Destructor Destroy; override;
      Property MenuList :TPdxMenuList read fPdxMenuList;
      Property FormList :TPdxFormList read fPdxFormList;
{      Property AutoList :TPdxAutoList read fPdxAutoList;    { Reserved for future use }
    End;

  TAddinForm = Class( IAddinForm )
    Private
      fFormInfo: TFormInfo;
      fForm :TParadoxForm;
      Function NeedForm:TParadoxForm;
      Function NeedForm2(Overrides:TCreateFormOverrides):TParadoxForm;
      Function CheckPropInfo(var Instance: TObject; Name:TBStr):PPropInfo;
    Public
      { IUnknown/IPdxAddinRoot }
      function QueryInterface(const iid: TIID; var obj): HResult; override;
      function AddRef: Longint; override;
      function Release: Longint; override;
      { IAddinForm }
      Procedure bringToTop; override;
      Function close:BOOL; override;
      Function closeQuery:BOOL; override;
      Procedure getPosition(var x,y,w,h:longint); override;  {twips?}
      Function getTitle:TBStr; override;
      Procedure hide; override;
      Function isMaximized:Bool; override;
      Function isMinimized:Bool; override;
      Function isVisible:Bool; override;
      Procedure maximize; override;
      Function menuAction(Command:Integer):BOOL; override;
      Procedure minimize; override;
      Procedure open; override;
      Procedure openAs(bDialog:Bool;bVisible:Bool); override;
      Procedure postMessage(Command:Cardinal; W:WPARAM; L:LPARAM); override;
      Function sendMessage(Command:Cardinal; W:WPARAM; L:LPARAM):LRESULT; override;
      Procedure setPosition(var x,y,w,h:longint); override;  {twips?}
      Procedure setTitle(Title:TBStr); override;
      Procedure show; override;
      Function showModal:Integer; override;  { In place of Wait }
      Function windowClientHandle:HWND; override;
      Function windowHandle:HWND; override;
      { - User Defined - }
      Function getProperty(Name:TBStr; Index:Variant):Variant; override;
      Procedure setProperty(Name:TBStr; Index, Value:Variant); override;
      Function getPropAsString(Name:TBStr):TBStr; override;
      Procedure setPropAsString(Name, Value:TBStr); override;
      Function getPropAsInteger(Name:TBStr):Integer; override;
      Procedure setPropAsInteger(Name:TBStr; Value:Integer); override;
      Function getPropAsFloat(Name:TBStr):Double; override;
      Procedure setPropAsFloat(Name:TBStr; Value:Double); override;
    Public { Delphi }
      Constructor Create( aOwner:TPdxFormList; aFormInfo: TFormInfo );
      Class Function CreateAttach( aOwner:TPdxFormList; Form:TForm ):TAddinForm;
      Destructor Destroy; override;
    end;

implementation

Uses PdxAddIn;

{ ----------------------------------------------------------------------- }
{                               TPdxAddIn                                 }
{ ----------------------------------------------------------------------- }
function TPdxAddin.QueryInterface(const iid: TIID; var obj): HResult;
Begin
  Pointer(obj) := Nil;
  if IsEqualIID(iid, IID_PdxAddin        ) then IUnknown(obj) := self         else
{  if IsEqualIID(iid, IID_PdxInfoList     ) then IUnknown(obj) := }
  if IsEqualIID(iid, IID_PdxMenuList     ) then IUnknown(obj) := fPdxMenuList else
  if IsEqualIID(iid, IID_PdxFormList     ) then IUnknown(obj) := fPdxFormList {else}
{  if IsEqualIID(iid, IID_PdxAutoList     ) then IUnknown(obj) := fPdxAutoList else {future!}
{  if IsEqualIID(iid, IID_PdxDataModelList) then Pointer(obj) := nil; {Future!};
  if assigned(Pointer(obj)) then
    begin
      IUnknown(obj).AddRef;
      result := S_OK;
    end
  else
    Result := E_NOINTERFACE;
End;

function TPdxAddin.AddRef: Longint;
Begin
  Result := doAddRef;
End;

function TPdxAddin.Release: Longint;
Begin
  Result := doRelease;
End;

Constructor TPdxAddin.Create;
Begin
  Inherited;
  AddRef;
  fPdxMenuList := TPdxMenuList.Create;
  fPdxFormList := TPdxFormList.Create;
{  fPdxAutoList := TPdxAutoList.Create; }
End;

Destructor TPdxAddin.Destroy;
Begin
  fPdxMenuList.Free;
  fPdxFormList.Free;
{  fPdxAutoList.Free; }
  Inherited;
End;

{ ----------------------------------------------------------------------- }
{                               TPdxMenuList                              }
{ ----------------------------------------------------------------------- }

function TPdxMenuList.QueryInterface(const iid: TIID; var obj): HResult;
Begin
  Pointer(obj) := Nil;
  if IsEqualIID(iid, IID_PdxInfoList) then IUnknown(obj) := self else
  if IsEqualIID(iid, IID_PdxMenuList) then IUnknown(obj) := self;
  if assigned(Pointer(obj)) then
    begin
      IUnknown(obj).AddRef;
      result := S_OK;
    end
  else
    Result := E_NOINTERFACE;
End;

function TPdxMenuList.AddRef: Longint;
Begin
  Result := doAddRef;
End;

function TPdxMenuList.Release: Longint;
Begin
  Result := doRelease;
End;

Constructor TPdxMenuList.Create;
Begin
  Inherited;
  AddRef;
  fMenuItems := TList.Create;
End;

Destructor TPdxMenuList.Destroy;
Begin
  Clear;
  fMenuItems.Free;
  Inherited;
End;

Procedure TPdxMenuList.Add( aMenuNode:TPdxMenuNode; aMenu:TMenu );
Var mi :TMenuInfo;
Begin
  mi := TMenuInfo.Create;
  mi.fMenuNode := aMenuNode;
  mi.fMenu := aMenu;
  fMenuItems.Add( mi );
End;

Function TPdxMenuList.getMenuInfo( Index:Integer ):TMenuInfo;
Begin
  Result := TMenuInfo( fMenuItems.Items[Index] );
End;

Procedure TPdxMenuList.Clear;
Var I :Integer;
Begin
  For I := 0 to fMenuItems.Count-1 do
    MenuInfo[I].Free;
  fMenuItems.Clear;
End;

Function TPdxMenuList.GetCount:Integer;
Begin
  Result := fMenuItems.Count;
End;

Function TPdxMenuList.GetName(Index:Integer):TBStr;
Begin
  Result := StringToOleStr( MenuInfo[Index].fMenu.Name );
End;

Function TPdxMenuList.IndexOf(Name:TBStr):Integer;
Var S :String;
Begin
  S := OleStrToString( Name );
  For Result := 0 to fMenuItems.Count-1 do
    if CompareText(MenuInfo[Result].fMenu.Name, S) = 0 then
      exit;
  Result := -1;
End;

{ IPdxMenuList }
{ Consider using Delphi's TOOLINTF.TIMenuItemIntf??? }
Procedure TPdxMenuList.DoInit;
Var
  I :Integer;
Begin
  For I := 0 to fMenuItems.Count-1 do
    if TObject(MenuInfo[I].fMenu) is TPopupMenu Then
      With TPopupMenu(MenuInfo[I].fMenu) do
        If @OnPopup <> Nil Then
          OnPopup( MenuInfo[I].fMenu );
End;
(*
Function TPdxMenuList.IsVisible(Index:Integer):Boolean;
Begin
  Result := MenuInfo[Index].fMenuItem.Visible;
End;
*)
Function TPdxMenuList.InSubMenu(Index:Integer; Node:TPdxMenuNode):Boolean;
Begin
  Result := MenuInfo[Index].fMenuNode = Node;
End;

Function TPdxMenuList.GetHandle(Index:Integer):HMENU;
Begin
  Result := MenuInfo[Index].fMenu.Handle;
End;

Function TPdxMenuList.FindCommand(Command:Word):TMenuItem;
  Function SubMenuFindCommand(Menu:TMenuItem; Command:Word):TMenuItem;
  Var
    I :Integer;
  Begin
    If Menu.Command = Command Then
      Begin
        Result := Menu;
        Exit;
      End;
    For I := 0 to Menu.Count-1 do
      begin
        Result := SubMenuFindCommand( Menu.Items[I], Command );
        If Assigned( Result ) Then
          Exit;
      end;
    Result := Nil;
  End;
Var
  I :Integer;
Begin
  For I := 0 to fMenuItems.Count-1 do
    begin
      Result := SubMenuFindCommand( MenuInfo[I].fMenu.Items, Command );
      If Assigned( Result ) Then
        Exit;
    end;
  Result := Nil;
End;

Procedure TPdxMenuList.DoClick(Command:Word);
Var menuItem :TMenuItem;
Begin
  menuItem := FindCommand(Command);
  if assigned( menuItem ) then
    menuItem.Click;
End;

Procedure TPdxMenuList.DoClickHelp(Command:Word);
Var menuItem :TMenuItem;
Begin
  menuItem := FindCommand(Command);
  if assigned( menuItem ) then
    Application.HelpContext( menuItem.HelpContext );
End;

{ ----------------------------------------------------------------------- }
{                               TPdxFormList                              }
{ ----------------------------------------------------------------------- }

function TPdxFormList.QueryInterface(const iid: TIID; var obj): HResult;
Begin
  Pointer(obj) := Nil;
  if IsEqualIID(iid, IID_PdxInfoList) then IUnknown(obj) := self else
  if IsEqualIID(iid, IID_PdxFormList) then IUnknown(obj) := self;
  if assigned(Pointer(obj)) then
    begin
      IUnknown(obj).AddRef;
      result := S_OK;
    end
  else
    Result := E_NOINTERFACE;
End;

function TPdxFormList.AddRef: Longint;
Begin
  Result := doAddRef;
End;

function TPdxFormList.Release: Longint;
Begin
  Result := doRelease;
End;

Constructor TPdxFormList.Create;
Begin
  Inherited;
  AddRef;
  fFormList := TList.Create;
End;

Destructor TPdxFormList.Destroy;
Begin
  fFormList.Free;
  Inherited;
End;

Procedure TPdxFormList.Add( aName:String; aFormClass: TParadoxFormClass; aInstanceVariable :Pointer{PParadoxFormVar} );
Var fi :TFormInfo;
Begin
  fi := TFormInfo.Create;
  fi.fFormName := aName;
  fi.fFormClass := aFormClass;
  fi.fInstanceVariable := aInstanceVariable;
  fFormList.Add( fi );
End;

Function TPdxFormList.getFormInfo( Index:Integer ):TFormInfo;
Begin
  Result := TFormInfo( fFormList.Items[Index] );
End;

Procedure TPdxFormList.Clear;
Var I :Integer;
Begin
  For I := 0 to fFormList.Count-1 do
    FormInfo[I].Free;
  fFormList.Clear;
End;

Function TPdxFormList.GetCount:Integer;
Begin
  Result := fFormList.Count;
End;

Function TPdxFormList.GetName(Index:Integer):TBStr;
Begin
  Result := StringToOleStr( FormInfo[Index].fFormName );
End;

Function TPdxFormList.IndexOf(Name:TBStr):Integer;
Var S :String;
Begin
  S := OleStrToString( Name );
  For Result := 0 to fFormList.Count-1 do
    if CompareText(FormInfo[Result].fFormName, S) = 0 then
      exit;
  Result := -1;
End;

Function TPdxFormList.Instance(Index:Integer):IUnknown;
Begin
  Result := TAddinForm.Create( Self, FormInfo[Index] );
End;

Function TPdxFormList.AttachWindow(wnd:HWND; title:TBSTR):IUnknown;
Var
  T:String;
  I:Integer;
Begin
  Result := Nil;
  if wnd <> 0 then { lookup window handle }
    Begin
      For I := 0 to Screen.FormCount-1 do
        If Screen.Forms[ I ].Handle = wnd then
          Begin
            Result := TAddinForm.CreateAttach( Self, Screen.Forms[ I ] );
            Exit;
          End;
    End
  Else
  if assigned(title) then { lookup title }
    Begin
      T := OleStrToString( title );
      For I := 0 to Screen.FormCount-1 do
        If Screen.Forms[ I ].Caption = T then { Case Sensative!!! }
          Begin
            Result := TAddinForm.CreateAttach( Self, Screen.Forms[ I ] );
            Exit;
          End;
    End
  Else { Just try the active form }
    Begin
      If assigned(Screen.ActiveForm) Then T := OleStrToString( title );
      For I := 0 to Screen.FormCount-1 do
        If Screen.Forms[ I ].Caption = T then { Case Sensative!!! }
          Begin
            Result := TAddinForm.CreateAttach( Self, Screen.Forms[ I ] );
            Exit;
          End;
    End
End;

{ --------------------------------------------------------------------------- }
{                               TFormInfo                                     }
{ --------------------------------------------------------------------------- }
Procedure TFormInfo.Assign( source:TFormInfo );
Begin
  fFormName := source.fFormName;
  fFormClass := source.fFormClass;
  fInstanceVariable := source.fInstanceVariable;
End;

{ --------------------------------------------------------------------------- }
{                               TAddinForm                                    }
{ --------------------------------------------------------------------------- }

Constructor TAddinForm.Create( aOwner:TPdxFormList; aFormInfo: TFormInfo );
Begin
  inherited Create;
  AddRef;
  if assigned( aFormInfo ) Then
    Begin
      fFormInfo := TFormInfo.Create;
      fFormInfo.Assign( aFormInfo );
    End;
End;

Class Function TAddinForm.CreateAttach( aOwner:TPdxFormList; Form:TForm ):TAddinForm;
Begin
  Result := Nil;
  If not (Form is TParadoxForm) Then
    Exit;
  Result := Create( aOwner, Nil );
  Result.fForm := TParadoxForm( Form );
  Result.fForm.AddRef;
  Result.fFormInfo := TFormInfo.Create;
  With Result, fFormInfo do
    Begin
      fFormName := fForm.Name;
      fFormClass := fForm.ClassInfo;
      fInstanceVariable := Nil;
    End;
End;

Destructor TAddinForm.Destroy;
Begin
  if not assigned(fFormInfo.fInstanceVariable) and assigned(fForm) then { ???? }
    fForm.Release;
  inherited;
End;

{ IUnknown/IPdxAddinRoot }
function TAddinForm.QueryInterface(const iid: TIID; var obj): HResult;
Begin
  Pointer(obj) := Nil;
  if IsEqualIID(iid, IID_AddinForm) then IUnknown(obj) := self;
  if assigned(Pointer(obj)) then
    begin
      IUnknown(obj).AddRef;
      result := S_OK;
    end
  else
    Result := E_NOINTERFACE;
End;

function TAddinForm.AddRef: Longint;
Begin
  Result := doAddRef;
End;

function TAddinForm.Release: Longint;
Begin
//  Result := doRelease;
  Dec(FRefCount);
  Result := FRefCount;
  if FRefCount = 0 then
    Begin
      If assigned(fForm) and fForm.Showing Then
        { PAL didn't close it first, so Ignore... }
      Else
        Destroy;
    End;
End;

Function TAddinForm.NeedForm:TParadoxForm;
Begin
  if assigned(fForm) then
    Result := fForm
  else
    Result := NeedForm2([]);
End;

Function TAddinForm.NeedForm2(Overrides:TCreateFormOverrides):TParadoxForm;
Begin
  if not assigned(fForm) then
    begin
      if assigned(fFormInfo.fInstanceVariable) then
        begin
          if Not Assigned(Pointer(fFormInfo.fInstanceVariable^)) then
            CreateParadoxForm( fFormInfo.fFormClass, Overrides, fFormInfo.fInstanceVariable^ );
          fForm := TParadoxForm(fFormInfo.fInstanceVariable^);
        end
      else
        CreateParadoxForm( fFormInfo.fFormClass, Overrides, fForm );
    end;
  Result := fForm;
End;

{ IAddinForm }
Procedure TAddinForm.bringToTop;
Begin
  NeedForm.BringToFront;
End;

Function TAddinForm.Close:BOOL;
Begin
  Try
    NeedForm.Close;
    Result := True;
  Except
    Result := False;
  End;
End;

Function TAddinForm.CloseQuery:BOOL;
Begin
  Result := NeedForm.CloseQuery;
End;

Procedure TAddinForm.GetPosition(var x,y,w,h:longint); { twips? }
Begin
  With NeedForm do
    begin
    {$ifdef APIUSETWIPS}
      x := PixelsToTwips( Left );
      y := PixelsToTwips( Top );
      w := PixelsToTwips( Width );
      h := PixelsToTwips( Height );
    {$else}
      x := Left;
      y := Top;
      w := Width;
      h := Height;
    {$endif}
    end;
End;

Function TAddinForm.GetTitle:TBStr;
Begin
  Result := StringToOleStr( NeedForm.Caption );
End;

Procedure TAddinForm.Hide;
Begin
  NeedForm.Hide;
End;

Function TAddinForm.IsMaximized:Bool;
Begin
  Result := NeedForm.WindowState = wsMaximized;
End;

Function TAddinForm.IsMinimized:Bool;
Begin
  Result := NeedForm.WindowState = wsMinimized;
End;

Function TAddinForm.IsVisible:Bool;
Begin
  Result := NeedForm.Visible;
End;

Procedure TAddinForm.Maximize;
Begin
  NeedForm.WindowState := wsMaximized;
End;

Function TAddinForm.MenuAction(Command:Integer):BOOL;
Var
  f:TParadoxForm;
  bResult :Boolean;
Begin
  bResult := False;
  F := NeedForm;
  With f do
    Begin
      If Assigned(OnMenuAction) Then
        OnMenuAction( f, Command, bResult );
    End;
  Result := bResult;
End;

Procedure TAddinForm.Minimize;
Begin
  NeedForm.WindowState := wsMinimized;
End;

Procedure TAddinForm.Open;
Begin
  NeedForm.HandleNeeded;
End;

Procedure TAddinForm.OpenAs(bDialog:Bool;bVisible:Bool);
Var
  Overrides:TCreateFormOverrides;
Begin
  if Boolean(bVisible) then  // Force ignore all but the low 8 bits...
    Overrides := [cfoVisible]
  else
    Overrides := [cfoNotVisible];
  if Boolean(bDialog) then  // Force ignore all but the low 8 bits...
    Include(Overrides, cfoNormal)
  else
    Include(Overrides, cfoChild);

  With NeedForm2(Overrides) do
    if (FormStyle = fsMDIChild) and Visible Then
      BringToFront; { MDI children don't do this for some reason }
End;

Procedure TAddinForm.PostMessage(Command:Cardinal; w:WPARAM; L:LPARAM);
Begin
  With NeedForm do
    Begin
      { if Delegated then Delegate }
      Windows.PostMessage(Handle, Command, W, L);
    End;
End;

Function TAddinForm.SendMessage(Command:Cardinal; W:WPARAM; L:LPARAM):LRESULT;
Begin
  With NeedForm do
    Begin
      { if Delegated then Delegate }
      Result := Windows.SendMessage(Handle, Command, W, L);
    End;
End;

Procedure TAddinForm.SetPosition(var x,y,w,h:longint); {twips?}
Begin
 {$ifdef APIUSETWIPS}
  NeedForm.SetBounds( TwipsToPixels(x), TwipsToPixels(y),
                      TwipsToPixels(w), TwipsToPixels(h) );
 {$else}
  NeedForm.SetBounds( x, y, w, h );
 {$endif}
End;

Procedure TAddinForm.SetTitle(Title:TBStr);
Begin
  NeedForm.Caption := OleStrToString( Title );
End;

Procedure TAddinForm.Show;
Begin
  With NeedForm do
    Begin
      WindowState := wsNormal;
      Show;
    End;
End;

Function TAddinForm.ShowModal:Integer; { In place of Wait }
Begin
  Result := NeedForm.ShowModal;
End;

Function TAddinForm.WindowClientHandle:HWND;
Begin
  Raise Exception.Create('Unimplemented');
  Result := NeedForm.ClientHandle; { Valid for MDI Parent ONLY????? }
End;

Function TAddinForm.WindowHandle:HWND;
Begin
  Result := NeedForm.Handle;
End;

{ ----------------------------------------------------- }
{ - Routines for manipulating User Defined properties - }

Function TAddinForm.CheckPropInfo(var Instance: TObject; Name:TBStr):PPropInfo;
Var PropName :String;
  Function RecursePropInfo(var Instance: TObject; Name:String):PPropInfo;
  Var I :Integer;
  Begin
    I := Pos('.', Name);
    If I = 0 Then
        Result := GetPropInfo( Instance.ClassInfo, Name )
    Else    { Nested Property }
      Begin
        Result := GetPropInfo( Instance.ClassInfo, Copy(Name,1,I-1) );
        If Result^.PropType^.Kind <> tkClass then
          Raise Exception.CreateFmt('%s is not a published property of %s, because %s is not an Object',
            [PropName,  fFormInfo.fFormName, Copy(Name,1,I-1)]);
        Instance := TObject(GetOrdProp(Instance, Result));
        If Not Assigned(Instance) then
          Raise Exception.CreateFmt('%s is inaccessible, because %s is NULL',
            [PropName, Copy(Name,1,I-1)]);
        Result := RecursePropInfo( Instance, Copy(Name,I+1,Length(Name)) );
      End;
  If Not Assigned(Result) Then
    if Instance = fForm Then
      Raise Exception.CreateFmt('%s is not a published property of %s', [PropName, fFormInfo.fFormName])
    Else
      Raise Exception.CreateFmt('%s is not a published property of %s, because %s is not a published property of %s',
        [PropName, fFormInfo.fFormName, Name, Instance.ClassName]);
  End;
Begin
  PropName := OleStrToString( Name );
  Instance := NeedForm;
  Result := RecursePropInfo( Instance, PropName );
End;

Function TAddinForm.GetProperty(Name:TBStr; Index:Variant):Variant; { OBSOLETE??? }
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     Result := GetOrdProp(Instance, PropInfo);
  tkChar:        Raise Exception.Create('Get of Char property not supported');
  tkEnumeration: Raise Exception.Create('Get of Enumeration property not supported');
  tkFloat:       Result := GetFloatProp(Instance, PropInfo);
{  tkString:      Result := StringToOleStr( GetStrProp(Instance, PropInfo) ); }
  tkSet:         Raise Exception.Create('Get of Set property not supported');
  tkClass:       Raise Exception.Create('Get of Class property not supported');
  tkMethod:      Raise Exception.Create('Get of Method property not supported');
  tkWChar:       Raise Exception.Create('Get of WChar property not supported');
{  tkLString:     Result := StringToOleStr( GetStrProp(Instance, PropInfo) ); }
//  tkLWString:    Raise Exception.Create('Get of LWString property not supported');
  tkVariant:     Result := GetVariantProp(Instance, PropInfo);
  End;
End;

Procedure TAddinForm.SetProperty(Name:TBStr; Index, Value:Variant); { OBSOLETE??? }
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     SetOrdProp(Instance, PropInfo, Value);
  tkChar:        Raise Exception.Create('Set of Char property not supported');
  tkEnumeration: Raise Exception.Create('Set of Enumeration property not supported');
  tkFloat:       SetFloatProp(Instance, PropInfo, Value);
  tkString:      SetStrProp(Instance, PropInfo, Value);
  tkSet:         Raise Exception.Create('Set of Set property not supported');
  tkClass:       Raise Exception.Create('Set of Class property not supported');
  tkMethod:      Raise Exception.Create('Set of Method property not supported');
  tkWChar:       Raise Exception.Create('Set of WChar property not supported');
  tkLString:     SetStrProp(Instance, PropInfo, Value);
//  tkLWString:    Raise Exception.Create('Get of LWString property not supported');
  tkVariant:     SetVariantProp(Instance, PropInfo, Value);
  End;
End;

const
  SetMax = SizeOf(Integer) * 8 - 1;
type
  TIntegerSet = set of 0..SetMax;

Function GetSetString(Instance :TObject; PropInfo :PPropInfo):String;
{ Code adapted from DSGNINTF.TSetProperty.GetValue }
var
  S: TIntegerSet;
  TypeInfo: PTypeInfo;
  I: Integer;
begin
  Integer(S) := GetOrdProp(Instance, PropInfo);

{$IFDEF VER90}
  TypeInfo := GetTypeData(PropInfo^.PropType)^.CompType;
{$ELSE}
  TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
{$ENDIF}

  Result := '[';
  for I := 0 to SetMax do
    if I in S then
    begin
      if Length(Result) <> 1 then Result := Result + ',';
      Result := Result + GetEnumName(TypeInfo, I);
    end;
  Result := Result + ']';
end;

Procedure SetSetFromString(Instance :TObject; PropInfo :PPropInfo; newValue:String);
var
  S: TIntegerSet;
  TypeInfo: PTypeInfo;
  enumValue: Integer;
  Start,Finish: PChar;
begin
  if (Length(newValue) < 2) or (newValue[1]<>'[') or (newValue[Length(newValue)]<>']') Then
    Raise Exception.Create('Set values must be enclosed in [brackets]');
  UniqueString(NewValue);
  NewValue[Length(NewValue)] := #0;

  Start := PChar(NewValue)+1;
  S := [];

{$IFDEF VER90}
  TypeInfo := GetTypeData(PropInfo^.PropType)^.CompType;
{$ELSE}
  TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
{$ENDIF}

  While Assigned(Start) and (Start^ <> #0) do
    Begin
      Finish := StrPos(Start, ',');
      If Assigned(Finish) Then
        Finish^ := #0;
      enumValue := GetEnumValue(TypeInfo, Start);
      if enumValue = -1 then
        Raise Exception.CreateFmt('%s is not an element of set %s',[Start,PropInfo^.PropType^.Name]);
      Include(S, enumValue);
      If Assigned(Finish) Then
        Start := Finish + 1
      Else
        Start := Nil;
    End;

  SetOrdProp(Instance, PropInfo, Integer(S));
end;

Function TAddinForm.GetPropAsString(Name:TBStr):TBStr;
Var
  PropInfo :PPropInfo;
  Instance :TObject;
  SResult :String;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     SResult := IntToStr(GetOrdProp(Instance, PropInfo));
  tkChar:        SResult := Char(GetOrdProp(Instance, PropInfo));

{$IFDEF VER90}
  tkEnumeration: SResult := GetEnumName(PropInfo^.PropType, GetOrdProp(Instance, PropInfo));
{$ELSE}
  tkEnumeration: SResult := GetEnumName(PropInfo^.PropType^, GetOrdProp(Instance, PropInfo));
{$ENDIF}

  tkFloat:       SResult := FloatToStr(GetFloatProp(Instance, PropInfo));
  tkString:      SResult := GetStrProp(Instance, PropInfo);
//  tkSet:         Raise Exception.Create('Get of Set property as string not supported');
  tkSet:         SResult := GetSetString(Instance, PropInfo);
  tkClass:       Raise Exception.Create('Get of Class property not supported');
  tkMethod:      Raise Exception.Create('Get of Method property not supported');
  tkWChar:
    Begin
      Result := StringToOleStr( ' ' );
      Result[0] := WChar(GetOrdProp(Instance, PropInfo));
      Exit;
    End;
  tkLString:     SResult := GetStrProp(Instance, PropInfo);
//  tkLWString:    Raise Exception.Create('Get of LWString property not supported');
  tkVariant:     SResult := GetVariantProp(Instance, PropInfo);
  End;
  Result := StringToOleStr( SResult );
End;

Procedure TAddinForm.SetPropAsString(Name, Value:TBStr);
Var
  PropInfo :PPropInfo;
  Instance :TObject;
  S :String;
  enumValue :Integer;
Begin
  S := OleStrToString( Value );
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     SetOrdProp(Instance, PropInfo, StrToInt(S));
  tkChar:        if length(S)=1 then
                   SetOrdProp(Instance, PropInfo, Ord(S[1]) )
                 else
                   Raise Exception.Create('Set of char property requires single char string');
  tkEnumeration: Begin

				{$IFDEF VER90}
  			       enumValue := GetEnumValue(PropInfo^.PropType, S);
				{$ELSE}
                   enumValue := GetEnumValue(PropInfo^.PropType^, S);
				{$ENDIF}
				
                   if enumValue = -1 then
                     Raise Exception.CreateFmt('%s is not a member of enumeration %s',[S,PropInfo^.PropType^.Name]);
                   SetOrdProp(Instance, PropInfo, enumValue);
                 End;
  tkFloat:       SetFloatProp(Instance, PropInfo, StrToFloat(S));
  tkString:      SetStrProp(Instance, PropInfo, S);
//  tkSet:         Raise Exception.Create('Set of Set property not supported');
  tkSet:         SetSetFromString(Instance, PropInfo, S);
  tkClass:       Raise Exception.Create('Set of Class property not supported');
  tkMethod:      Raise Exception.Create('Set of Method property not supported');
  tkWChar:       Raise Exception.Create('Set of WChar property not supported');
  tkLString:     SetStrProp(Instance, PropInfo, S);
//  tkLWString:    Raise Exception.Create('Set of LWString property not supported');
  tkVariant:     SetVariantProp(Instance, PropInfo, S);
  End;
End;

Function TAddinForm.GetPropAsInteger(Name:TBStr):Integer;
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     Result := GetOrdProp(Instance, PropInfo);
  tkChar:        Result := GetOrdProp(Instance, PropInfo);
  tkEnumeration: Result := GetOrdProp(Instance, PropInfo);
  tkFloat:       Result := Trunc(GetFloatProp(Instance, PropInfo));
  tkString:      Result := StrToInt(GetStrProp(Instance, PropInfo));
  tkSet:         Raise Exception.Create('Get of Set property as Integer not supported');
  tkClass:       Raise Exception.Create('Get of Class property not supported');
  tkMethod:      Raise Exception.Create('Get of Method property not supported');
  tkWChar:       Raise Exception.Create('Get of LWString property as Integer not supported');
  tkLString:     Result := StrToInt(GetStrProp(Instance, PropInfo));
//  tkLWString:    Raise Exception.Create('Get of LWString property as Integer not supported');
  tkVariant:     Result := GetVariantProp(Instance, PropInfo);
  else           Raise Exception.Create('Get of unknown property type');
  End;
End;

Procedure TAddinForm.SetPropAsInteger(Name:TBStr; Value:Integer);
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     SetOrdProp(Instance, PropInfo, Value);
  tkChar:        SetOrdProp(Instance, PropInfo, Value );
  tkEnumeration: SetOrdProp(Instance, PropInfo, Value);
  tkFloat:       SetFloatProp(Instance, PropInfo, 1.0 * Value);
  tkString:      SetStrProp(Instance, PropInfo, IntToStr(Value));
  tkSet:         Raise Exception.Create('Set of Set property not supported');
  tkClass:       Raise Exception.Create('Set of Class property not supported');
  tkMethod:      Raise Exception.Create('Set of Method property not supported');
  tkWChar:       Raise Exception.Create('Set of WChar property not supported');
  tkLString:     SetStrProp(Instance, PropInfo, IntToStr(Value));
//  tkLWString:    Raise Exception.Create('Set of LWString property not supported');
  tkVariant:     SetVariantProp(Instance, PropInfo, Value);
  End;
End;

Function TAddinForm.GetPropAsFloat(Name:TBStr):Double;
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     Result := GetOrdProp(Instance, PropInfo);
  tkChar:        Result := GetOrdProp(Instance, PropInfo);
  tkEnumeration: Result := GetOrdProp(Instance, PropInfo);
  tkFloat:       Result := GetFloatProp(Instance, PropInfo);
  tkString:      Result := StrToFloat(GetStrProp(Instance, PropInfo));
  tkSet:         Raise Exception.Create('Get of Set property as Float not supported');
  tkClass:       Raise Exception.Create('Get of Class property not supported');
  tkMethod:      Raise Exception.Create('Get of Method property not supported');
  tkWChar:       Raise Exception.Create('Get of WChar property as Float not supported');
  tkLString:     Result := StrToFloat(GetStrProp(Instance, PropInfo));
//  tkLWString:    Raise Exception.Create('Get of LWString property as Float not supported');
  tkVariant:     Result := GetVariantProp(Instance, PropInfo);
  else           Raise Exception.Create('Get of unknown property type');
  End;
End;

Procedure TAddinForm.SetPropAsFloat(Name:TBStr; Value:Double);
Var
  PropInfo :PPropInfo;
  Instance :TObject;
Begin
  PropInfo := CheckPropInfo(Instance, Name);
  Case PropInfo^.PropType^.Kind of
  tkInteger:     SetOrdProp(Instance, PropInfo, Trunc(Value));
  tkChar:        SetOrdProp(Instance, PropInfo, Trunc(Value));
  tkEnumeration: SetOrdProp(Instance, PropInfo, Trunc(Value));
  tkFloat:       SetFloatProp(Instance, PropInfo, Value);
  tkString:      SetStrProp(Instance, PropInfo, FloatToStr(Value));
  tkSet:         Raise Exception.Create('Set of Set property not supported');
  tkClass:       Raise Exception.Create('Set of Class property not supported');
  tkMethod:      Raise Exception.Create('Set of Method property not supported');
  tkWChar:       Raise Exception.Create('Set of WChar property as Float not supported');
  tkLString:     SetStrProp(Instance, PropInfo, FloatToStr(Value));
//  tkLWString:    Raise Exception.Create('Set of LWString property as Float not supported');
  tkVariant:     SetVariantProp(Instance, PropInfo, Value);
  End;
End;


end.
