426 lines
9.6 KiB
ObjectPascal
426 lines
9.6 KiB
ObjectPascal
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;
|
|
|
|
type
|
|
TPalettePage = (
|
|
ppStandard,
|
|
ppAdditional,
|
|
ppCommonControls,
|
|
ppDialogs,
|
|
ppMisc,
|
|
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
|
|
|
|
end;
|
|
|
|
const
|
|
MaxComponentsOnAPage = 21; // AdditionalPage
|
|
PageNames : array[TPalettePage] of shortstring =
|
|
('Standard', 'Additional', 'Common Controls', 'Dialogs', 'Misc', 'Other unlisted pages');
|
|
|
|
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]);
|
|
LoadTreeView;
|
|
end;
|
|
|
|
procedure TForm1.tvCompsChange(Sender: TObject; Node: TTreeNode);
|
|
begin
|
|
DisplayComponentInfo(Node);
|
|
end;
|
|
|
|
procedure TForm1.LoadTreeView;
|
|
var aNode: TTreeNode;
|
|
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)
|
|
);
|
|
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;
|
|
end;
|
|
|
|
function TForm1.GetComponentClass(
|
|
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;
|
|
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;
|
|
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;
|
|
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|