tutorials
/
lazarus-tutorials
1
0
Fork 0
Code Releases Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compbrowser/comp_browser_main.lfm
View File

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

383
compbrowser/comp_browser_main.pas
View File

@ -5,30 +5,41 @@ unit comp_browser_main;
interface interface
uses 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 type
TPalettePage = (ppStandard, ppAdditional, ppOtherPagesNotListedHere); TPalettePage = (ppStandard, ppAdditional, ppCommonControls, ppOtherPagesNotListedHere);
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
seViewer: TSynEdit; seViewer: TSynEdit;
tvComps: TTreeView; tvComps: TTreeView;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure tvCompsChange(Sender: TObject; Node: TTreeNode);
private private
compClass: TComponentClass; compClass: TComponentClass;
procedure LoadTreeView; Hiliter: TSynPositionHighlighter;
function GetComponentClass(aPage: TPalettePage; anIndex: word): TComponentClass; 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 public
end; end;
const const
MaxComponentsOnAPage = 21; // AdditionalPage MaxComponentsOnAPage = 21; // AdditionalPage
PageNames : array[TPalettePage] of shortstring = PageNames : array[TPalettePage] of shortstring =
('Standard', 'Additional', 'Other unlisted pages'); ('Standard', 'Additional', 'Common Controls', 'Other unlisted pages');
var var
Form1: TForm1; Form1: TForm1;
@ -41,86 +52,316 @@ implementation
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
hiliter := TSynPositionHighlighter.Create(Self);
seViewer.Highlighter := hiliter;
atrUL := hiliter.CreateTokenID('atrUL', clBlue, clNone, [fsBold, fsUnderline]);
atrBD := hiliter.CreateTokenID('atrBD', clBlack, clNone, [fsBold]);
LoadTreeView; LoadTreeView;
end; end;
procedure TForm1.tvCompsChange(Sender: TObject; Node: TTreeNode);
begin
DisplayComponentInfo(Node);
end;
procedure TForm1.LoadTreeView; procedure TForm1.LoadTreeView;
var aNode: TTreeNode; var aNode: TTreeNode;
palPage: TPalettePage; palPage: TPalettePage;
i: integer; i: integer;
begin begin
tvComps.BeginUpdate; tvComps.BeginUpdate;
for palPage := High(TPalettePage) downto Low(TPalettePage) do for palPage := High(TPalettePage) downto Low(TPalettePage) do
begin begin
aNode := tvComps.Items.AddFirst(nil, PageNames[palPage]); aNode := tvComps.Items.AddFirst(nil, PageNames[palPage]);
for i := 1 to MaxComponentsOnAPage do for i := 1 to MaxComponentsOnAPage do
begin begin
compClass := GetComponentClass(palPage, i); compClass := GetComponentClass(palPage, i);
if Assigned(compClass) then if Assigned(compClass) then
tvComps.Items.AddChildObject( tvComps.Items.AddChildObject(
aNode, aNode,
compClass.ClassName, compClass.ClassName,
TObject(compClass) TObject(compClass)
); );
end; end;
end; end;
tvComps.EndUpdate; tvComps.EndUpdate;
tvComps.Selected := tvComps.Items[0]; 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; end;
function TForm1.GetComponentClass( function TForm1.GetComponentClass(
aPage: TPalettePage; aPage: TPalettePage;
anIndex: word anIndex: word
): TComponentClass; ): TComponentClass;
begin begin
case aPage of case aPage of
ppStandard: case anIndex of ppStandard: case anIndex of
1: result := TMainMenu; 1: result := TMainMenu;
2: result := TPopupMenu; 2: result := TPopupMenu;
3: result := TButton; 3: result := TButton;
4: result := TLabel; 4: result := TLabel;
5: result := TEdit; 5: result := TEdit;
6: result := TMemo; 6: result := TMemo;
7: result := TToggleBox; 7: result := TToggleBox;
8: result := TCheckBox; 8: result := TCheckBox;
9: result := TRadioButton; 9: result := TRadioButton;
10: result := TListBox; 10: result := TListBox;
11: result := TComboBox; 11: result := TComboBox;
12: result := TScrollBar; 12: result := TScrollBar;
13: result := TGroupBox; 13: result := TGroupBox;
14: result := TRadioGroup; 14: result := TRadioGroup;
15: result := TCheckGroup; 15: result := TCheckGroup;
16: result := TPanel; 16: result := TPanel;
17: result := TFrame; 17: result := TFrame;
18: result := TActionList; 18: result := TActionList;
else result := nil; else result := nil;
end; end;
ppAdditional: case anIndex of ppAdditional: case anIndex of
1: result := TBitBtn; 1: result := TBitBtn;
2: result := TSpeedbutton; 2: result := TSpeedbutton;
3: result := TStaticText; 3: result := TStaticText;
4: result := TImage; 4: result := TImage;
5: result := TShape; 5: result := TShape;
6: result := TBevel; 6: result := TBevel;
7: result := TPaintBox; 7: result := TPaintBox;
8: result := TNotebook; 8: result := TNotebook;
9: result := TlabeledEdit; 9: result := TlabeledEdit;
10: result := TSplitter; 10: result := TSplitter;
11: result := TTrayIcon; 11: result := TTrayIcon;
12: result := TMaskEdit; 12: result := TMaskEdit;
13: result := TCheckListBox; 13: result := TCheckListBox;
14: result := TScrollBox; 14: result := TScrollBox;
15: result := TApplicationProperties; 15: result := TApplicationProperties;
16: result := TStringGrid; 16: result := TStringGrid;
17: result := TDrawGrid; 17: result := TDrawGrid;
18: result := TPairSplitter; 18: result := TPairSplitter;
19: result := TColorBox; 19: result := TColorBox;
20: result := TColorListBox; 20: result := TColorListBox;
21: result := TValueListEditor; 21: result := TValueListEditor;
else result := nil; else result := nil;
end; 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;
end; end;

9
compbrowser/compbrowser.lpi
View File

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

2
compbrowser/compbrowser.lpr
View File

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