home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / packages / AddInPackage / AddInFormU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-05  |  7.6 KB  |  255 lines
  1. unit AddInFormU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, ExtCtrls, Grids;
  8.  
  9. type
  10.   TObjectBrowserForm = class(TForm)
  11.     Splitter1: TSplitter;
  12.     Splitter2: TSplitter;
  13.     TvOwnerHierarchy: TTreeView;
  14.     Label1: TLabel;
  15.     BtnUpdate: TButton;
  16.     GrdProp: TStringGrid;
  17.     TCPropType: TTabControl;
  18.     Label2: TLabel;
  19.     TvChildrenHierarchy: TTreeView;
  20.     Splitter3: TSplitter;
  21.     Label3: TLabel;
  22.     TvClassHierarchy: TTreeView;
  23.     procedure FormShow(Sender: TObject);
  24.     procedure BtnUpdateClick(Sender: TObject);
  25.     procedure TvOwnerHierarchyChange(Sender: TObject; Node: TTreeNode);
  26.     procedure TCPropTypeChange(Sender: TObject);
  27.   private
  28.     { Private declarations }
  29.     procedure ListComponents(Root: TComponent; RootNode: TTreeNode);
  30.     procedure ListChildren(Control: TWinControl; RootNode: TTreeNode);
  31.     procedure ListClasses(Comp: TComponent);
  32.   public
  33.     { Public declarations }
  34.     procedure ShowChildrenHierarchy(Comp: TComponent);
  35.     procedure ShowClassHierarchy(Comp: TComponent);
  36.     procedure ShowProperties(Comp: TComponent);
  37.   end;
  38.  
  39. var
  40.   ObjectBrowserForm: TObjectBrowserForm;
  41.  
  42. implementation
  43.  
  44. uses
  45.   TypInfo, Menus;
  46.  
  47. {$R *.DFM}
  48.  
  49. procedure TObjectBrowserForm.FormShow(Sender: TObject);
  50. begin
  51.   BtnUpdate.Click;
  52. end;
  53.  
  54. procedure TObjectBrowserForm.ListComponents(Root: TComponent; RootNode: TTreeNode);
  55. var
  56.   Loop: Integer;
  57. begin
  58.   for Loop := 0 to Root.ComponentCount - 1 do
  59.     ListComponents(
  60.       Root.Components[Loop],
  61.       TvOwnerHierarchy.Items.AddChildObject(
  62.         RootNode,
  63.         Format('%s (%s)',
  64.           [Root.Components[Loop].Name,
  65.            Root.Components[Loop].ClassName]),
  66.         Root.Components[Loop]))
  67. end;
  68.  
  69. procedure TObjectBrowserForm.BtnUpdateClick(Sender: TObject);
  70. begin
  71.   TvOwnerHierarchy.Items.BeginUpdate;
  72.   TvOwnerHierarchy.Items.Clear;
  73.   ListComponents(
  74.     Application,
  75.     TvOwnerHierarchy.Items.AddObject(
  76.       nil,
  77.       'Application (TApplication)',
  78.       Pointer(Application)));
  79.   TvOwnerHierarchy.FullExpand;
  80.   TvOwnerHierarchy.TopItem := TvOwnerHierarchy.Items[0];
  81.   TvOwnerHierarchy.Items.EndUpdate;
  82. end;
  83.  
  84. procedure TObjectBrowserForm.TvOwnerHierarchyChange(Sender: TObject;
  85.   Node: TTreeNode);
  86. begin
  87.   ShowProperties(TComponent(Node.Data));
  88.   ShowClassHierarchy(TComponent(Node.Data));
  89.   ShowChildrenHierarchy(TComponent(Node.Data))
  90. end;
  91.  
  92. procedure TObjectBrowserForm.ListChildren(Control: TWinControl; RootNode: TTreeNode);
  93. var
  94.   Loop: Integer;
  95.   NewNode: TTreeNode;
  96. begin
  97.   for Loop := 0 to Control.ControlCount - 1 do
  98.   begin
  99.     NewNode := TvChildrenHierarchy.Items.AddChildObject(
  100.       RootNode, Format('%s (%s)',
  101.         [Control.Controls[Loop].Name,
  102.          Control.Controls[Loop].ClassName]),
  103.       Control.Controls[Loop]);
  104.     if Control.Controls[Loop] is TWinControl then
  105.       ListChildren(TWinControl(Control.Controls[Loop]), NewNode);
  106.   end
  107. end;
  108.  
  109. procedure TObjectBrowserForm.ShowChildrenHierarchy(Comp: TComponent);
  110. begin
  111.   TvChildrenHierarchy.Items.BeginUpdate;
  112.   TvChildrenHierarchy.Items.Clear;
  113.   if Comp is TWinControl then
  114.     ListChildren(
  115.       TWinControl(Comp),
  116.       TvChildrenHierarchy.Items.Add(
  117.         nil,
  118.         Format('%s (%s)', [Comp.Name, Comp.ClassName])));
  119.   TvChildrenHierarchy.FullExpand;
  120.   TvChildrenHierarchy.Items.EndUpdate;
  121. end;
  122.  
  123. procedure TObjectBrowserForm.ListClasses(Comp: TComponent);
  124. var
  125.   CurrentClass: TClass;
  126.   OldNode: TTreeNode;
  127. begin
  128.   CurrentClass := Comp.ClassType;
  129.   OldNode := nil;
  130.   while Assigned(CurrentClass) do
  131.   begin
  132.     OldNode := TvClassHierarchy.Items.AddChild(OldNode, CurrentClass.ClassName);
  133.     CurrentClass := CurrentClass.ClassParent
  134.   end
  135. end;
  136.  
  137. procedure TObjectBrowserForm.ShowClassHierarchy(Comp: TComponent);
  138. begin
  139.   TvClassHierarchy.Items.BeginUpdate;
  140.   TvClassHierarchy.Items.Clear;
  141.   ListClasses(Comp);
  142.   TvClassHierarchy.FullExpand;
  143.   TvClassHierarchy.Items.EndUpdate;
  144. end;
  145.  
  146. procedure TObjectBrowserForm.TCPropTypeChange(Sender: TObject);
  147. begin
  148.   ShowProperties(TComponent(TCPropType.Tag))
  149. end;
  150.  
  151. procedure TObjectBrowserForm.ShowProperties(Comp: TComponent);
  152. const
  153.   PropTypes: array[0..1] of TTypeKinds = (tkProperties, tkMethods);
  154.   BitsInAnInteger = SizeOf(Integer) * 8;
  155. type
  156.   TIntegerSet = set of 0..BitsInAnInteger - 1;
  157. var
  158.   Loop: Integer;
  159.   List: TPropList;
  160.   Count: Integer;
  161.   ASet: TIntegerSet;
  162.   ASetMember: Integer;
  163.   AMethod: TMethod;
  164.   AnObject: TObject;
  165.   S: String;
  166. begin
  167.   TCPropType.Tag := Integer(Comp);
  168.   FillChar(List, SizeOf(List), 0);
  169.   Count := GetPropList(
  170.     Comp.ClassInfo, PropTypes[TCPropType.TabIndex], @List);
  171.   GrdProp.RowCount := Count;
  172.   //If you set a grid's row count to 0, it sets it to 1
  173.   if Count = 0 then
  174.   begin
  175.     GrdProp.Cells[0, 0] := '';
  176.     GrdProp.Cells[1, 0] := '';
  177.   end;
  178.   //Loop through properties, getting a text version to display
  179.   for Loop := 0 to Count - 1 do
  180.   begin
  181.     if List[Loop] <> nil then
  182.     begin
  183.       GrdProp.Cells[0, Loop] := List[Loop].Name;
  184.       case List[Loop].PropType^.Kind of
  185.         tkInteger:
  186.         begin
  187.           if List[Loop].Name = 'Color' then
  188.             GrdProp.Cells[1, Loop] := ColorToString(TColor(GetOrdProp(Comp, List[Loop])))
  189.           else
  190.           if (List[Loop].Name = 'Cursor') or (List[Loop].Name = 'DragCursor') then
  191.             GrdProp.Cells[1, Loop] := CursorToString(TCursor(GetOrdProp(Comp, List[Loop])))
  192.           else
  193.           if List[Loop].Name = 'ShortCut' then
  194.             GrdProp.Cells[1, Loop] := ShortCutToText(GetOrdProp(Comp, List[Loop]))
  195.           else
  196.             GrdProp.Cells[1, Loop] := IntToStr(GetOrdProp(Comp, List[Loop]))
  197.         end;
  198.         tkChar, tkWChar:
  199.           GrdProp.Cells[1, Loop] := Chr(GetOrdProp(Comp, List[Loop]));
  200.         tkSet:
  201.         begin
  202.           Integer(ASet) := GetOrdProp(Comp, List[Loop]);
  203.           S := '[';
  204.           for ASetMember := 0 to BitsInAnInteger - 1 do
  205.             if ASetMember in ASet then
  206.             begin
  207.               if Length(S) <> 1 then
  208.                 S := S + ',';
  209.               S := S + GetEnumName(GetTypeData(List[Loop].PropType^)^.CompType^, ASetMember);
  210.             end;
  211.           GrdProp.Cells[1, Loop] := S + ']';
  212.         end;
  213.         tkClass:
  214.         begin
  215.           AnObject := TObject(GetOrdProp(Comp, List[Loop]));
  216.           if Assigned(AnObject) and
  217.              (AnObject is TComponent) and
  218.              (TComponent(AnObject).Name <> '') then
  219.             GrdProp.Cells[1, Loop] := TComponent(AnObject).Name
  220.           else
  221.             GrdProp.Cells[1, Loop] :=
  222.               '(' + GetTypeData(List[Loop].PropType^)^.ClassType.ClassName + ')';
  223.         end;
  224.         tkEnumeration:
  225.           GrdProp.Cells[1, Loop] :=
  226.             GetEnumName(List[Loop].PropType^, GetOrdProp(Comp, List[Loop]));
  227.         tkFloat:
  228.           GrdProp.Cells[1, Loop] :=
  229.             FloatToStr(GetFloatProp(Comp, List[Loop]));
  230.         tkString, tkLString, tkWString:
  231.           GrdProp.Cells[1, Loop] := GetStrProp(Comp, List[Loop]);
  232.         tkMethod:
  233.         begin
  234.           AMethod := GetMethodProp(Comp, List[Loop]);
  235.           if AMethod.Code = nil then
  236.             GrdProp.Cells[1, Loop] := ''
  237.           else
  238.             //If the method was not published, it's name will
  239.             //not be available, so get its address instead
  240.             try
  241.               GrdProp.Cells[1, Loop] :=
  242.                 (TObject(AMethod.Data) as TComponent).MethodName(AMethod.Code)
  243.             except
  244.               GrdProp.Cells[1, Loop] := Format('$%p', [AMethod.Code]);
  245.             end
  246.         end
  247.       end
  248.     end
  249.   end
  250. end;
  251.  
  252. initialization
  253.   RegisterClass(TPanel)
  254. end.
  255.