mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-31 03:21:28 +01:00
404 lines
11 KiB
ObjectPascal
404 lines
11 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Author: Alexander Klenin
|
|
|
|
}
|
|
unit TASubcomponentsEditor;
|
|
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, ComponentEditors, Forms, Menus, PropEdits, StdCtrls;
|
|
|
|
type
|
|
|
|
{ TSubComponentListEditor }
|
|
|
|
TSubComponentListEditor = class(TComponentEditor)
|
|
private
|
|
FEditorForm: TForm;
|
|
protected
|
|
function MakeEditorForm: TForm; virtual; abstract;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TComponentListPropertyEditor }
|
|
|
|
TComponentListPropertyEditor = class(TPropertyEditor)
|
|
private
|
|
FEditorForm: TForm;
|
|
protected
|
|
function GetChildrenCount: Integer; virtual; abstract;
|
|
function MakeEditorForm: TForm; virtual; abstract;
|
|
public
|
|
destructor Destroy; override;
|
|
procedure Edit; override;
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
function GetValue: ansistring; override;
|
|
end;
|
|
|
|
{ TComponentListEditorForm }
|
|
|
|
TComponentListEditorForm = class(TForm)
|
|
ChildrenListBox: TListBox;
|
|
MainMenu1: TMainMenu;
|
|
miMoveUp: TMenuItem;
|
|
miMoveDown: TMenuItem;
|
|
miAdd: TMenuItem;
|
|
miDelete: TMenuItem;
|
|
procedure ChildrenListBoxClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure miAddClick(Sender: TObject);
|
|
procedure miDeleteClick(Sender: TObject);
|
|
procedure miMoveDownClick(Sender: TObject);
|
|
procedure miMoveUpClick(Sender: TObject);
|
|
private
|
|
FComponentEditor: TSubComponentListEditor;
|
|
FDesigner: TComponentEditorDesigner;
|
|
FParent: TComponent;
|
|
FPropertyEditor: TComponentListPropertyEditor;
|
|
function FindChild(ACandidate: TPersistent; out AIndex: Integer): Boolean;
|
|
procedure MoveSelection(AStart, ADir: Integer);
|
|
procedure OnComponentRenamed(AComponent: TComponent);
|
|
procedure OnGetSelection(const ASelection: TPersistentSelectionList);
|
|
procedure OnPersistentAdded(APersistent: TPersistent; ASelect: Boolean);
|
|
procedure OnPersistentDeleting(APersistent: TPersistent);
|
|
procedure OnSetSelection(const ASelection: TPersistentSelectionList);
|
|
procedure RefreshList;
|
|
procedure SelectionChanged(AOrderChanged: Boolean = false);
|
|
protected
|
|
procedure AddSubcomponent(AParent, AChild: TComponent); virtual; abstract;
|
|
procedure AddSubcomponentClass(const ACaption: String; ATag: Integer);
|
|
procedure BuildCaption; virtual; abstract;
|
|
function ChildClass: TComponentClass; virtual; abstract;
|
|
procedure EnumerateSubcomponentClasses; virtual; abstract;
|
|
function GetChildrenList: TFPList; virtual; abstract;
|
|
function MakeSubcomponent(
|
|
AOwner: TComponent; ATag: Integer): TComponent; virtual; abstract;
|
|
property Parent: TComponent read FParent;
|
|
public
|
|
constructor Create(
|
|
AOwner, AParent: TComponent; AComponentEditor: TSubComponentListEditor;
|
|
APropertyEditor: TComponentListPropertyEditor); reintroduce;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, SysUtils, TAChartUtils;
|
|
|
|
{$R *.lfm}
|
|
|
|
{ TComponentListPropertyEditor }
|
|
|
|
destructor TComponentListPropertyEditor.Destroy;
|
|
begin
|
|
FreeAndNil(FEditorForm);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TComponentListPropertyEditor.Edit;
|
|
begin
|
|
if GetComponent(0) = nil then
|
|
raise Exception.Create('TComponentListPropertyEditor.Component=nil');
|
|
if FEditorForm = nil then
|
|
FEditorForm := MakeEditorForm;
|
|
FEditorForm.EnsureVisible;
|
|
end;
|
|
|
|
function TComponentListPropertyEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paDialog, paReadOnly];
|
|
end;
|
|
|
|
function TComponentListPropertyEditor.GetValue: ansistring;
|
|
var
|
|
c: Integer;
|
|
begin
|
|
c := GetChildrenCount;
|
|
if c = 1 then
|
|
Result := '1 item'
|
|
else
|
|
Result := IntToStr(c) + ' items';
|
|
end;
|
|
|
|
{ TSubComponentListEditor }
|
|
|
|
destructor TSubComponentListEditor.Destroy;
|
|
begin
|
|
FreeAndNil(FEditorForm);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSubComponentListEditor.ExecuteVerb(Index: Integer);
|
|
begin
|
|
if Index <> 0 then exit;
|
|
if GetComponent = nil then
|
|
raise Exception.Create('TSubComponentListEditor.Component=nil');
|
|
if FEditorForm = nil then
|
|
FEditorForm := MakeEditorForm;
|
|
FEditorForm.ShowOnTop;
|
|
end;
|
|
|
|
function TSubComponentListEditor.GetVerbCount: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
{ TComponentListEditorForm }
|
|
|
|
procedure TComponentListEditorForm.AddSubcomponentClass(
|
|
const ACaption: String; ATag: Integer);
|
|
var
|
|
mi: TMenuItem;
|
|
begin
|
|
if ACaption = '' then exit; // Empty names denote deprecated components.
|
|
mi := TMenuItem.Create(Self);
|
|
mi.OnClick := @miAddClick;
|
|
mi.Caption := ACaption;
|
|
mi.Tag := ATag;
|
|
miAdd.Add(mi);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.ChildrenListBoxClick(Sender: TObject);
|
|
begin
|
|
SelectionChanged;
|
|
end;
|
|
|
|
constructor TComponentListEditorForm.Create(
|
|
AOwner, AParent: TComponent; AComponentEditor: TSubComponentListEditor;
|
|
APropertyEditor: TComponentListPropertyEditor);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FParent := AParent;
|
|
FComponentEditor := AComponentEditor;
|
|
FPropertyEditor := APropertyEditor;
|
|
if FComponentEditor <> nil then
|
|
FDesigner := FComponentEditor.Designer
|
|
else
|
|
FDesigner := FindRootDesigner(FParent) as TComponentEditorDesigner;
|
|
BuildCaption;
|
|
EnumerateSubcomponentClasses;
|
|
|
|
RefreshList;
|
|
|
|
GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
|
|
GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
|
|
GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
|
|
GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
|
|
GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
|
|
|
|
SelectionChanged;
|
|
end;
|
|
|
|
function TComponentListEditorForm.FindChild(
|
|
ACandidate: TPersistent; out AIndex: Integer): Boolean;
|
|
begin
|
|
if ACandidate is ChildClass then
|
|
AIndex := ChildrenListBox.Items.IndexOfObject(ACandidate)
|
|
else
|
|
AIndex := -1;
|
|
Result := AIndex >= 0;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.FormClose(
|
|
Sender: TObject; var CloseAction: TCloseAction);
|
|
begin
|
|
CloseAction := caFree;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
if FComponentEditor <> nil then begin
|
|
FComponentEditor.FEditorForm := nil;
|
|
if
|
|
(FParent <> nil) and (not (csDestroying in FParent.ComponentState)) and
|
|
(ChildrenListBox.SelCount > 0)
|
|
then
|
|
GlobalDesignHook.SelectOnlyThis(FParent);
|
|
end;
|
|
if FPropertyEditor <> nil then
|
|
FPropertyEditor.FEditorForm := nil;
|
|
if Assigned(GlobalDesignHook) then
|
|
GlobalDesignHook.RemoveAllHandlersForObject(Self);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.miAddClick(Sender: TObject);
|
|
var
|
|
s: TComponent;
|
|
n: String;
|
|
begin
|
|
s := MakeSubcomponent(FParent.Owner, (Sender as TMenuItem).Tag);
|
|
try
|
|
n := Copy(s.ClassName, 2, Length(s.ClassName) - 1);
|
|
s.Name := FDesigner.CreateUniqueComponentName(FParent.Name + n);
|
|
AddSubcomponent(FParent, s);
|
|
FDesigner.PropertyEditorHook.PersistentAdded(s, true);
|
|
FDesigner.Modified;
|
|
RefreshList;
|
|
except
|
|
s.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.miDeleteClick(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
s: TComponent;
|
|
begin
|
|
if ChildrenListBox.SelCount = 0 then exit;
|
|
for i := ChildrenListBox.Items.Count - 1 downto 0 do
|
|
if ChildrenListBox.Selected[i] then begin
|
|
s := TComponent(ChildrenListBox.Items.Objects[i]);
|
|
ChildrenListBox.Items.Delete(i);
|
|
FDesigner.PropertyEditorHook.PersistentDeleting(s);
|
|
s.Free;
|
|
end;
|
|
FDesigner.Modified;
|
|
SelectionChanged;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.miMoveDownClick(Sender: TObject);
|
|
begin
|
|
MoveSelection(ChildrenListBox.Count - 1, 1);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.miMoveUpClick(Sender: TObject);
|
|
begin
|
|
MoveSelection(0, -1);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.MoveSelection(AStart, ADir: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if not ChildrenListBox.SelCount = 0 then exit;
|
|
i := AStart - ADir;
|
|
with ChildrenListBox do
|
|
while InRange(i + ADir, 0, Count - 1) do begin
|
|
if Selected[i] and not Selected[i + ADir] then begin
|
|
with TIndexedComponent(Items.Objects[i]) do
|
|
Index := Index + ADir;
|
|
Items.Move(i, i + ADir);
|
|
Selected[i + ADir] := true;
|
|
Selected[i] := false;
|
|
end;
|
|
i -= ADir;
|
|
end;
|
|
FDesigner.Modified;
|
|
SelectionChanged(true);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.OnComponentRenamed(AComponent: TComponent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AComponent = nil then exit;
|
|
if FindChild(AComponent, i) then
|
|
ChildrenListBox.Items[i] := AComponent.Name
|
|
else if AComponent = FParent then
|
|
BuildCaption;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.OnGetSelection(
|
|
const ASelection: TPersistentSelectionList);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if ASelection = nil then exit;
|
|
ASelection.Clear;
|
|
with ChildrenListBox do
|
|
for i := 0 to Items.Count - 1 do
|
|
if Selected[i] then
|
|
ASelection.Add(TPersistent(Items.Objects[i]));
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.OnPersistentAdded(
|
|
APersistent: TPersistent; ASelect: Boolean);
|
|
var
|
|
s: TComponent;
|
|
begin
|
|
if (APersistent = nil) or not (APersistent is ChildClass) then exit;
|
|
s := APersistent as TComponent;
|
|
if s.GetParentComponent <> FParent then exit;
|
|
with ChildrenListBox do
|
|
Selected[Items.AddObject(s.Name, s)] := ASelect;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.OnPersistentDeleting(
|
|
APersistent: TPersistent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FindChild(APersistent, i) then
|
|
ChildrenListBox.Items.Delete(i);
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.OnSetSelection(
|
|
const ASelection: TPersistentSelectionList);
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
if ASelection = nil then exit;
|
|
ChildrenListBox.ClearSelection;
|
|
for i := 0 to ASelection.Count - 1 do
|
|
if FindChild(ASelection.Items[i], j) then
|
|
ChildrenListBox.Selected[j] := true;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.RefreshList;
|
|
var
|
|
ci: TStrings;
|
|
i: Integer;
|
|
begin
|
|
ci := ChildrenListBox.Items;
|
|
try
|
|
ci.BeginUpdate;
|
|
ci.Clear;
|
|
with GetChildrenList do
|
|
for i := 0 to Count - 1 do
|
|
ci.AddObject(TComponent(Items[i]).Name, TObject(Items[i]));
|
|
finally
|
|
ci.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TComponentListEditorForm.SelectionChanged(AOrderChanged: Boolean);
|
|
var
|
|
sel: TPersistentSelectionList;
|
|
begin
|
|
GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
|
|
try
|
|
sel := TPersistentSelectionList.Create;
|
|
sel.ForceUpdate := AOrderChanged;
|
|
try
|
|
OnGetSelection(sel);
|
|
FDesigner.PropertyEditorHook.SetSelection(sel) ;
|
|
finally
|
|
sel.Free;
|
|
end;
|
|
finally
|
|
GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|