1
0
lazarus-tutorials/compbrowser/comp_browser_main.pas

426 lines
9.6 KiB
ObjectPascal
Raw Permalink Normal View History

2021-10-12 15:51:51 -04:00
unit comp_browser_main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus,
Buttons, StdCtrls, ExtCtrls, ActnList, MaskEdit, grids, CheckLst, PairSplitter,
ColorBox, ValEdit, SynHighlighterPosition, strutils, SynEdit, DateTimePicker,
PopupNotifier, ExtDlgs, ComboEx, ShellCtrls, PrintersDlgs, Spin, EditBtn,
FileCtrl, Arrow, XMLPropStorage, IniPropStorage, JsonPropStorage,
IDEWindowIntf, ButtonPanel, typinfo;
2021-10-12 15:51:51 -04:00
type
TPalettePage = (
ppStandard,
ppAdditional,
ppCommonControls,
ppDialogs,
ppMisc,
ppOtherPagesNotListedHere
);
2021-10-12 15:51:51 -04:00
{ TForm1 }
TForm1 = class(TForm)
seViewer: TSynEdit;
tvComps: TTreeView;
procedure FormCreate(Sender: TObject);
procedure tvCompsChange(Sender: TObject; Node: TTreeNode);
2021-10-12 15:51:51 -04:00
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;
2021-10-12 15:51:51 -04:00
public
end;
const
MaxComponentsOnAPage = 21; // AdditionalPage
PageNames : array[TPalettePage] of shortstring =
('Standard', 'Additional', 'Common Controls', 'Dialogs', 'Misc', 'Other unlisted pages');
2021-10-12 15:51:51 -04:00
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
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]);
2021-10-12 15:51:51 -04:00
LoadTreeView;
end;
procedure TForm1.tvCompsChange(Sender: TObject; Node: TTreeNode);
begin
DisplayComponentInfo(Node);
end;
2021-10-12 15:51:51 -04:00
procedure TForm1.LoadTreeView;
var aNode: TTreeNode;
palPage: TPalettePage;
i: integer;
2021-10-12 15:51:51 -04:00
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)
);
2021-10-12 15:51:51 -04:00
end;
end;
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;
2021-10-12 15:51:51 -04:00
end;
function TForm1.GetComponentClass(
aPage: TPalettePage;
anIndex: word
2021-10-12 15:51:51 -04:00
): 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;
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;
2021-10-12 15:51:51 -04:00
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;
2021-10-12 15:51:51 -04:00
end;
ppDialogs: case anIndex of
1: result := TOpenDialog;
2: result := TSaveDialog;
3: result := TSelectDirectoryDialog;
4: result := TColorDialog;
5: result := TFontDialog;
6: result := TFindDialog;
7: result := TReplaceDialog;
8: result := TTaskDialog;
9: result := TOpenPictureDialog;
10: result := TSavePictureDialog;
11: result := TCalendarDialog;
12: result := TCalculatorDialog;
13: result := TPrinterSetupDialog;
14: result := TPrintDialog;
15: result := TPageSetupDialog;
else result := nil;
end;
ppMisc: case anIndex of
1: result := TColorButton;
2: result := TSpinEdit;
3: result := TFloatSpinEdit;
4: result := TArrow;
5: result := TEditButton;
6: result := TFileNameEdit;
7: result := TDirectoryEdit;
8: result := TDateEdit;
9: result := TTimeEdit;
10: result := TCalcEdit;
11: result := TFileListBox;
12: result := TFilterComboBox;
13: result := TComboBoxEx;
14: result := TCheckComboBox;
15: result := TButtonPanel;
16: result := TShellTreeView;
17: result := TShellListView;
18: result := TXMLPropStorage;
19: result := TIniPropStorage;
20: result := TJsonPropStorage;
21: result := TIDEDialogLayoutStorage;
else result := nil;
end;
else result := nil;
2021-10-12 15:51:51 -04:00
end;
end;
end.