paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-21 23:02:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

IdeIntf: Implement Selection Editors to extend handling of OI selections. Patch by Sven Barth.

Browse Source 
git-svn-id: trunk@63626 -
This commit is contained in:
juha 2020-07-22 20:16:20 +00:00
parent b9a70c31b0
commit a8a9c4e9fb
7 changed files with 405 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2211,6 +2211,7 @@ components/ideintf/propedits.pp svneol=native#text/pascal
components/ideintf/propeditutils.pp svneol=native#text/pascal
components/ideintf/selectdatasetdlg.lfm svneol=native#text/plain
components/ideintf/selectdatasetdlg.pas svneol=native#text/plain
components/ideintf/seledits.pas svneol=native#text/pascal
components/ideintf/srceditorintf.pas svneol=native#text/pascal
components/ideintf/statusbarpropedit.pp svneol=native#text/pascal
components/ideintf/stringspropeditdlg.lfm svneol=native#text/plain

15
components/ideintf/fpmake.pp
View File

@ -3,7 +3,7 @@
fpmake.pp for IDEIntf 1.0
This file was generated on 21.03.2020
This file was generated on 22.07.2020
}
{$ifndef ALLPACKAGES}
@ -24,10 +24,14 @@ begin
with Installer do
begin
P:=AddPackage('ideintf');
P.Version:='1.0';
P.Version:='1.0.0-0';
P.Directory:=ADirectory;
P.Author:='Lazarus';
P.License:='Modified LGPL2';
P.Description:='IDEIntf - the interface units for the Lazarus IDE';
P.Flags.Add('LazarusDsgnPkg');
D := P.Dependencies.Add('buildintf');
@ -96,6 +100,9 @@ begin
t.Dependencies.AddUnit('toolbarintf');
t.Dependencies.AddUnit('treeviewpropedit');
t.Dependencies.AddUnit('unitresources');
t.Dependencies.AddUnit('bufdatasetdsgn');
t.Dependencies.AddUnit('selectdatasetdlg');
t.Dependencies.AddUnit('seledits');
T:=P.Targets.AddUnit('actionseditor.pas');
T:=P.Targets.AddUnit('actionseditorstd.pas');
@ -149,8 +156,12 @@ begin
T:=P.Targets.AddUnit('toolbarintf.pas');
T:=P.Targets.AddUnit('treeviewpropedit.pas');
T:=P.Targets.AddUnit('unitresources.pas');
T:=P.Targets.AddUnit('bufdatasetdsgn.pas');
T:=P.Targets.AddUnit('selectdatasetdlg.pas');
T:=P.Targets.AddUnit('seledits.pas');
// copy the compiled file, so the IDE knows how the package was compiled
P.Sources.AddSrc('IDEIntf.compiled');
P.InstallFiles.Add('IDEIntf.compiled',AllOSes,'$(unitinstalldir)');
end;

4
components/ideintf/ideintf.lpk
View File

@ -315,6 +315,10 @@
<Filename Value="selectdatasetdlg.pas"/>
<UnitName Value="selectdatasetdlg"/>
</Item>
<Item>
<Filename Value="seledits.pas"/>
<UnitName Value="SelEdits"/>
</Item>
</Files>
<LazDoc Paths="docs"/>
<i18n>

21
components/ideintf/ideintf.pas
View File

@ -8,14 +8,19 @@ unit IDEIntf;
interface
uses
ActionsEditor, ActionsEditorStd, ChangeParentDlg, CheckGroupEditorDlg, CheckListboxEditorDlg, CollectionPropEditForm, ColumnDlg,
ComponentEditors, ComponentReg, ComponentTreeView, DBGridColumnsPropEditForm, DBPropEdits, EditorSyntaxHighlighterDef,
FieldsEditor, FieldsList, FileFilterPropEditor, FormEditingIntf, frmSelectProps, GraphicPropEdit, GraphPropEdits,
HeaderControlPropEdit, HelpFPDoc, IDECommands, IDEDialogs, IDEHelpIntf, IDEImagesIntf, IDEMsgIntf, IDEOptEditorIntf,
IDETextConverter, IDEUtils, IDEWindowIntf, ImageListEditor, KeyValPropEditDlg, LazIDEIntf, LazStringGridEdit, ListViewPropEdit,
MaskPropEdit, MenuIntf, NewField, ObjectInspector, ObjInspStrConsts, OIFavoriteProperties, ProjectGroupIntf, PropEdits,
PropEditUtils, SrcEditorIntf, StatusBarPropEdit, StringsPropEditDlg, TextTools, ToolBarIntf, TreeViewPropEdit, UnitResources,
bufdatasetdsgn, selectdatasetdlg, LazarusPackageIntf;
ActionsEditor, ActionsEditorStd, ChangeParentDlg, CheckGroupEditorDlg,
CheckListboxEditorDlg, CollectionPropEditForm, ColumnDlg, ComponentEditors,
ComponentReg, ComponentTreeView, DBGridColumnsPropEditForm, DBPropEdits,
EditorSyntaxHighlighterDef, FieldsEditor, FieldsList, FileFilterPropEditor,
FormEditingIntf, frmSelectProps, GraphicPropEdit, GraphPropEdits,
HeaderControlPropEdit, HelpFPDoc, IDECommands, IDEDialogs, IDEHelpIntf,
IDEImagesIntf, IDEMsgIntf, IDEOptEditorIntf, IDETextConverter, IDEUtils,
IDEWindowIntf, ImageListEditor, KeyValPropEditDlg, LazIDEIntf,
LazStringGridEdit, ListViewPropEdit, MaskPropEdit, MenuIntf, NewField,
ObjectInspector, ObjInspStrConsts, OIFavoriteProperties, ProjectGroupIntf,
PropEdits, PropEditUtils, SrcEditorIntf, StatusBarPropEdit,
StringsPropEditDlg, TextTools, ToolBarIntf, TreeViewPropEdit, UnitResources,
bufdatasetdsgn, selectdatasetdlg, SelEdits, LazarusPackageIntf;
implementation

271
components/ideintf/propedits.pp
View File

@ -23,7 +23,7 @@ interface
uses
// RTL / FCL
Classes, TypInfo, SysUtils, types, RtlConsts, variants, Contnrs, strutils,
Classes, TypInfo, SysUtils, types, RtlConsts, variants, Contnrs, strutils, FGL,
// LCL
LCLType, LCLIntf, LCLProc, Forms, Controls, GraphType, ButtonPanel, Graphics,
StdCtrls, Buttons, Menus, ExtCtrls, ComCtrls, Dialogs, EditBtn, Grids, ValEdit,
@ -277,8 +277,7 @@ type
TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
TPropEditDrawStateType = (pedsSelected, pedsFocused, pedsInEdit,
pedsInComboList);
TPropEditDrawStateType = (pedsSelected, pedsFocused, pedsInEdit, pedsInComboList);
TPropEditDrawState = set of TPropEditDrawStateType;
TPropEditHint = (
@ -415,11 +414,11 @@ type
read FOnSubPropertiesChanged write FOnSubPropertiesChanged;
end;
TPropertyEditorClass=class of TPropertyEditor;
TPropertyEditorClass = class of TPropertyEditor;
TPropertyEditorList = specialize TFPGObjectList<TPropertyEditor>;
{ THiddenPropertyEditor
A property editor, to hide a published property. If you can't unpublish it,
hide it. }
A property editor to hide a published property. If you can't unpublish it, hide it. }
THiddenPropertyEditor = class(TPropertyEditor)
end;
@ -1180,6 +1179,39 @@ type
TDateTimeProperty = TDateTimePropertyEditor;
type
TSelectionEditorAttribute = (
seaFilterProperties
);
TSelectionEditorAttributes = set of TSelectionEditorAttribute;
{ TBaseSelectionEditor }
TBaseSelectionEditor = class
constructor Create({%H-}ADesigner: TIDesigner; {%H-}AHook: TPropertyEditorHook); virtual;
function GetAttributes: TSelectionEditorAttributes; virtual; abstract;
procedure FilterProperties(ASelection: TPersistentSelectionList; AProperties: TPropertyEditorList); virtual; abstract;
end;
TSelectionEditorClass = class of TBaseSelectionEditor;
TSelectionEditorClassList = specialize TFPGList<TSelectionEditorClass>;
{ TSelectionEditor }
TSelectionEditor = class(TBaseSelectionEditor)
private
FDesigner: TIDesigner;
FHook: TPropertyEditorHook;
public
constructor Create(ADesigner: TIDesigner; AHook: TPropertyEditorHook); override;
function GetAttributes: TSelectionEditorAttributes; override;
procedure FilterProperties({%H-}ASelection: TPersistentSelectionList; {%H-}AProperties: TPropertyEditorList); override;
property Designer: TIDesigner read FDesigner;
property Hook: TPropertyEditorHook read FHook;
end;
//==============================================================================
{ RegisterPropertyEditor
@ -1253,8 +1285,13 @@ procedure GetPersistentProperties(AItem: TPersistent;
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
AEditorFilterFunc: TPropertyEditorFilterFunc);
function GetEditorClass(PropInfo:PPropInfo;
Obj: TPersistent): TPropertyEditorClass;
function GetEditorClass(PropInfo:PPropInfo; Obj: TPersistent): TPropertyEditorClass;
//==============================================================================
procedure RegisterSelectionEditor(AComponentClass: TComponentClass; AEditorClass: TSelectionEditorClass);
procedure GetSelectionEditorClasses(AComponent: TComponent; AEditorList: TSelectionEditorClassList);
procedure GetSelectionEditorClasses(ASelection: TPersistentSelectionList; AEditorList: TSelectionEditorClassList);
//==============================================================================
@ -1825,6 +1862,35 @@ type
procedure Gather(Child: TComponent);
end;
{ TSelectionEditor }
constructor TSelectionEditor.Create(ADesigner: TIDesigner;
AHook: TPropertyEditorHook);
begin
inherited Create(ADesigner, AHook);
FDesigner := ADesigner;
FHook := AHook;
end;
function TSelectionEditor.GetAttributes: TSelectionEditorAttributes;
begin
Result := [];
end;
procedure TSelectionEditor.FilterProperties(
ASelection: TPersistentSelectionList; AProperties: TPropertyEditorList);
begin
end;
{ TBaseSelectionEditor }
constructor TBaseSelectionEditor.Create(ADesigner: TIDesigner;
AHook: TPropertyEditorHook);
begin
end;
{ TPagesPropertyEditor }
procedure TPagesPropertyEditor.AssignItems(OldItmes, NewItems: TStrings);
@ -2121,6 +2187,7 @@ const
var
PropertyEditorMapperList:TFPList;
PropertyClassList:TFPList;
SelectionEditorClassList:TFPList;
type
PPropertyClassRec=^TPropertyClassRec;
@ -2136,6 +2203,12 @@ type
Mapper:TPropertyEditorMapperFunc;
end;
PSelectionEditorClassRec=^TSelectionEditorClassRec;
TSelectionEditorClassRec=record
ComponentClass:TComponentClass;
EditorClass:TSelectionEditorClass;
end;
{ TPropInfoList }
constructor TPropInfoList.Create(Instance:TPersistent; Filter:TTypeKinds);
@ -2288,6 +2361,69 @@ end;
//------------------------------------------------------------------------------
procedure RegisterSelectionEditor(AComponentClass: TComponentClass; AEditorClass: TSelectionEditorClass);
var
p:PSelectionEditorClassRec;
begin
if not Assigned(AComponentClass) or not Assigned(AEditorClass) then
Exit;
if not Assigned(SelectionEditorClassList) then
SelectionEditorClassList:=TFPList.Create;
New(p);
p^.ComponentClass:=AComponentClass;
p^.EditorClass:=AEditorClass;
SelectionEditorClassList.Add(p);
end;
procedure GetSelectionEditorClasses(AComponent: TComponent; AEditorList: TSelectionEditorClassList);
var
i:LongInt;
begin
if not Assigned(AComponent) or not Assigned(AEditorList) then
Exit;
if not Assigned(SelectionEditorClassList) then
Exit;
for i:=0 to SelectionEditorClassList.Count-1 do begin
with PSelectionEditorClassRec(SelectionEditorClassList[i])^ do begin
if AComponent.InheritsFrom(ComponentClass) then
AEditorList.Add(EditorClass);
end;
end;
end;
procedure GetSelectionEditorClasses(ASelection: TPersistentSelectionList;
AEditorList: TSelectionEditorClassList);
var
tmp:TSelectionEditorClassList;
i,j:LongInt;
sel:TPersistent;
begin
if not Assigned(ASelection) or (ASelection.Count=0) or not Assigned(AEditorList) then
Exit;
tmp:=TSelectionEditorClassList.Create;
try
for i:=0 to ASelection.Count-1 do begin
sel:=ASelection[i];
if not (sel is TComponent) then
Continue;
GetSelectionEditorClasses(TComponent(sel),tmp);
{ if there are no classes yet, we pick them as is, otherwise we remove all
those from the existing list that are not part of the new list }
if AEditorList.Count=0 then
AEditorList.Assign(tmp)
else begin
for j:=AEditorList.Count-1 downto 0 do begin
if tmp.IndexOf(AEditorList[j])<0 then
AEditorList.Delete(j);
end;
end;
tmp.Clear;
end;
finally
tmp.Free;
end;
end;
{ GetComponentProperties }
@ -2319,8 +2455,7 @@ begin
PropertyEditorMapperList.Insert(0,P);
end;
function GetEditorClass(PropInfo:PPropInfo;
Obj:TPersistent): TPropertyEditorClass;
function GetEditorClass(PropInfo:PPropInfo; Obj:TPersistent): TPropertyEditorClass;
var
PropType:PTypeInfo;
P,C:PPropertyClassRec;
@ -2401,10 +2536,14 @@ var
Candidates: TPropInfoList;
PropLists: TFPList;
PropEditor: TPropertyEditor;
PropEditorList: TPropertyEditorList;
SelEditor: TBaseSelectionEditor;
SelEditorList: TSelectionEditorClassList;
EdClass: TPropertyEditorClass;
PropInfo: PPropInfo;
AddEditor: Boolean;
Instance: TPersistent;
Designer: TIDesigner;
begin
if (ASelection = nil) or (ASelection.Count = 0) then Exit;
SelCount := ASelection.Count;
@ -2448,52 +2587,81 @@ begin
PropEditor.Free;
end;
PropLists := TFPList.Create;
PropEditorList := TPropertyEditorList.Create(True);
try
PropLists.Count := SelCount;
// Create a property info list for each component in the selection
for I := 0 to SelCount - 1 do
PropLists[i] := TPropInfoList.Create(ASelection[I], AFilter);
PropLists := TFPList.Create;
try
PropLists.Count := SelCount;
// Create a property info list for each component in the selection
for I := 0 to SelCount - 1 do
PropLists[i] := TPropInfoList.Create(ASelection[I], AFilter);
// Eliminate each property in Candidates that is not in all property lists
for I := 0 to SelCount - 1 do
Candidates.Intersect(TPropInfoList(PropLists[I]));
// Eliminate each property in Candidates that is not in all property lists
for I := 0 to SelCount - 1 do
Candidates.Intersect(TPropInfoList(PropLists[I]));
// Eliminate each property in the property list that are not in Candidates
for I := 0 to SelCount - 1 do
TPropInfoList(PropLists[I]).Intersect(Candidates);
// Eliminate each property in the property list that are not in Candidates
for I := 0 to SelCount - 1 do
TPropInfoList(PropLists[I]).Intersect(Candidates);
// PropList now has a matrix of PropInfo's.
// -> create a property editor for each property
for I := 0 to Candidates.Count - 1 do
begin
EdClass := GetEditorClass(Candidates[I], Instance);
if EdClass = nil then Continue;
PropEditor := EdClass.Create(AHook, SelCount);
AddEditor := True;
for J := 0 to SelCount - 1 do
// PropList now has a matrix of PropInfo's.
// -> create a property editor for each property
for I := 0 to Candidates.Count - 1 do
begin
if (ASelection[J].ClassType <> ClassTyp) and
(GetEditorClass(TPropInfoList(PropLists[J])[I], ASelection[J])<>EdClass) then
EdClass := GetEditorClass(Candidates[I], Instance);
if EdClass = nil then Continue;
PropEditor := EdClass.Create(AHook, SelCount);
AddEditor := True;
for J := 0 to SelCount - 1 do
begin
AddEditor := False;
Break;
if (ASelection[J].ClassType <> ClassTyp) and
(GetEditorClass(TPropInfoList(PropLists[J])[I], ASelection[J])<>EdClass) then
begin
AddEditor := False;
Break;
end;
PropEditor.SetPropEntry(J, ASelection[J], TPropInfoList(PropLists[J])[I]);
end;
PropEditor.SetPropEntry(J, ASelection[J], TPropInfoList(PropLists[J])[I]);
if AddEditor then
begin
PropEditor.Initialize;
if not PropEditor.ValueAvailable then AddEditor:=false;
end;
if AddEditor then
PropEditorList.Add(PropEditor)
else
PropEditor.Free;
end;
if AddEditor then
begin
PropEditor.Initialize;
if not PropEditor.ValueAvailable then AddEditor:=false;
end;
if AddEditor then
AProc(PropEditor)
else
PropEditor.Free;
finally
for I := 0 to PropLists.Count - 1 do
TPropInfoList(PropLists[I]).Free;
PropLists.Free;
end;
SelEditorList := TSelectionEditorClassList.Create;
try
GetSelectionEditorClasses(ASelection, SelEditorList);
{ is it safe to assume that the whole selection has the same designer? }
Designer := FindRootDesigner(ASelection[0]);
for I := 0 to SelEditorList.Count - 1 do begin
SelEditor := SelEditorList[I].Create(Designer, AHook);
try
if seaFilterProperties in SelEditor.GetAttributes then
SelEditor.FilterProperties(ASelection, PropEditorList);
finally
SelEditor.Free;
end;
end;
finally
SelEditorList.Free;
end;
{ no longer free the editors }
PropEditorList.FreeObjects := False;
for I := 0 to PropEditorList.Count - 1 do
AProc(PropEditorList[I]);
finally
for I := 0 to PropLists.Count - 1 do TPropInfoList(PropLists[I]).Free;
PropLists.Free;
PropEditorList.Free;
end;
finally
Candidates.Free;
@ -8107,6 +8275,7 @@ var
i: integer;
pm: PPropertyEditorMapperRec;
pc: PPropertyClassRec;
sec: PSelectionEditorClassRec;
begin
if PropertyEditorMapperList<>nil then begin
for i:=0 to PropertyEditorMapperList.Count-1 do begin
@ -8124,6 +8293,14 @@ begin
FreeAndNil(PropertyClassList);
end;
if Assigned(SelectionEditorClassList) then begin
for i:=0 to SelectionEditorClassList.Count-1 do begin
sec:=PSelectionEditorClassRec(SelectionEditorClassList[i]);
Dispose(sec);
end;
FreeAndNil(SelectionEditorClassList);
end;
FreeAndNil(ListPropertyEditors);
FreeAndNil(VirtualKeyStrings);
end;

149
components/ideintf/seledits.pas Normal file
View File

@ -0,0 +1,149 @@
{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Sven Barth
Abstract:
This unit contains selection editors for various LCL components.
}
unit SelEdits;
{$mode objfpc}{$H+}
interface
uses
// RTL / FCL
SysUtils, TypInfo,
// LCL
Controls, ExtCtrls,
// IdeIntf
PropEdits;
type
{ TFlowPanelControlIndexEditor }
TFlowPanelControlIndexEditor = class(TSelectionEditor)
public
function GetAttributes: TSelectionEditorAttributes; override;
procedure FilterProperties(ASelection: TPersistentSelectionList;
AProperties: TPropertyEditorList); override;
end;
implementation
type
{ TFlowPanelControlIndexProperty }
TFlowPanelControlIndexProperty = class(TPropertyEditor)
private
FPanel: TCustomFlowPanel;
FControl: TControl;
FPropInfo: TPropInfo;
FPropType: PTypeInfo;
public
constructor Create(APanel: TCustomFlowPanel; AControl: TControl; AHook: TPropertyEditorHook); reintroduce;
function GetAttributes: TPropertyAttributes; override;
function GetValue: ansistring; override;
procedure SetValue(const NewValue: ansistring); override;
end;
{ TFlowPanelControlIndexProperty }
constructor TFlowPanelControlIndexProperty.Create(APanel: TCustomFlowPanel;
AControl: TControl; AHook: TPropertyEditorHook);
begin
inherited Create(AHook, 1);
FPanel := APanel;
FControl := AControl;
FPropType := TypeInfo(Integer);
{$if FPC_FULLVERSION<30101}
FPropInfo.PropType := FPropType;
{$else}
FPropInfo.PropTypeRef := @FPropType;
{$endif}
FPropInfo.Name := 'ControlIndex';
SetPropEntry(0, Nil, @FPropInfo);
end;
function TFlowPanelControlIndexProperty.GetAttributes: TPropertyAttributes;
begin
Result := [];
end;
function TFlowPanelControlIndexProperty.GetValue: ansistring;
begin
Result := IntToStr(FPanel.GetControlIndex(FControl));
end;
procedure TFlowPanelControlIndexProperty.SetValue(const NewValue: ansistring);
var
idx: Integer;
begin
if not TryStrToInt(NewValue, idx) then
Exit;
FPanel.SetControlIndex(FControl, idx);
end;
{ TFlowPanelControlIndexEditor }
function TFlowPanelControlIndexEditor.GetAttributes: TSelectionEditorAttributes;
begin
Result := [seaFilterProperties];
end;
procedure TFlowPanelControlIndexEditor.FilterProperties(
ASelection: TPersistentSelectionList; AProperties: TPropertyEditorList);
var
ctrl: TControl;
i: LongInt;
todelete: array[0..1] of LongInt;
propname: ShortString;
begin
if not Assigned(ASelection) or not Assigned(AProperties) then
Exit;
if ASelection.Count <> 1 then
Exit;
todelete[0] := -1;
todelete[1] := -1;
for i := 0 to AProperties.Count - 1 do begin
if AProperties[i] is TFlowPanelControlIndexProperty then
Exit;
propname := UpperCase(AProperties[i].GetName);
if propname = 'CONTROLINDEX' then
Exit
else if propname = 'LEFT' then
todelete[0] := i
else if propname = 'TOP' then
todelete[1] := i;
end;
if not (ASelection[0] is TControl) then
Exit;
ctrl := TControl(ASelection[0]);
if not (ctrl.Parent is TCustomFlowPanel) then
Exit;
if todelete[0] < todelete[1] then begin
i := todelete[0];
todelete[0] := todelete[1];
todelete[1] := i;
end;
for i := Low(todelete) to High(todelete) do
if todelete[i] >= 0 then
AProperties.Delete(todelete[i]);
AProperties.Add(TFlowPanelControlIndexProperty.Create(TCustomFlowPanel(ctrl.Parent), ctrl, Hook));
end;
initialization
{ we need to register this for TControl as this is applied to each control
that is placed on a TFlowPanel }
RegisterSelectionEditor(TControl, TFlowPanelControlIndexEditor);
end.

1
ide/main.pp
View File

@ -82,6 +82,7 @@ uses
SrcEditorIntf, NewItemIntf, IDEExternToolIntf, IDEMsgIntf, LazMsgDialogs,
PackageIntf, ProjectIntf, CompOptsIntf, MenuIntf, BaseIDEIntf, LazIDEIntf,
IDEOptionsIntf, IDEOptEditorIntf, IDEImagesIntf, ComponentEditors, ToolBarIntf,
SelEdits,
// protocol
IDEProtocol,
// compile