Finish Component Browser example, with additional page of components

compbrowser/comp_browser_main.lfm

@@ -15,6 +15,7 @@ object Form1: TForm1
     Width = 210
     Align = alLeft
     TabOrder = 0
+    OnChange = tvCompsChange
   end
   inline seViewer: TSynEdit
     Left = 210

compbrowser/comp_browser_main.pas

@@ -5,21 +5,32 @@ unit comp_browser_main;
 interface
 
 uses
-	Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus, Buttons,
+	Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus,
-  StdCtrls, ExtCtrls, ActnList, MaskEdit, grids, CheckLst, PairSplitter, ColorBox,
+	Buttons, StdCtrls, ExtCtrls, ActnList, MaskEdit, grids, CheckLst, PairSplitter,
-  ValEdit, SynHighlighterPosition, strutils, SynEdit, typinfo;
+	ColorBox, ValEdit, SynHighlighterPosition, strutils, SynEdit, DateTimePicker,
+	PopupNotifier, typinfo;
 
 type
-	TPalettePage = (ppStandard, ppAdditional, ppOtherPagesNotListedHere);
+	TPalettePage = (ppStandard, ppAdditional, ppCommonControls, ppOtherPagesNotListedHere);
 	{ TForm1 }
 
  TForm1 = class(TForm)
 		seViewer: TSynEdit;
 		tvComps: TTreeView;
 		procedure FormCreate(Sender: TObject);
+		procedure tvCompsChange(Sender: TObject; Node: TTreeNode);
 	private
 		compClass: TComponentClass;
+		Hiliter: TSynPositionHighlighter;
+		atrUL, atrBD: TtkTokenKind;
+		lineNo: integer;
 		procedure LoadTreeView;
+		procedure DisplayComponentInfo(aNode: TTreeNode);
+		procedure DisplayPageInfo(aNode: TTreeNode);
+		procedure DisplayComponentData;
+		procedure DisplayComponentHierarchy(aNode: TTreeNode);
+		procedure DisplayComponentProperties;
+		function GetAncestorCount(aClass: TClass): integer;
 		function GetComponentClass(aPage: TPalettePage; anIndex: word): TComponentClass;
 	public
 
@@ -28,7 +39,7 @@ type
  const
 	 MaxComponentsOnAPage = 21; // AdditionalPage
 	 PageNames : array[TPalettePage] of shortstring =
-     ('Standard', 'Additional', 'Other unlisted pages');
+		 ('Standard', 'Additional', 'Common Controls', 'Other unlisted pages');
 
 var
 	Form1: TForm1;
@@ -41,9 +52,18 @@ implementation
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
+	hiliter := TSynPositionHighlighter.Create(Self);
+	seViewer.Highlighter := hiliter;
+	atrUL := hiliter.CreateTokenID('atrUL', clBlue, clNone, [fsBold, fsUnderline]);
+	atrBD := hiliter.CreateTokenID('atrBD', clBlack, clNone, [fsBold]);
 	LoadTreeView;
 end;
 
+procedure TForm1.tvCompsChange(Sender: TObject; Node: TTreeNode);
+begin
+	DisplayComponentInfo(Node);
+end;
+
 procedure TForm1.LoadTreeView;
 var aNode: TTreeNode;
 	palPage: TPalettePage;
@@ -69,6 +89,210 @@ begin
 	tvComps.Selected := tvComps.Items[0];
 end;
 
+procedure TForm1.DisplayComponentInfo(aNode: TTreeNode);
+begin
+	seViewer.Lines.Clear;
+	hiliter.ClearAllTokens;
+	lineNo := 0;
+
+	case aNode.Level of
+		0: begin
+			seViewer.Lines.Add('');
+			seViewer.Lines.Add(' (' + aNode.Text + ' Page)');
+		end
+		else
+			begin
+				compClass := TComponentClass(aNode.Data);
+				DisplayPageInfo(aNode);
+				DisplayComponentData;
+				DisplayComponentHierarchy(aNode);
+				DisplayComponentProperties;
+			end;
+	end;
+end;
+
+procedure TForm1.DisplayPageInfo(aNode: TTreeNode);
+var s: string;
+begin
+	seViewer.Lines.Add('');
+	inc(lineNo);
+
+	s := ' Palette Page: ' + aNode.Parent.Text;
+
+	hiliter.AddToken(lineNo, 1, tkText);
+	hiliter.AddToken(lineNo, Length(s), atrUL);
+
+	seViewer.Lines.Add(s);
+	inc(lineNo);
+
+	seViewer.Lines.Add('');
+	inc(lineNo);
+end;
+
+procedure TForm1.DisplayComponentData;
+var st: string;
+begin
+	st := ' ' + compClass.ClassName;
+
+	HiLiter.AddToken(lineNo, 1, tkText);
+	HiLiter.AddToken(lineNo, Length(st), atrUL);
+
+	seViewer.Lines.Add(st);
+	inc(lineNo);
+
+	seViewer.Lines.Add('');
+	inc(lineNo);
+
+	seViewer.Lines.Add(
+		Format(' ''%s'' is declared in the %s unit', [
+			compClass.ClassName,
+			compClass.UnitName
+		])
+	);
+	inc(lineNo);
+
+	seViewer.Lines.Add(
+		Format(' InstanceSize is : %d bytes', [compClass.InstanceSize])
+	);
+	inc(lineNo);
+
+	seViewer.Lines.Add('');
+	inc(lineNo);
+end;
+
+procedure TForm1.DisplayComponentHierarchy(aNode: TTreeNode);
+var
+	sl: TStringList;
+	step: integer = 1;
+	ancestorCount : integer = 0;
+	i: integer;
+	s: string;
+	aClass: TClass;
+
+	function Plural(aCount: integer): string;
+	begin
+		case aCount of
+			1: result := '';
+			else result := 'es';
+		end;
+	end;
+
+begin
+	ancestorCount := GetAncestorCount(compClass);
+	s := Format(
+		' %s class hierarchy [%d ancestor class%s]',
+		[compClass.ClassName, ancestorCount, Plural(ancestorCount)]
+	);
+
+	hiliter.AddToken(lineNo, 1, tkText);
+	hiliter.AddToken(lineNo, Length(s), atrBD);
+	seViewer.Lines.Add(s);
+	inc(lineNo);
+
+	aClass := TClass(aNode.Data);
+
+	if Assigned(aClass.ClassParent) then
+		begin
+			sl := TStringList.Create;
+			try
+				while Assigned(aClass.ClassParent) do
+					begin
+						sl.Add(DupeString(' ', step) + aClass.ClassName);
+						aClass := aClass.ClassParent;
+						inc(step, 2);
+					end;
+
+				sl.Add(DupeString(' ', step) + aClass.ClassName);
+				for i := sl.Count -1 downto 0 do
+					begin
+						seViewer.Lines.Add(sl[i]);
+						inc(lineNo);
+					end;
+			finally
+				sl.Free;
+			end;
+		end
+	else
+		begin
+			seViewer.Lines.Add('    (No parent class)');
+			inc(lineNo);
+		end;
+end;
+
+procedure TForm1.DisplayComponentProperties;
+var
+	aPPI: PPropInfo;
+	aPTI: PTypeInfo;
+	aPTD: PTypeData;
+	aPropList: PPropList;
+	sortSL: TStringList;
+	i: integer;
+	s: string;
+begin
+	seViewer.Lines.Add('');
+	inc(LineNo);
+
+	aPTI := PTypeInfo(compClass.ClassInfo);
+	aPTD := GetTypeData(aPTI);
+	s := Format(
+		' %s has %d published properties:',
+		[aPTI^.Name, aPTD^.PropCount]
+	);
+
+	hiliter.AddToken(lineNo, 1, tkText);
+	hiliter.AddToken(lineNo, Length(s), atrBD);
+
+	seViewer.Lines.Add(s);
+	inc(lineNo);
+
+	if (aPTD^.PropCount = 0)
+		then seViewer.Lines.Add('    (no published properties)')
+	else
+		begin
+			GetMem(aPropList, SizeOf(PPropInfo^) * aPTD^.PropCount);
+			sortSL := TStringList.Create;
+			sortSL.Sorted := true;
+
+			try
+				GetPropInfos(aPTI, aPropList);
+				for i := 0 to aPTD^.PropCount - 1 do
+					begin
+						aPPI := aPropList^[i];
+						sortSL.AddObject(Format(
+							' %s: %s',
+							[aPPI^.Name, aPPI^.PropType^.Name]
+						), TObject(Pointer(Length(aPPI^.Name))));
+					end;
+
+				for i := 0 to sortSL.Count - 1 do
+					begin
+						seViewer.Lines.Add(sortSL[i]);
+						hiliter.AddToken(lineNo, Succ(Integer(Pointer(sortSL.Objects[i]))), atrBD);
+						hiliter.AddToken(lineNo, Length(sortSL[i]), tkText);
+						inc(lineNo);
+					end;
+			finally
+				FreeMem(aPropList, SizeOf(PPropInfo) * aPTD^.PropCount);
+				sortSL.Free;
+			end;
+		end;
+end;
+
+function TForm1.GetAncestorCount(aClass: TClass): integer;
+begin
+	result := 0;
+	if not Assigned(aClass.ClassParent)
+		then Exit
+	else
+		begin
+			while Assigned(aClass.ClassParent) do
+				begin
+					inc(result);
+					aClass := aClass.ClassParent;
+				end;
+		end;
+end;
+
 function TForm1.GetComponentClass(
 	aPage: TPalettePage;
 	anIndex: word
@@ -120,6 +344,23 @@ begin
 			21: result := TValueListEditor;
 			else result := nil;
 		end;
+		ppCommonControls: case anIndex of
+			1: result := TTrackBar;
+			2: result := TProgressBar;
+			3: result := TTreeView;
+			4: result := TListView;
+			5: result := TStatusBar;
+			6: result := TToolBar;
+			7: result := TCoolBar;
+			8: result := TUpDown;
+			9: result := TPageControl;
+			10: result := TTabControl;
+			11: result := THeaderControl;
+			12: result := TImageList;
+			13: result := TPopupNotifier;
+			14: result := TDateTimePicker;
+			else result := nil;
+		end;
 		else result := nil;
 	end;
 end;

compbrowser/compbrowser.lpi

@@ -25,13 +25,16 @@
       <FormatVersion Value="2"/>
       <Modes Count="0"/>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="3">
       <Item1>
-        <PackageName Value="SynEdit"/>
+        <PackageName Value="DateTimeCtrls"/>
       </Item1>
       <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="SynEdit"/>
       </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
     </RequiredPackages>
     <Units Count="2">
       <Unit0>

compbrowser/compbrowser.lpr

@@ -7,7 +7,7 @@ uses
 	cthreads,
 	{$ENDIF}{$ENDIF}
 	Interfaces, // this includes the LCL widgetset
-	Forms, comp_browser_main
+	Forms, datetimectrls, comp_browser_main
 	{ you can add units after this };
 
 {$R *.res}