Finish Component Browser example, with additional page of components
This commit is contained in:
Timothy Warren
parent
90f6a6756a
commit
ae20af005f
@ -15,6 +15,7 @@ object Form1: TForm1
|
||||
Width = 210
|
||||
Align = alLeft
|
||||
TabOrder = 0
|
||||
OnChange = tvCompsChange
|
||||
end
|
||||
inline seViewer: TSynEdit
|
||||
Left = 210
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user