1
0

Finish Component Browser example, with additional page of components

This commit is contained in:
Timothy Warren 2021-10-13 11:12:50 -04:00
parent 90f6a6756a
commit ae20af005f
4 changed files with 320 additions and 75 deletions

View File

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

View File

@ -5,21 +5,32 @@ 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;
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;

View File

@ -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>

View File

@ -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}