home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 035A / COMPED2.ZIP / E_PROPS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-03-13  |  22.3 KB  |  566 lines
  1. Unit E_Props;
  2. {-------------} Interface {--------------------}
  3. Uses
  4.       Classes  ,TypInfo;
  5. (*******************************************************************
  6.                             E_Props
  7.     Get and set RTTI information routines.
  8.     NOTE : I have encapsulated all RTTI manipulation routines in this
  9.     unit due to the possibility that Borland may change the structure
  10.     of RTTI with later releases. This way any changes required in an
  11.     application can be made in only one place. The TEProperty class
  12.     below provides an interface that can be used for displaying and
  13.     editing a component's properties.
  14.     Author : David Spies
  15.     Contacts : Work - davidsp@eastsoft.com Home DSPIES@onecom.com  *)
  16.  
  17. Const
  18.        PROP_NOTYPE        = 0;
  19.        PROP_STRTYPE       = 1;
  20.        PROP_INTTYPE       = 2;
  21.        PROP_REALTYPE      = 3;
  22.        PROP_BOOLTYPE      = 4;
  23.        PROP_CHARTYPE      = 5;
  24.        PROP_ENUMTYPE      = 6;
  25.        PROP_COLORTYPE     = 7;
  26.        PROP_CURSORTYPE    = 8;
  27.        PROP_SETTYPE       = 9;
  28.        PROP_CLASSTYPE     = 10;
  29.        PROP_MODALTYPE     = 11;
  30.        PROP_DBNAMETYPE    = 12;
  31.        PROP_DBIDXNAMETYPE = 13;
  32.        PROP_DBTABNAMETYPE = 14;
  33.        PROP_DBLOOKUPFIELD = 15;
  34.  
  35.        PROP_FONTSUB        = 1;
  36.        PROP_ICONSUB        = 2;
  37.        PROP_BMPSUB         = 3;
  38.        PROP_TSTRSUB        = 4;
  39.        PROP_DATASETSUB     = 5;
  40.        PROP_DATASOURCESUB  = 6;
  41. Type
  42.      TEProperty = Class
  43.        EType        : Word;
  44.        SubType      : Word;
  45.        MaxChars     : Word;
  46.        MinVal       : LongInt;
  47.        MaxVal       : LongInt;
  48.        ClassAddr    : LongInt;
  49.        PValue       : String;
  50.        TypeInfo     : PTypeInfo;
  51.      end;
  52.  
  53.  
  54.  
  55. Function E_IsPublishedProp(     AComponent : TComponent;
  56.                            Const PropName   : String) : Boolean;
  57.  
  58.  
  59. Function E_GetStrProp(      AComponent : TComponent;
  60.                       Const PropName   : String;
  61.                       Var   PropValue  : String) : Boolean;
  62.  
  63. Function E_GetIntProp(      AComponent : TComponent;
  64.                       Const PropName   : String;
  65.                       Var   PropValue  : Integer) : Boolean;
  66.  
  67. Function E_GetBoolProp(      AComponent : TComponent;
  68.                        Const PropName   : String;
  69.                        Var   PropValue  : Boolean) : Boolean;
  70.  
  71. Function E_GetRealProp(     AComponent : TComponent;
  72.                       Const PropName   : String;
  73.                       Var   PropValue  : Double) : Boolean;
  74.  
  75. Function E_GetSetStrProp(      AComponent : TComponent;
  76.                          Const PropName   : String;
  77.                           Var  PropValue  : String) : Boolean;
  78.  
  79. Function E_SetStrProp(      AComponent : TComponent;
  80.                       Const PropName   : String;
  81.                       Const PropValue  : String) : Boolean;
  82.  
  83. Function E_SetIntProp(      AComponent : TComponent;
  84.                       Const PropName   : String;
  85.                             PropValue  : Integer) : Boolean;
  86.  
  87. Function E_SetRealProp(      AComponent : TComponent;
  88.                        Const PropName   : String;
  89.                             PropValue   : Double) : Boolean;
  90.  
  91. Function E_SetBoolProp(     AComponent : TComponent;
  92.                       Const PropName   : String;
  93.                             PropValue  : Boolean) : Boolean;
  94.  
  95. Function E_SetSetStrProp(      AComponent : TComponent;
  96.                          Const PropName   : String;
  97.                                PropValue  : String) : Boolean;
  98.  
  99. Function E_EnumProperties(    AComponent : TComponent;
  100.                           Var PropList   : TStringList) : Integer;
  101.  
  102. Function E_GetEnumList(      CompProp : TEProperty;
  103.                              AList    : TStrings) : Boolean;
  104.  
  105.  
  106. {-------------} Implementation {---------------}
  107. Uses
  108.     Controls,Db,DbTables,Graphics,SysUtils;
  109. Type
  110.      TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  111.  
  112. (*******************************************************************
  113.                             E_GetPropInfo
  114.     Internal helper routine to get a RTTI structure pointer.
  115.  *******************************************************************)
  116. Function E_GetPropInfo(      AComponent : TCOmponent;
  117.                        Const PropName   : String;
  118.                        Var   PropInfo   : PPropInfo) : Boolean;
  119. begin
  120.   PropInfo:=Nil;
  121.   If AComponent<>Nil then
  122.     Try
  123.       PropInfo:=GetPropInfo(AComponent.ClassInfo,PropName);
  124.     Except
  125.       PropInfo:=Nil;
  126.     end;
  127.   Result:=PropInfo<>Nil;
  128. end;
  129. (*******************************************************************
  130.                             E_IsPublished
  131.     Return true if PropName is a published property.
  132.  *******************************************************************)
  133. Function E_IsPublishedProp(     AComponent : TComponent;
  134.                            Const PropName   : String) : Boolean;
  135. begin
  136.   If Propname<>'' then
  137.     Result:=GetPropInfo(AComponent.ClassInfo,PropName)<>Nil
  138.   else
  139.     Result:=False;
  140. end;
  141. (*******************************************************************
  142.                             E_Get????????
  143.   The next several routines get the value of PropName from component.
  144.   Returns False if property doesn't exist.
  145.  *******************************************************************)
  146. Function E_GetStrProp(      AComponent : TComponent;
  147.                       Const PropName   : String;
  148.                       Var   PropValue  : String) : Boolean;
  149. Var
  150.     PropInfo  : PPropInfo;
  151. begin
  152.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  153.   If Result then
  154.     PropValue:=GetStrProp(TObJect(AComponent),PropInfo)
  155.   else
  156.     PropValue:='';
  157. end;
  158. Function E_GetIntProp(      AComponent : TComponent;
  159.                       Const PropName   : String;
  160.                       Var   PropValue  : Integer) : Boolean;
  161. Var
  162.     PropInfo  : PPropInfo;
  163. begin
  164.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  165.   If Result then
  166.     PropValue:=GetOrdProp(TObJect(AComponent),PropInfo)
  167.   else
  168.     PropValue:=0;
  169. end;
  170. Function E_GetBoolProp(      AComponent : TComponent;
  171.                        Const PropName   : String;
  172.                        Var   PropValue  : Boolean) : Boolean;
  173. Var
  174.     PropInfo  : PPropInfo;
  175. begin
  176.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  177.   If Result then
  178.     PropValue:=Boolean(GetOrdProp(TObJect(AComponent),PropInfo))
  179.   else
  180.     PropValue:=False;
  181. end;
  182. Function E_GetRealProp(      AComponent : TComponent;
  183.                        Const PropName   : String;
  184.                        Var   PropValue  : Double) : Boolean;
  185. Var
  186.     PropInfo  : PPropInfo;
  187. begin
  188.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  189.   If Result then
  190.     PropValue:=GetFloatProp(TObJect(AComponent),PropInfo)
  191.   else
  192.     PropValue:=0;
  193. end;
  194. Function E_GetSetStrProp(      AComponent : TComponent;
  195.                          Const PropName   : String;
  196.                           Var  PropValue  : String) : Boolean;
  197. Var
  198.     PropInfo  : PPropInfo;
  199.     S         : TIntegerSet;
  200.     TypeInfo  : PTypeInfo;
  201.     I         ,
  202.     MinV      ,
  203.     MaxV      : Integer;
  204. begin
  205.   PropValue:='';
  206.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  207.   If Result then
  208.   begin
  209.     Integer(S):=GetOrdProp(TObJect(AComponent),PropInfo);
  210.     TypeInfo:=GetTypeData(PropInfo^.PropType)^.CompType;
  211.     MinV:=GetTypeData(TypeInfo).MinValue;
  212.     MaxV:=GetTypeData(TypeInfo).MaxValue;
  213.     PropValue := '[';
  214.     for I := MinV to MaxV do
  215.       if I in S then
  216.       begin
  217.         if Length(PropValue) <> 1 then
  218.           PropValue := PropValue + ',';
  219.         PropValue := PropValue + GetEnumName(TypeInfo,I);
  220.       end;
  221.       PropValue := PropValue + ']';
  222.   end;
  223. end;
  224. (*******************************************************************
  225.                             E_Set????????
  226.   The next several routines sets the value of PropName in component
  227.   to PropVal. Returns False if property doesn't exist.
  228.  *******************************************************************)
  229. Function E_SetStrProp(      AComponent : TComponent;
  230.                       Const PropName   : String;
  231.                       Const PropValue  : String) : Boolean;
  232. Var
  233.     PropInfo  : PPropInfo;
  234. begin
  235.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  236.   If Result then
  237.     SetStrProp(TObJect(AComponent),PropInfo,PropValue);
  238. end;
  239. Function E_SetIntProp(      AComponent : TComponent;
  240.                       Const PropName   : String;
  241.                             PropValue  : Integer) : Boolean;
  242. Var
  243.     PropInfo  : PPropInfo;
  244. begin
  245.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  246.   If Result then
  247.     SetOrdProp(TObJect(AComponent),PropInfo,PropValue);
  248. end;
  249. Function E_SetBoolProp(     AComponent : TComponent;
  250.                       Const PropName   : String;
  251.                             PropValue  : Boolean) : Boolean;
  252. Var
  253.     PropInfo  : PPropInfo;
  254.     PValue    : Integer;
  255. begin
  256.   PValue:=Ord(PropValue);
  257.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  258.   If Result then
  259.     SetOrdProp(TObJect(AComponent),PropInfo,PValue);
  260.  
  261. end;
  262. Function E_SetRealProp(      AComponent : TComponent;
  263.                        Const PropName   : String;
  264.                             PropValue   : Double) : Boolean;
  265. Var
  266.     PropInfo  : PPropInfo;
  267. begin
  268.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  269.   If Result then
  270.     SetFloatProp(TObJect(AComponent),PropInfo,PropValue);
  271. end;
  272. Function E_SetSetStrProp(      AComponent : TComponent;
  273.                          Const PropName   : String;
  274.                                PropValue  : String) : Boolean;
  275. Var
  276.     PropInfo  : PPropInfo;
  277.     S         : TIntegerSet;
  278.     TypeInfo  : PTypeInfo;
  279.     I         : Integer;
  280.     Tp        : String;
  281. begin
  282.   Result:=E_GetPropInfo(AComponent,PropName,PropInfo);
  283.   If Result then
  284.   begin
  285.     While PropValue<>'' do
  286.     begin
  287.       I:=Pos('[',PropValue);
  288.       If I=0 then
  289.         I:=Pos(']',PropValue);
  290.       If I=0 then
  291.         Break;
  292.       Delete(PropValue,I,1);
  293.     end;
  294.     S:=[];
  295.     TypeInfo:=GetTypeData(PropInfo^.PropType)^.CompType;
  296.     While PropValue<>'' do
  297.     begin
  298.       I:=Pos(',',PropValue);
  299.       If I=0 then
  300.         I:=Succ(Length(PropValue));
  301.       Tp:=Copy(PropValue,1,Pred(I));
  302.       Delete(PropValue,1,I);
  303.       Include(S,GetEnumValue(TypeInfo,Tp));
  304.     end;
  305.     SetOrdProp(TObJect(AComponent),PropInfo,Integer(S));
  306.   end;
  307. end;
  308. (*******************************************************************
  309.                             E_EnumProperties
  310.     Enumerate the properties of a component and return them
  311.     in stringlist Proplist where the string is the property name
  312.     and a TEProperty class associated with the property describes
  313.     how to manipulate the property. NOTE that it is expected that
  314.     PropList has not been created.
  315.  *******************************************************************)
  316. Function E_EnumProperties(    AComponent : TComponent;
  317.                           Var PropList   : TStringList) : Integer;
  318. Var
  319.     PKinds   : TTypeKinds;
  320.     PList    : PPropList;
  321.     PtData   : PTypeData;
  322.     PropInfo : PPropInfo;
  323.     CompProp : TEProperty;
  324.     I,J      : Integer;
  325.     TReal    : Double;
  326.     TInt     : Integer;
  327.     S        : TIntegerSet;
  328.     Ts       : String;
  329.     PCount   : Integer;
  330. begin
  331.   PropList:=Nil;
  332.   PKinds:=[tkInteger, tkChar, tkEnumeration, tkFloat,tkString, tkSet, tkClass, tkLString];
  333.   Result:=GetPropList(AComponent.ClassInfo,PKinds,Nil);
  334.   If Result>0 then
  335.   begin
  336.     GetMem(PList,Result * SizeOf(Pointer));
  337.     Try
  338.        Result:=GetPropList(AComponent.ClassInfo,PKinds,PList);
  339.        If Result>0 then
  340.        begin
  341.          PropList:=TStringList.Create;
  342.          for I := 0 to result - 1 do
  343.          begin
  344.            PropInfo := PList^[I];
  345.            CompProp:=TEProperty.Create;
  346.            With CompProp do
  347.            begin
  348.              TypeInfo:=PropInfo^.PropType;
  349.              MinVal:=0;
  350.              MaxVal:=0;
  351.              ClassAddr:=0;
  352.              MaxChars:=0;
  353.              SubType:=0;
  354.            end;
  355.            With PropInfo^,PropType^ do
  356.            begin
  357.              If Kind<>tkClass then  {Acts screwy for some reason}
  358.                PtData:=GetTypeData(PropType);
  359.              Case Kind Of
  360.                tkFloat       : begin
  361.                                  TReal:=GetFloatProp(TObJect(AComponent),PropInfo);
  362.                                  With CompProp do
  363.                                  begin
  364.                                    EType:=PROP_REALTYPE;
  365.                                    Case PtData^.FloatType Of
  366.                                      ftSingle : MaxChars:=8;
  367.                                      ftDouble : MaxChars:=16;
  368.                                    else
  369.                                      MaxChars:=20;
  370.                                    end;
  371.                                    PValue:=FloatToStrF(TReal,ffGeneral,MaxChars,0);
  372.                                    MaxChars:=22; {For -&. in edit}
  373.                                  end;
  374.                                end;
  375.                tkChar        : begin
  376.                                  TInt:=GetOrdProp(TObJect(AComponent),PropInfo);
  377.                                  With CompProp do
  378.                                  begin
  379.                                    If (TInt<32) OR (TInt>127) then
  380.                                      PValue:='#'+IntToStr(TInt)
  381.                                    else
  382.                                      PValue:=''+Chr(TInt);
  383.                                    EType:=PROP_CHARTYPE;
  384.                                    MaxChars:=4;
  385.                                  end;
  386.                                end;
  387.                tkString      ,
  388.                tkLString     : With CompProp do
  389.                                begin
  390.                                  EType:=PROP_STRTYPE;
  391.                                  If Kind=tkString then
  392.                                    MaxChars:=PtData^.MaxLength;
  393.                                  If PropInfo^.Name='Name' then
  394.                                    MaxChars:=63;
  395.                                  PValue:=UpperCase(PropInfo.Name);
  396.                                  If AComponent IS TTable then
  397.                                  begin
  398.                                    If Pvalue='DATABASENAME' then
  399.                                      EType:=PROP_DBNAMETYPE
  400.                                    else If PValue='INDEXNAME' then
  401.                                      EType:=PROP_DBIDXNAMETYPE
  402.                                    else If PValue='TABLENAME' then
  403.                                      EType:=PROP_DBTABNAMETYPE;
  404.                                  end
  405.                                  else If (Pvalue='LOOKUPFIELD') OR (PValue='LOOKUPDISPLAY') then
  406.                                    EType:=PROP_DBLOOKUPFIELD;
  407.                                  PValue:=GetStrProp(TObJect(AComponent),PropInfo);
  408.                                end;
  409.                tkEnumeration : begin
  410.                                  TInt:=GetOrdProp(TObJect(AComponent),PropInfo);
  411.                                  With CompProp do If UpperCase(Name)='BOOLEAN' then
  412.                                  begin
  413.                                    If TInt=0 then
  414.                                      PValue:='False'
  415.                                    else
  416.                                      PValue:='True';
  417.                                    EType:=PROP_BOOLTYPE;
  418.                                  end
  419.                                  else
  420.                                  begin
  421.                                    PValue:=GetEnumName(PropType,TInt);
  422.                                    MinVal:=PtData^.MinValue;
  423.                                    MaxVal:=PtData^.MaxValue;
  424.                                    EType:=PROP_ENUMTYPE;
  425.                                  end;
  426.                                end;
  427.                tkInteger     : With CompProp do
  428.                                begin
  429.                                  TInt:=GetOrdProp(TObJect(AComponent),PropInfo);
  430.                                  PValue:=UpperCase(PropInfo.Name);
  431.                                  If Pos('COLOR',PValue)>0 then
  432.                                  begin
  433.                                    PValue:=ColorToString(TColor(TInt));
  434.                                    EType:=PROP_COLORTYPE;
  435.                                  end
  436.                                  else If Pos('CURSOR',PValue)>0 then
  437.                                  begin
  438.                                    PValue:=CursorToString(TCursor(TInt));
  439.                                    EType:=PROP_CURSORTYPE;
  440.                                  end
  441.                                  else
  442.                                  begin
  443.                                    PValue:=IntToStr(TInt);
  444.                                    EType:=PROP_INTTYPE;
  445.                                    If (PtData<>Nil) then
  446.                                    begin
  447.                                      MinVal:=PtData^.MinValue;
  448.                                      MaxVal:=PtData^.MaxValue;
  449.                                    end;
  450.                                    Case PtData^.OrdType Of
  451.                                      otSByte : MaxChars:=4;
  452.                                      otUByte : MaxChars:=3;
  453.                                      otSWord : MaxChars:=6;
  454.                                      otUWord : MaxChars:=5;
  455.                                      otSLong : MaxChars:=11;
  456.                                    end;
  457.                                  end;
  458.                                end;
  459.                tkSet          : With CompProp do
  460.                                 begin
  461.                                   EType:=PROP_SETTYPE;
  462.                                   TypeInfo:=ptData^.CompType;
  463.                                   PtData:=GetTypeData(TypeInfo);
  464.                                   MinVal:=PtData^.MinValue;
  465.                                   MaxVal:=PtData^.MaxValue;
  466.                                   Integer(S):=GetOrdProp(TObJect(AComponent),PropInfo);
  467.                                   CompProp.PValue := '[';
  468.                                   for J := MinVal to MaxVal do
  469.                                     if J IN S then
  470.                                     begin
  471.                                       if Length(PValue) <> 1 then
  472.                                         PValue := PValue + ',';
  473.                                       PValue := PValue + GetEnumName(TypeInfo,J);
  474.                                     end;
  475.                                   PValue := PValue + ']';
  476.                                 end;
  477.                tkClass        : With CompProp do
  478.                                 begin
  479.                                   EType:=PROP_CLASSTYPE;
  480.                                   Ts:=UpperCase(PropType^.Name);
  481.                                   PValue:='('+PropType^.Name+')';
  482.                                   ClassAddr:=GetOrdProp(AComponent,PropInfo);
  483.                                   If Ts = 'TFONT' then
  484.                                   begin
  485.                                     SubType:=PROP_FONTSUB;
  486.                                     If ClassAddr>0 then
  487.                                       PValue:=TFont(ClassAddr).Name;
  488.                                   end
  489.                                   else If Ts = 'TICON' then
  490.                                     SubType:=PROP_ICONSUB
  491.                                   else If Ts = 'TBITMAP' then
  492.                                     SubType:=PROP_BMPSUB
  493.                                   else If Ts = 'TSTRINGS' then
  494.                                     SubType:=PROP_TSTRSUB
  495.                                   else If (Ts='TDATASET') OR (Ts='TTABLE') then
  496.                                   begin
  497.                                     If ClassAddr>0 then
  498.                                       PValue:=TTable(ClassAddr).Name
  499.                                     else
  500.                                       PValue:='';
  501.                                     SubType:=PROP_DATASETSUB;
  502.                                   end
  503.                                   else If (Ts='TDATASOURCE') then
  504.                                   begin
  505.                                     If ClassAddr>0 then
  506.                                       PValue:=TDataSource(ClassAddr).Name
  507.                                     else
  508.                                       PValue:='';
  509.                                     SubType:=PROP_DATASOURCESUB;
  510.                                   end
  511.                                   else
  512.                                   begin
  513.                                     PCount :=0; {Does It Have Some Properties?}
  514.                                     If ClassAddr>0 then
  515.                                       Try
  516.                                         PCount:=GetPropList(TComponent(ClassAddr).ClassInfo,PKinds,Nil);
  517.                                       Except
  518.                                         PCount:=0;
  519.                                       end;
  520.                                     If PCount<1 then {Just Show It!}
  521.                                     begin
  522.                                       EType:=PROP_NOTYPE;
  523.                                       PValue:='*'+PropType^.Name+'*';
  524.                                     end;
  525.                                   end;
  526.                                 end;
  527.              end;
  528.            end;
  529.            PropList.AddObject(PropInfo^.Name,CompProp);
  530.          end;
  531.        end;
  532.     Finally
  533.       If Result>0 then
  534.         FreeMem(PList,Result*SizeOf(Pointer));
  535.     end;
  536.   end;
  537. end;
  538. (*******************************************************************
  539.                             E_GetEnumList
  540.     Get a string list representing the values of a set type or
  541.     an enumerated type property. NOTE that it is expected AList has
  542.     already been created.
  543.  *******************************************************************)
  544. Function E_GetEnumList(      CompProp : TEProperty;
  545.                              AList    : TStrings) : Boolean;
  546. Var
  547.     I        : Integer;
  548. begin
  549.   AList.Clear;
  550.   Result:=False;
  551.   If CompProp=Nil then
  552.     Exit;
  553.   If CompProp.EType=PROP_BOOLTYPE then
  554.   begin
  555.     AList.Add('True');
  556.     AList.Add('False');
  557.   end
  558.   else For I:=CompProp.MinVal to CompProp.MaxVal do
  559.     AList.Add(GetEnumName(CompProp.TypeInfo,I));
  560.   Result:=True;
  561. end;
  562. {-------------------------END OF FILE---------------------------------}
  563. end.
  564.  
  565.  
  566.