diff --git a/compbrowser/comp_browser_main.lfm b/compbrowser/comp_browser_main.lfm
index 11b745e..e953c05 100644
--- a/compbrowser/comp_browser_main.lfm
+++ b/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
diff --git a/compbrowser/comp_browser_main.pas b/compbrowser/comp_browser_main.pas
index b25c1cb..1b08956 100644
--- a/compbrowser/comp_browser_main.pas
+++ b/compbrowser/comp_browser_main.pas
@@ -5,30 +5,41 @@ unit comp_browser_main;
interface
uses
- Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus, Buttons,
- StdCtrls, ExtCtrls, ActnList, MaskEdit, grids, CheckLst, PairSplitter, ColorBox,
- ValEdit, SynHighlighterPosition, strutils, SynEdit, typinfo;
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus,
+ Buttons, StdCtrls, ExtCtrls, ActnList, MaskEdit, grids, CheckLst, PairSplitter,
+ 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;
- procedure LoadTreeView;
- function GetComponentClass(aPage: TPalettePage; anIndex: word): 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
end;
const
- MaxComponentsOnAPage = 21; // AdditionalPage
- PageNames : array[TPalettePage] of shortstring =
- ('Standard', 'Additional', 'Other unlisted pages');
+ MaxComponentsOnAPage = 21; // AdditionalPage
+ PageNames : array[TPalettePage] of shortstring =
+ ('Standard', 'Additional', 'Common Controls', 'Other unlisted pages');
var
Form1: TForm1;
@@ -41,86 +52,316 @@ 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;
- i: integer;
+ palPage: TPalettePage;
+ i: integer;
begin
tvComps.BeginUpdate;
- for palPage := High(TPalettePage) downto Low(TPalettePage) do
- begin
- aNode := tvComps.Items.AddFirst(nil, PageNames[palPage]);
- for i := 1 to MaxComponentsOnAPage do
- begin
- compClass := GetComponentClass(palPage, i);
- if Assigned(compClass) then
- tvComps.Items.AddChildObject(
- aNode,
- compClass.ClassName,
- TObject(compClass)
- );
+ for palPage := High(TPalettePage) downto Low(TPalettePage) do
+ begin
+ aNode := tvComps.Items.AddFirst(nil, PageNames[palPage]);
+ for i := 1 to MaxComponentsOnAPage do
+ begin
+ compClass := GetComponentClass(palPage, i);
+ if Assigned(compClass) then
+ tvComps.Items.AddChildObject(
+ aNode,
+ compClass.ClassName,
+ TObject(compClass)
+ );
end;
end;
- tvComps.EndUpdate;
- tvComps.Selected := tvComps.Items[0];
+ tvComps.EndUpdate;
+ 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
+ aPage: TPalettePage;
+ anIndex: word
): TComponentClass;
begin
case aPage of
- ppStandard: case anIndex of
- 1: result := TMainMenu;
- 2: result := TPopupMenu;
- 3: result := TButton;
- 4: result := TLabel;
- 5: result := TEdit;
- 6: result := TMemo;
- 7: result := TToggleBox;
- 8: result := TCheckBox;
- 9: result := TRadioButton;
- 10: result := TListBox;
- 11: result := TComboBox;
- 12: result := TScrollBar;
- 13: result := TGroupBox;
- 14: result := TRadioGroup;
- 15: result := TCheckGroup;
- 16: result := TPanel;
- 17: result := TFrame;
- 18: result := TActionList;
- else result := nil;
+ ppStandard: case anIndex of
+ 1: result := TMainMenu;
+ 2: result := TPopupMenu;
+ 3: result := TButton;
+ 4: result := TLabel;
+ 5: result := TEdit;
+ 6: result := TMemo;
+ 7: result := TToggleBox;
+ 8: result := TCheckBox;
+ 9: result := TRadioButton;
+ 10: result := TListBox;
+ 11: result := TComboBox;
+ 12: result := TScrollBar;
+ 13: result := TGroupBox;
+ 14: result := TRadioGroup;
+ 15: result := TCheckGroup;
+ 16: result := TPanel;
+ 17: result := TFrame;
+ 18: result := TActionList;
+ else result := nil;
end;
- ppAdditional: case anIndex of
- 1: result := TBitBtn;
- 2: result := TSpeedbutton;
- 3: result := TStaticText;
- 4: result := TImage;
- 5: result := TShape;
- 6: result := TBevel;
- 7: result := TPaintBox;
- 8: result := TNotebook;
- 9: result := TlabeledEdit;
- 10: result := TSplitter;
- 11: result := TTrayIcon;
- 12: result := TMaskEdit;
- 13: result := TCheckListBox;
- 14: result := TScrollBox;
- 15: result := TApplicationProperties;
- 16: result := TStringGrid;
- 17: result := TDrawGrid;
- 18: result := TPairSplitter;
- 19: result := TColorBox;
- 20: result := TColorListBox;
- 21: result := TValueListEditor;
- else result := nil;
+ ppAdditional: case anIndex of
+ 1: result := TBitBtn;
+ 2: result := TSpeedbutton;
+ 3: result := TStaticText;
+ 4: result := TImage;
+ 5: result := TShape;
+ 6: result := TBevel;
+ 7: result := TPaintBox;
+ 8: result := TNotebook;
+ 9: result := TlabeledEdit;
+ 10: result := TSplitter;
+ 11: result := TTrayIcon;
+ 12: result := TMaskEdit;
+ 13: result := TCheckListBox;
+ 14: result := TScrollBox;
+ 15: result := TApplicationProperties;
+ 16: result := TStringGrid;
+ 17: result := TDrawGrid;
+ 18: result := TPairSplitter;
+ 19: result := TColorBox;
+ 20: result := TColorListBox;
+ 21: result := TValueListEditor;
+ else result := nil;
end;
- else result := nil;
+ 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;
diff --git a/compbrowser/compbrowser.lpi b/compbrowser/compbrowser.lpi
index 7394c66..d5d077d 100644
--- a/compbrowser/compbrowser.lpi
+++ b/compbrowser/compbrowser.lpi
@@ -25,13 +25,16 @@
-
+
-
+
-
+
+
+
+
diff --git a/compbrowser/compbrowser.lpr b/compbrowser/compbrowser.lpr
index bb1b1e0..c882884 100644
--- a/compbrowser/compbrowser.lpr
+++ b/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}