paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 02:59:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 47970-47971 #00bdf8baca-#00bdf8baca, 47979 #125625ee6a, 47995 #3555efa582 from trunk:

Browse Source 
IDE: Fix "All Options" parser for FPC 3.x output.
........
IDE: Improve the palette tab in ComponentList window. Issue #27527, patch from Balazs Szekely.
........
IDE: Take care of component palette page names that differ only by character case. Issue #27516.
........
IDE: Improve the List and Inheritance tabs of ComponentList. Issue #27539, patch from Balazs Szekely.
........

git-svn-id: branches/fixes_1_4@48005 -
This commit is contained in:
maxim 2015-02-25 23:06:50 +00:00
parent c619b61c6b
commit 56c999a639
5 changed files with 255 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/ideintf/componentreg.pas
View File

@ -182,6 +182,8 @@ type
FUpdateLock: integer; FUpdateLock: integer;
fChanged: boolean; fChanged: boolean;
fChangeStamp: integer; fChangeStamp: integer;
// Used to find names that differ in character case only.
fOrigPageHelper: TStringList;
procedure AddHandler(HandlerType: TComponentPaletteHandlerType; procedure AddHandler(HandlerType: TComponentPaletteHandlerType;
const AMethod: TMethod; AsLast: boolean = false); const AMethod: TMethod; AsLast: boolean = false);
procedure RemoveHandler(HandlerType: TComponentPaletteHandlerType; procedure RemoveHandler(HandlerType: TComponentPaletteHandlerType;
@ -588,6 +590,8 @@ begin
fPages:=TBaseComponentPageList.Create; fPages:=TBaseComponentPageList.Create;
fComps:=TRegisteredComponentList.Create; fComps:=TRegisteredComponentList.Create;
fOrigPagePriorities:=TPagePriorityList.Create; fOrigPagePriorities:=TPagePriorityList.Create;
fOrigPageHelper:=TStringList.Create; // Note: CaseSensitive = False
fOrigPageHelper.Sorted:=True;
end; end;
destructor TBaseComponentPalette.Destroy; destructor TBaseComponentPalette.Destroy;
@ -595,6 +599,7 @@ var
HandlerType: TComponentPaletteHandlerType; HandlerType: TComponentPaletteHandlerType;
begin begin
Clear; Clear;
FreeAndNil(fOrigPageHelper);
FreeAndNil(fOrigPagePriorities); FreeAndNil(fOrigPagePriorities);
FreeAndNil(fComps); FreeAndNil(fComps);
FreeAndNil(fPages); FreeAndNil(fPages);
@ -614,6 +619,7 @@ begin
fComps[i].RealPage:=nil; fComps[i].RealPage:=nil;
fComps.Clear; fComps.Clear;
fOrigPagePriorities.Clear; fOrigPagePriorities.Clear;
fOrigPageHelper.Clear;
end; end;
procedure TBaseComponentPalette.AddHandler(HandlerType: TComponentPaletteHandlerType; procedure TBaseComponentPalette.AddHandler(HandlerType: TComponentPaletteHandlerType;
@ -780,15 +786,24 @@ begin
fComps.Insert(InsertIndex,NewComponent); fComps.Insert(InsertIndex,NewComponent);
OnPageAddedComponent(NewComponent); OnPageAddedComponent(NewComponent);
// Store a list of page names and their priorities. if NewComponent.FOrigPageName = '' then Exit;
if (NewComponent.OrigPageName <> '')
and (fOrigPagePriorities.IndexOf(NewComponent.OrigPageName) = -1) then // See if page was added with different char case. Use the first version always.
begin if fOrigPageHelper.Find(NewComponent.FOrigPageName, InsertIndex) then begin
NewComponent.FOrigPageName := fOrigPageHelper[InsertIndex]; // Possibly different case
Assert(fOrigPagePriorities.IndexOf(NewComponent.FOrigPageName) >= 0,
'TBaseComponentPalette.AddComponent: FOrigPageName not found!');
end
else begin
fOrigPageHelper.Add(NewComponent.FOrigPageName);
Assert(fOrigPagePriorities.IndexOf(NewComponent.FOrigPageName) = -1,
'TBaseComponentPalette.AddComponent: FOrigPageName exists but it should not!');
// Store a list of page names and their priorities.
InsertIndex:=0; InsertIndex:=0;
while (InsertIndex<fOrigPagePriorities.Count) while (InsertIndex<fOrigPagePriorities.Count)
and (ComparePriority(NewPriority, fOrigPagePriorities.Data[InsertIndex])<=0) do and (ComparePriority(NewPriority, fOrigPagePriorities.Data[InsertIndex])<=0) do
inc(InsertIndex); inc(InsertIndex);
fOrigPagePriorities.InsertKeyData(InsertIndex, NewComponent.OrigPageName, NewPriority); fOrigPagePriorities.InsertKeyData(InsertIndex, NewComponent.FOrigPageName, NewPriority);
end; end;
end; end;

46
ide/compiler.pp
View File

@ -151,16 +151,19 @@ type
// A set of options. A combination of chars or numbers following the option char. // A set of options. A combination of chars or numbers following the option char.
TCompilerOptSet = class(TCompilerOptGroup) TCompilerOptSet = class(TCompilerOptGroup)
private private
fCommonIndent: integer; // Common indentation for this group fixed during parse.
function SetNumberOpt(aValue: string): Boolean; function SetNumberOpt(aValue: string): Boolean;
function SetBooleanOpt(aValue: string): Boolean; function SetBooleanOpt(aValue: string): Boolean;
protected protected
procedure AddOptions(aDescr: string; aIndent: integer); procedure AddOptions(aDescr: string; aIndent: integer);
procedure ParseEditKind; override; procedure ParseEditKind; override;
public public
constructor Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup); constructor Create(aOwnerReader: TCompilerOptReader;
aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
destructor Destroy; override; destructor Destroy; override;
function CollectSelectedOptions(aUseComments: Boolean): string; function CollectSelectedOptions(aUseComments: Boolean): string;
procedure SelectOptions(aOptStr: string); procedure SelectOptions(aOptStr: string);
property CommonIndent: integer read fCommonIndent write fCommonIndent;
end; end;
{ TCompilerOptReader } { TCompilerOptReader }
@ -465,12 +468,12 @@ begin
fIndentation := aIndent; fIndentation := aIndent;
// Separate the actual option and description from each other // Separate the actual option and description from each other
if aDescr[1] <> '-' then if aDescr[1] <> '-' then
raise Exception.Create('Option description does not start with "-"'); raise Exception.CreateFmt('Option "%s" does not start with "-"', [aDescr]);
i := 1; i := 1;
while (i < Length(aDescr)) and (aDescr[i] <> ' ') do while (i <= Length(aDescr)) and (aDescr[i] <> ' ') do
Inc(i); Inc(i);
fOption := Copy(aDescr, 1, i-1); fOption := Copy(aDescr, 1, i-1);
while (i < Length(aDescr)) and (aDescr[i] = ' ') do while (i <= Length(aDescr)) and (aDescr[i] = ' ') do
Inc(i); Inc(i);
fDescription := Copy(aDescr, i, Length(aDescr)); fDescription := Copy(aDescr, i, Length(aDescr));
i := Length(fOption); i := Length(fOption);
@ -752,9 +755,11 @@ end;
{ TCompilerOptSet } { TCompilerOptSet }
constructor TCompilerOptSet.Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup); constructor TCompilerOptSet.Create(aOwnerReader: TCompilerOptReader;
aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
begin begin
inherited Create(aOwnerReader, aOwnerGroup); inherited Create(aOwnerReader, aOwnerGroup);
fCommonIndent := aCommonIndent;
end; end;
destructor TCompilerOptSet.Destroy; destructor TCompilerOptSet.Destroy;
@ -1112,8 +1117,8 @@ function TCompilerOptReader.ParseH(aLines: TStringList): TModalResult;
const const
OptSetId = 'a combination of'; OptSetId = 'a combination of';
var var
i, ThisInd, NextInd: Integer; i, ThisInd, NextInd, OptSetInd: Integer;
ThisLine, NextLine: String; ThisLine: String;
Opt: TCompilerOpt; Opt: TCompilerOpt;
LastGroup, SubGroup: TCompilerOptGroup; LastGroup, SubGroup: TCompilerOptGroup;
GroupItems: TStrings; GroupItems: TStrings;
@ -1126,6 +1131,12 @@ begin
ThisLine := StringReplace(aLines[i],'-Agas-darwinAssemble','-Agas-darwin Assemble',[]); ThisLine := StringReplace(aLines[i],'-Agas-darwinAssemble','-Agas-darwin Assemble',[]);
ThisInd := CalcIndentation(ThisLine); ThisInd := CalcIndentation(ThisLine);
ThisLine := Trim(ThisLine); ThisLine := Trim(ThisLine);
if LastGroup is TCompilerOptSet then
begin // Fix strangely split line indents in options groups.
OptSetInd := TCompilerOptSet(LastGroup).CommonIndent;
if (ThisLine[1] <> '-') and (ThisInd > OptSetInd) then
ThisInd := OptSetInd;
end;
// Top header line for compiler version, check only once. // Top header line for compiler version, check only once.
if (fFpcVersion = '') and ReadVersion(ThisLine) then Continue; if (fFpcVersion = '') and ReadVersion(ThisLine) then Continue;
if ThisInd < 2 then Continue; if ThisInd < 2 then Continue;
@ -1133,23 +1144,18 @@ begin
or (ThisLine[1] = '@') or (ThisLine[1] = '@')
or (Pos('-? ', ThisLine) > 0) or (Pos('-? ', ThisLine) > 0)
or (Pos('-h ', ThisLine) > 0) then Continue; or (Pos('-h ', ThisLine) > 0) then Continue;
if i < aLines.Count-1 then begin if i < aLines.Count-1 then
NextLine := aLines[i+1]; NextInd := CalcIndentation(aLines[i+1])
NextInd := CalcIndentation(aLines[i+1]); else
end
else begin
NextLine := '';
NextInd := -1; NextInd := -1;
end;
if NextInd > ThisInd then if NextInd > ThisInd then
begin begin
if (LastGroup is TCompilerOptSet) if LastGroup is TCompilerOptSet then
and ((Pos(' v : ', NextLine) > 0) or (NextInd > 30)) then NextInd := TCompilerOptSet(LastGroup).CommonIndent
// A hack to deal with split lined in the help output.
NextInd := ThisInd
else begin else begin
if Pos(OptSetId, ThisLine) > 0 then // Header for sets if Pos(OptSetId, ThisLine) > 0 then // Header for sets
LastGroup := TCompilerOptSet.Create(Self, LastGroup) // Hard-code indent to NextInd, for strangely split lines later in help output.
LastGroup := TCompilerOptSet.Create(Self, LastGroup, NextInd)
else // Group header for options else // Group header for options
LastGroup := TCompilerOptGroup.Create(Self, LastGroup); LastGroup := TCompilerOptGroup.Create(Self, LastGroup);
LastGroup.ParseOption(ThisLine, ThisInd); LastGroup.ParseOption(ThisLine, ThisInd);
@ -1158,7 +1164,7 @@ begin
if NextInd <= ThisInd then if NextInd <= ThisInd then
begin begin
// This is an option // This is an option
if (LastGroup is TCompilerOptSet) then // Add it to a set (may add many) if LastGroup is TCompilerOptSet then // Add it to a set (may add many)
TCompilerOptSet(LastGroup).AddOptions(ThisLine, ThisInd) TCompilerOptSet(LastGroup).AddOptions(ThisLine, ThisInd)
else begin else begin
if IsGroup(ThisLine, GroupItems) then if IsGroup(ThisLine, GroupItems) then

144
ide/componentlist.lfm
View File

@ -1,7 +1,7 @@
object ComponentListForm: TComponentListForm object ComponentListForm: TComponentListForm
Left = 368 Left = 560
Height = 467 Height = 467
Top = 94 Top = 216
Width = 300 Width = 300
Caption = 'Components' Caption = 'Components'
ClientHeight = 467 ClientHeight = 467
@ -12,7 +12,7 @@ object ComponentListForm: TComponentListForm
OnKeyDown = FormKeyDown OnKeyDown = FormKeyDown
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.3' LCLVersion = '1.5'
object PageControl: TPageControl object PageControl: TPageControl
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = FilterPanel AnchorSideTop.Control = FilterPanel
@ -21,8 +21,8 @@ object ComponentListForm: TComponentListForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonPanel AnchorSideBottom.Control = ButtonPanel
Left = 0 Left = 0
Height = 404 Height = 400
Top = 25 Top = 27
Width = 300 Width = 300
ActivePage = TabSheetList ActivePage = TabSheetList
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -31,96 +31,110 @@ object ComponentListForm: TComponentListForm
OnChange = PageControlChange OnChange = PageControlChange
object TabSheetList: TTabSheet object TabSheetList: TTabSheet
Caption = 'List' Caption = 'List'
ClientHeight = 378 ClientHeight = 375
ClientWidth = 292 ClientWidth = 296
object Panel7: TPanel object Panel7: TPanel
Left = 0 Left = 0
Height = 378 Height = 375
Top = 0 Top = 0
Width = 292 Width = 296
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
BorderWidth = 2 BorderWidth = 2
ClientHeight = 378 ClientHeight = 375
ClientWidth = 292 ClientWidth = 296
TabOrder = 0 TabOrder = 0
object ListTree: TTreeView object ListTree: TTreeView
Left = 2 Left = 2
Height = 374 Height = 371
Top = 2 Top = 2
Width = 288 Width = 292
Align = alClient Align = alClient
DefaultItemHeight = 16 DefaultItemHeight = 26
Images = imListPalette
Indent = 25
ReadOnly = True ReadOnly = True
RowSelect = True
ShowButtons = False
ShowLines = False
ShowRoot = False
TabOrder = 0 TabOrder = 0
OnClick = ComponentsClick OnClick = ComponentsClick
OnCustomDrawItem = TreeCustomDrawItem
OnDblClick = ComponentsDblClick OnDblClick = ComponentsDblClick
OnKeyPress = TreeKeyPress OnKeyPress = TreeKeyPress
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] Options = [tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRowSelect, tvoToolTips]
end end
end end
end end
object TabSheetPaletteTree: TTabSheet object TabSheetPaletteTree: TTabSheet
Caption = 'Palette' Caption = 'Palette'
ClientHeight = 373 ClientHeight = 375
ClientWidth = 294 ClientWidth = 296
object Panel5: TPanel object pnPaletteTree: TPanel
Left = 0 Left = 0
Height = 366 Height = 375
Top = 0 Top = 0
Width = 294 Width = 296
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
BorderWidth = 5 BorderWidth = 5
ClientHeight = 366 ClientHeight = 375
ClientWidth = 294 ClientWidth = 296
TabOrder = 0 TabOrder = 0
object PalletteTree: TTreeView object PalletteTree: TTreeView
Left = 5 Left = 5
Height = 356 Height = 365
Top = 5 Top = 5
Width = 284 Width = 286
Align = alClient Align = alClient
DefaultItemHeight = 26
Images = imListPalette
PopupMenu = pmCollapseExpand
ReadOnly = True ReadOnly = True
RightClickSelect = True
RowSelect = True
ShowLines = False ShowLines = False
TabOrder = 0 TabOrder = 0
OnClick = ComponentsClick OnClick = ComponentsClick
OnCustomDrawItem = TreeCustomDrawItem
OnDblClick = ComponentsDblClick OnDblClick = ComponentsDblClick
OnKeyPress = TreeKeyPress OnKeyPress = TreeKeyPress
Options = [tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowRoot, tvoToolTips, tvoNoDoubleClickExpand, tvoThemedDraw] Options = [tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowButtons, tvoShowRoot, tvoToolTips]
end end
end end
end end
object TabSheetInheritance: TTabSheet object TabSheetInheritance: TTabSheet
Caption = 'Inheritance' Caption = 'Inheritance'
ClientHeight = 373 ClientHeight = 375
ClientWidth = 294 ClientWidth = 296
object Panel6: TPanel object Panel6: TPanel
Left = 0 Left = 0
Height = 366 Height = 375
Top = 0 Top = 0
Width = 294 Width = 296
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
BorderWidth = 5 BorderWidth = 5
ClientHeight = 366 ClientHeight = 375
ClientWidth = 294 ClientWidth = 296
TabOrder = 0 TabOrder = 0
object InheritanceTree: TTreeView object InheritanceTree: TTreeView
Left = 5 Left = 5
Height = 356 Height = 365
Top = 5 Top = 5
Width = 284 Width = 286
Align = alClient Align = alClient
DefaultItemHeight = 26
Images = imListPalette
Indent = 20
PopupMenu = pmCollapseExpand
ReadOnly = True ReadOnly = True
RightClickSelect = True
RowSelect = True
TabOrder = 0 TabOrder = 0
OnClick = ComponentsClick OnClick = ComponentsClick
OnCustomDrawItem = TreeCustomDrawItem
OnDblClick = ComponentsDblClick OnDblClick = ComponentsDblClick
OnKeyPress = TreeKeyPress OnKeyPress = TreeKeyPress
Options = [tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoNoDoubleClickExpand, tvoThemedDraw] Options = [tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
end end
end end
end end
@ -128,22 +142,22 @@ object ComponentListForm: TComponentListForm
object FilterPanel: TPanel object FilterPanel: TPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 1 Left = 1
Height = 25 Height = 27
Top = 0 Top = 0
Width = 300 Width = 300
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 25 ClientHeight = 27
ClientWidth = 300 ClientWidth = 300
TabOrder = 0 TabOrder = 0
object LabelSearch: TLabel object LabelSearch: TLabel
AnchorSideLeft.Control = FilterPanel AnchorSideLeft.Control = FilterPanel
AnchorSideTop.Control = FilterPanel AnchorSideTop.Control = FilterPanel
Left = 6 Left = 6
Height = 13 Height = 15
Top = 6 Top = 6
Width = 58 Width = 74
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'LabelSearch' Caption = 'LabelSearch'
ParentColor = False ParentColor = False
@ -153,10 +167,10 @@ object ComponentListForm: TComponentListForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LabelSearch AnchorSideTop.Control = LabelSearch
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 92 Left = 86
Height = 28 Height = 21
Top = 2 Top = 3
Width = 204 Width = 210
OnAfterFilter = TreeFilterEdAfterFilter OnAfterFilter = TreeFilterEdAfterFilter
ButtonWidth = 23 ButtonWidth = 23
NumGlyphs = 1 NumGlyphs = 1
@ -169,8 +183,8 @@ object ComponentListForm: TComponentListForm
end end
object ButtonPanel: TButtonPanel object ButtonPanel: TButtonPanel
Left = 6 Left = 6
Height = 26 Height = 28
Top = 435 Top = 433
Width = 288 Width = 288
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True OKButton.DefaultCaption = True
@ -185,4 +199,40 @@ object ComponentListForm: TComponentListForm
ShowButtons = [pbOK] ShowButtons = [pbOK]
ShowBevel = False ShowBevel = False
end end
object imListPalette: TImageList
Height = 24
Width = 24
left = 56
top = 112
end
object pmCollapseExpand: TPopupMenu
OnPopup = pmCollapseExpandPopup
left = 160
top = 112
object miExpand: TMenuItem
Caption = 'Expand'
OnClick = miExpandClick
end
object miExpandAll: TMenuItem
Caption = 'Expand All'
OnClick = miExpandAllClick
end
object MenuItem1: TMenuItem
Caption = '-'
end
object miCollapse: TMenuItem
Caption = 'Collapse'
OnClick = miCollapseClick
end
object miCollapseAll: TMenuItem
Caption = 'Collapse All'
OnClick = miCollapseAllClick
end
end
object imInheritance: TImageList
Height = 24
Width = 24
left = 56
top = 168
end
end end

172
ide/componentlist.pas
View File

@ -19,7 +19,7 @@
*************************************************************************** ***************************************************************************
Author: Marius Author: Marius
Modified by Juha Manninen Modified by Juha Manninen, Balazs Szekely
Abstract: Abstract:
A dialog to quickly find components and to add the found component A dialog to quickly find components and to add the found component
@ -33,41 +33,47 @@ interface
uses uses
Classes, SysUtils, LCLType, Forms, Controls, Graphics, StdCtrls, ExtCtrls, Classes, SysUtils, LCLType, Forms, Controls, Graphics, StdCtrls, ExtCtrls,
ComCtrls, ButtonPanel, LazarusIDEStrConsts, ComponentReg, ComCtrls, ButtonPanel, Menus, LazarusIDEStrConsts, ComponentReg, PackageDefs,
PackageDefs, IDEImagesIntf, TreeFilterEdit, fgl; IDEImagesIntf, TreeFilterEdit, FormEditingIntf;
type type
TRegisteredCompList = specialize TFPGList<TRegisteredComponent>;
{ TComponentListForm } { TComponentListForm }
TComponentListForm = class(TForm) TComponentListForm = class(TForm)
imListPalette: TImageList;
imInheritance: TImageList;
ListTree: TTreeView; ListTree: TTreeView;
ButtonPanel: TButtonPanel; ButtonPanel: TButtonPanel;
miCollapse: TMenuItem;
miCollapseAll: TMenuItem;
miExpand: TMenuItem;
miExpandAll: TMenuItem;
OKButton: TPanelBitBtn; OKButton: TPanelBitBtn;
LabelSearch: TLabel; LabelSearch: TLabel;
PageControl: TPageControl; PageControl: TPageControl;
FilterPanel: TPanel; FilterPanel: TPanel;
Panel5: TPanel; PalletteTree: TTreeView;
InheritanceTree: TTreeView;
pnPaletteTree: TPanel;
Panel6: TPanel; Panel6: TPanel;
Panel7: TPanel; Panel7: TPanel;
pmCollapseExpand: TPopupMenu;
TabSheetPaletteTree: TTabSheet;
TabSheetInheritance: TTabSheet; TabSheetInheritance: TTabSheet;
TabSheetList: TTabSheet; TabSheetList: TTabSheet;
TabSheetPaletteTree: TTabSheet;
InheritanceTree: TTreeView;
PalletteTree: TTreeView;
TreeFilterEd: TTreeFilterEdit; TreeFilterEd: TTreeFilterEdit;
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure miCollapseAllClick(Sender: TObject);
procedure miCollapseClick(Sender: TObject);
procedure miExpandAllClick(Sender: TObject);
procedure miExpandClick(Sender: TObject);
procedure OKButtonClick(Sender: TObject); procedure OKButtonClick(Sender: TObject);
procedure ComponentsDblClick(Sender: TObject); procedure ComponentsDblClick(Sender: TObject);
procedure ComponentsClick(Sender: TObject); procedure ComponentsClick(Sender: TObject);
//procedure ComponentsListboxDrawItem(Control: TWinControl; Index: Integer;
// ARect: TRect; State: TOwnerDrawState);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure TreeCustomDrawItem(Sender: TCustomTreeView; procedure pmCollapseExpandPopup(Sender: TObject);
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure TreeFilterEdAfterFilter(Sender: TObject); procedure TreeFilterEdAfterFilter(Sender: TObject);
procedure PageControlChange(Sender: TObject); procedure PageControlChange(Sender: TObject);
procedure TreeKeyPress(Sender: TObject; var Key: char); procedure TreeKeyPress(Sender: TObject; var Key: char);
@ -111,9 +117,14 @@ begin
TabSheetInheritance.Caption := lisCmpLstInheritance; TabSheetInheritance.Caption := lisCmpLstInheritance;
ButtonPanel.OKButton.Caption := lisUseAndClose; ButtonPanel.OKButton.Caption := lisUseAndClose;
ListTree.Images:=IDEImages.Images_24; imListPalette.Width := ComponentPaletteImageWidth;
InheritanceTree.Images:=ListTree.Images; imListPalette.Height := ComponentPaletteImageHeight;
PalletteTree.Images:=ListTree.Images; imInheritance.Width := ComponentPaletteImageWidth;
imInheritance.Height := ComponentPaletteImageHeight;
ListTree.Images := imListPalette;
PalletteTree.Images := imListPalette;
InheritanceTree.Images := imInheritance;
PrevPageIndex := -1; PrevPageIndex := -1;
PageControl.ActivePage := TabSheetList; PageControl.ActivePage := TabSheetList;
if Assigned(IDEComponentPalette) then if Assigned(IDEComponentPalette) then
@ -211,6 +222,7 @@ var
Node: TTreeNode; Node: TTreeNode;
ClssName: string; ClssName: string;
i, Ind: Integer; i, Ind: Integer;
CurIcon: TCustomBitmap;
begin begin
PalList := TStringList.Create; PalList := TStringList.Create;
try try
@ -237,7 +249,17 @@ begin
if ClssName <> Comp.ComponentClass.ClassName then if ClssName <> Comp.ComponentClass.ClassName then
Node := InheritanceTree.Items.AddChild(Node, ClssName) Node := InheritanceTree.Items.AddChild(Node, ClssName)
else else
begin
Node := InheritanceTree.Items.AddChildObject(Node, ClssName, Comp); Node := InheritanceTree.Items.AddChildObject(Node, ClssName, Comp);
CurIcon := nil;
if (Comp is TPkgComponent) then
CurIcon := TPkgComponent(Comp).Icon;
if CurIcon <> nil then
begin
Node.ImageIndex := imInheritance.Add(CurIcon, nil);
Node.SelectedIndex := Node.ImageIndex;
end;
end;
FClassList.AddObject(ClssName, Node); FClassList.AddObject(ClssName, Node);
end; end;
end; end;
@ -253,7 +275,10 @@ var
Comps: TStringList; Comps: TStringList;
Comp: TRegisteredComponent; Comp: TRegisteredComponent;
ParentNode: TTreeNode; ParentNode: TTreeNode;
AListNode: TTreeNode;
APaletteNode: TTreeNode;
i, j: Integer; i, j: Integer;
CurIcon: TCustomBitmap;
begin begin
if [csDestroying,csLoading]*ComponentState<>[] then exit; if [csDestroying,csLoading]*ComponentState<>[] then exit;
Screen.Cursor := crHourGlass; Screen.Cursor := crHourGlass;
@ -268,6 +293,8 @@ begin
FClassList.Sorted := true; FClassList.Sorted := true;
FClassList.CaseSensitive := false; FClassList.CaseSensitive := false;
FClassList.Duplicates := dupIgnore; FClassList.Duplicates := dupIgnore;
// ParentInheritence := InheritanceTree.Items.Add(nil, 'TComponent');
// FClassList.AddObject('TComponent', ParentInheritence);
// Iterate all pages // Iterate all pages
for i := 0 to IDEComponentPalette.Pages.Count-1 do for i := 0 to IDEComponentPalette.Pages.Count-1 do
begin begin
@ -279,9 +306,19 @@ begin
for j := 0 to Comps.Count-1 do begin for j := 0 to Comps.Count-1 do begin
Comp := Comps.Objects[j] as TRegisteredComponent; Comp := Comps.Objects[j] as TRegisteredComponent;
// Flat list item // Flat list item
ListTree.Items.AddChildObject(Nil, Comps[j], Comp); AListNode := ListTree.Items.AddChildObject(Nil, Comps[j], Comp);
// Palette layout item // Palette layout item
PalletteTree.Items.AddChildObject(ParentNode, Comps[j], Comp); APaletteNode := PalletteTree.Items.AddChildObject(ParentNode, Comps[j], Comp);
CurIcon := nil;
if (Comp is TPkgComponent) then
CurIcon := TPkgComponent(Comp).Icon;
if CurIcon <> nil then
begin
AListNode.ImageIndex := imListPalette.Add(CurIcon, nil);
AListNode.SelectedIndex := AListNode.ImageIndex;
APaletteNode.ImageIndex := AListNode.ImageIndex;
APaletteNode.SelectedIndex := AListNode.ImageIndex;
end;
// Component inheritence item // Component inheritence item
DoComponentInheritence(Comp); DoComponentInheritence(Comp);
end; end;
@ -299,53 +336,6 @@ begin
end; end;
end; end;
procedure TComponentListForm.TreeCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
var
Comp: TRegisteredComponent;
ARect: TRect;
CurIcon: TCustomBitmap;
Indent, IconWidth, IconHeight, NodeTextHeight: Integer;
begin
DefaultDraw := False;
Indent := (Sender as TTreeView).Indent;
Comp := TRegisteredComponent(Node.Data);
with Sender.Canvas do
begin
if cdsSelected in State then
begin
Brush.Color := clHighlight; //Brush.Style := ...
Font.Color := clHighlightText;
end
else begin
Brush.Color := clDefault;
Font.Color := clDefault;
end;
ARect := Node.DisplayRect(False);
FillRect(ARect);
//Brush.Style := bsClear; //don't paint over the background bitmap.
ARect.Left := ARect.Left + (Node.Level * Indent);
// ARect.Left now points to the left of the image, or text if no image
CurIcon := nil;
if Comp is TPkgComponent then
CurIcon := TPkgComponent(Comp).Icon;
if CurIcon<>nil then
begin
IconWidth := CurIcon.Width;
IconHeight := CurIcon.Height;
ARect.Left := ARect.Left + Indent;
//ARect.Left is now the leftmost portion of the image.
Draw(ARect.Left+(25-IconWidth) div 2,
ARect.Top+(ARect.Bottom-ARect.Top-IconHeight) div 2, CurIcon);
ARect.Left := ARect.Left + IconWidth + 2;
end;
NodeTextHeight := TextHeight(Node.Text);
Inc(ARect.Top, (ARect.Bottom - ARect.Top - NodeTextHeight) div 2);
//Now we are finally in a position to draw the text.
TextOut(ARect.Left, ARect.Top, Node.Text);
end;
end;
procedure TComponentListForm.TreeFilterEdAfterFilter(Sender: TObject); procedure TComponentListForm.TreeFilterEdAfterFilter(Sender: TObject);
begin begin
UpdateButtonState; UpdateButtonState;
@ -432,5 +422,57 @@ begin
end; end;
end; end;
procedure TComponentListForm.miCollapseAllClick(Sender: TObject);
begin
TreeFilterEd.FilteredTreeview.FullCollapse;
end;
procedure TComponentListForm.miCollapseClick(Sender: TObject);
var
Node: TTreeNode;
begin
Node := TreeFilterEd.FilteredTreeview.Selected;
if Node = nil then
Exit;
if (Node.Level > 0) and (Node.HasChildren = False) then
Node := Node.Parent;
Node.Collapse(True);
end;
procedure TComponentListForm.miExpandAllClick(Sender: TObject);
begin
TreeFilterEd.FilteredTreeview.FullExpand;
end;
procedure TComponentListForm.miExpandClick(Sender: TObject);
var
Node: TTreeNode;
begin
Node := TreeFilterEd.FilteredTreeview.Selected;
if Node = nil then
Exit;
if (Node.Level > 0) and (Node.HasChildren = False) then
Node := Node.Parent;
Node.Expand(True);
end;
procedure TComponentListForm.pmCollapseExpandPopup(Sender: TObject);
var
Node: TTreeNode;
begin
Node := TreeFilterEd.FilteredTreeview.Selected;
if Node = nil then
begin
miExpand.Enabled := False;
miCollapse.Enabled := False;
end
else
begin
miExpand.Enabled := (Node.HasChildren) and (not Node.Expanded);
miCollapse.Enabled := (Node.HasChildren) and (Node.Expanded);
end;
end;
end. end.

5
ide/componentpalette.pas
View File

@ -280,6 +280,7 @@ begin
begin begin
PgName := FComponentPages[PageI]; PgName := FComponentPages[PageI];
DstComps := TStringList.Create; DstComps := TStringList.Create;
DstComps.CaseSensitive := True;
FComponentPages.Objects[PageI] := DstComps; FComponentPages.Objects[PageI] := DstComps;
i := fOptions.ComponentPages.IndexOf(PgName); i := fOptions.ComponentPages.IndexOf(PgName);
if i >= 0 then // Add components reordered by user. if i >= 0 then // Add components reordered by user.
@ -934,6 +935,7 @@ begin
Format('CacheComponentPages: %s already cached.', [PgName])); Format('CacheComponentPages: %s already cached.', [PgName]));
// Add a cache StringList for this page name. // Add a cache StringList for this page name.
sl := TStringList.Create; sl := TStringList.Create;
sl.CaseSensitive := True;
fOrigComponentPageCache.AddObject(PgName, sl); fOrigComponentPageCache.AddObject(PgName, sl);
// Find all components for this page and add them to cache. // Find all components for this page and add them to cache.
for CompI := 0 to fComps.Count-1 do begin for CompI := 0 to fComps.Count-1 do begin
@ -1020,9 +1022,11 @@ begin
fComponentCache:=TAVLTree.Create(@CompareRegisteredComponents); fComponentCache:=TAVLTree.Create(@CompareRegisteredComponents);
fOrigComponentPageCache:=TStringList.Create; fOrigComponentPageCache:=TStringList.Create;
fOrigComponentPageCache.OwnsObjects:=True; fOrigComponentPageCache.OwnsObjects:=True;
fOrigComponentPageCache.CaseSensitive:=True;
fOrigComponentPageCache.Sorted:=True; fOrigComponentPageCache.Sorted:=True;
fUserComponentPageCache:=TStringList.Create; fUserComponentPageCache:=TStringList.Create;
fUserComponentPageCache.OwnsObjects:=True; fUserComponentPageCache.OwnsObjects:=True;
fUserComponentPageCache.CaseSensitive:=True;
fUserComponentPageCache.Sorted:=True; fUserComponentPageCache.Sorted:=True;
OnComponentIsInvisible:=@CheckComponentDesignerVisible; OnComponentIsInvisible:=@CheckComponentDesignerVisible;
end; end;
@ -1101,6 +1105,7 @@ begin
[PgName, Pg.PageName])); [PgName, Pg.PageName]));
// New cache page // New cache page
UserComps := TStringList.Create; UserComps := TStringList.Create;
UserComps.CaseSensitive := True;
fUserComponentPageCache.AddObject(PgName, UserComps); fUserComponentPageCache.AddObject(PgName, UserComps);
// Associate components belonging to this page // Associate components belonging to this page
aVisibleCompCnt := 0; aVisibleCompCnt := 0;