diff --git a/.gitattributes b/.gitattributes index bb29a05c25..ad3c08c725 100644 --- a/.gitattributes +++ b/.gitattributes @@ -304,7 +304,6 @@ debugger/watchpropertydlg.pp svneol=native#text/pascal designer/abstractcompiler.pp svneol=native#text/pascal designer/abstracteditor.pp svneol=native#text/pascal designer/abstractfilesystem.pp svneol=native#text/pascal -designer/abstractformeditor.pp svneol=native#text/pascal designer/aligncompsdlg.pp svneol=native#text/pascal designer/changeclassdialog.lfm svneol=native#text/plain designer/changeclassdialog.lrs svneol=native#text/pascal @@ -622,6 +621,7 @@ ideintf/allideintf.pas svneol=native#text/pascal ideintf/columndlg.pp svneol=native#text/pascal ideintf/componenteditors.pas svneol=native#text/pascal ideintf/componenttreeview.pas svneol=native#text/pascal +ideintf/formeditingintf.pas svneol=native#text/pascal ideintf/graphpropedits.pas svneol=native#text/pascal ideintf/helpintf.pas svneol=native#text/pascal ideintf/idecommands.pas svneol=native#text/pascal diff --git a/designer/abstractformeditor.pp b/designer/abstractformeditor.pp deleted file mode 100644 index 85dd35d0e0..0000000000 --- a/designer/abstractformeditor.pp +++ /dev/null @@ -1,117 +0,0 @@ -{ - /*************************************************************************** - AbstractFormEditor.pp - --------------------- - - ***************************************************************************/ - - *************************************************************************** - * * - * This source is free software; you can redistribute it and/or modify * - * it under the terms of the GNU General Public License as published by * - * the Free Software Foundation; either version 2 of the License, or * - * (at your option) any later version. * - * * - * This code 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. See the GNU * - * General Public License for more details. * - * * - * A copy of the GNU General Public License is available on the World * - * Wide Web at . You can also * - * obtain it by writing to the Free Software Foundation, * - * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * - * * - *************************************************************************** -} -unit AbstractFormEditor; - -{$mode objfpc}{$H-} - -interface - -uses - Classes, TypInfo, Controls; - -type - -{ Should I include typinfo.pp and use TTypeKind instead of TPropertyType - or use TPropertyType -} - - TIComponentInterface = class - public - Function GetComponentType : String; virtual; abstract; - Function GetComponentHandle : LongInt; virtual; abstract; - Function GetParent : TIComponentInterface; virtual; abstract; - Function IsTControl : Boolean; virtual; abstract; - Function GetPropCount : Integer; virtual; abstract; - Function GetPropType(Index : Integer) : TTypeKind; virtual; abstract; - // Function GetPropType(Index : Integer) : TPropertyType; virtual; abstract; - Function GetPropName(Index : Integer) : String; virtual; abstract; - Function GetPropTypebyName(Name : String) : TTypeKind; virtual; abstract; - // Function GetPropTypebyName(Name : String) : TPropertyType; virtual; abstract; - Function GetPropTypeName(Index : Integer) : String; virtual; abstract; - - - Function GetPropValue(Index : Integer; var Value) : Boolean; virtual; abstract; - Function GetPropValuebyName(Name: String; var Value) : Boolean; virtual; abstract; - Function SetProp(Index : Integer; const Value) : Boolean; virtual; abstract; - Function SetPropbyName(Name : String; const Value) : Boolean; virtual; abstract; - - Function GetControlCount: Integer; virtual; abstract; - Function GetControl(Index : Integer): TIComponentInterface; virtual; abstract; - - Function GetComponentCount: Integer; virtual; abstract; - Function GetComponent(Index : Integer): TIComponentInterface; virtual; abstract; - - Function Select : Boolean; virtual; abstract; - Function Focus : Boolean; virtual; abstract; - Function Delete : Boolean; virtual; abstract; - end; - - - { TIFormInterface - currently not used } - - TIFormInterface = class - public - Function Filename : AnsiString; virtual; abstract; - Function FormModified : Boolean; virtual; abstract; - Function MarkModified : Boolean; virtual; abstract; - Function GetFormComponent : TIComponentInterface; virtual; abstract; - Function FindComponent : TIComponentInterface; virtual; abstract; - Function GetComponentfromHandle(ComponentHandle:Pointer): TIComponentInterface; virtual; abstract; - - Function GetSelCount: Integer; virtual; abstract; - Function GetSelComponent(Index : Integer): TIComponentInterface; virtual; abstract; - Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass; - X,Y,W,H : Integer): TIComponentInterface; virtual; abstract; - end; - -{ - Created by Shane Miller - This unit defines the layout for the forms editor. The forms editor is - responsible for creating all forms, holding all component interfaces . -} - - TAbstractFormEditor = class - public - Function FindComponentByName(const Name : ShortString) : TIComponentInterface; virtual; abstract; - Function FindComponent(AComponent: TComponent): TIComponentInterface; virtual; abstract; - - Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass; - X,Y,W,H : Integer): TIComponentInterface; virtual; abstract; - Function CreateComponentFromStream(BinStream: TStream; - AncestorType: TComponentClass; Interactive: boolean - ): TIComponentInterface; virtual; abstract; - Function CreateChildComponentFromStream(BinStream: TStream; - ComponentClass: TComponentClass; - Root: TComponent; - ParentControl: TWinControl - ): TIComponentInterface; virtual; abstract; - end; - - -implementation - -end. diff --git a/designer/changeclassdialog.lfm b/designer/changeclassdialog.lfm index c036adf4fc..311376c4f2 100644 --- a/designer/changeclassdialog.lfm +++ b/designer/changeclassdialog.lfm @@ -58,6 +58,7 @@ object ChangeClassDlg: TChangeClassDlg Width = 200 object NewClassComboBox: TComboBox MaxLength = 0 + OnEditingDone = NewClassComboBoxEditingDone TabOrder = 0 Text = 'NewClassComboBox' Left = 14 diff --git a/designer/changeclassdialog.lrs b/designer/changeclassdialog.lrs index 8055a74a13..96ba87a141 100644 --- a/designer/changeclassdialog.lrs +++ b/designer/changeclassdialog.lrs @@ -17,16 +17,17 @@ LazarusResources.Add('TChangeClassDlg','FORMDATA',[ +#0#0#0#0#0#9'TGroupBox'#11'NewGroupBox'#7'Caption'#6#11'NewGroupBox'#12'Clie' +'ntHeight'#3#231#0#11'ClientWidth'#3#196#0#11'ParentColor'#9#8'TabOrder'#2#1 +#4'Left'#3#216#0#6'Height'#3#248#0#3'Top'#2#8#5'Width'#3#200#0#0#9'TComboBox' - +#16'NewClassComboBox'#9'MaxLength'#2#0#8'TabOrder'#2#0#4'Text'#6#16'NewClass' - +'ComboBox'#4'Left'#2#14#6'Height'#2#25#3'Top'#2#9#5'Width'#3#174#0#0#0#9'TGr' - +'oupBox'#19'NewAncestorGroupBox'#5'Align'#7#8'alBottom'#7'Caption'#6#19'NewA' - +'ncestorGroupBox'#12'ClientHeight'#3#175#0#11'ClientWidth'#3#192#0#11'Parent' - +'Color'#9#8'TabOrder'#2#1#6'Height'#3#192#0#3'Top'#2''''#5'Width'#3#196#0#0#8 - +'TListBox'#19'NewAncestorsListBox'#5'Align'#7#8'alClient'#16'ClickOnSelChang' - +'e'#8#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#3#175#0#5'Width'#3#192#0#0 - +#0#0#0#7'TButton'#8'OkButton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Capti' - +'on'#6#2'Ok'#11'ModalResult'#2#1#8'TabOrder'#2#2#4'Left'#3#192#0#6'Height'#2 - +#25#3'Top'#3#14#1#5'Width'#2'['#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11 - +#7'akRight'#8'akBottom'#0#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOr' - +'der'#2#3#4'Left'#3'@'#1#6'Height'#2#25#3'Top'#3#14#1#5'Width'#2'['#0#0#0 + +#16'NewClassComboBox'#9'MaxLength'#2#0#13'OnEditingDone'#7#27'NewClassComboB' + +'oxEditingDone'#8'TabOrder'#2#0#4'Text'#6#16'NewClassComboBox'#4'Left'#2#14#6 + +'Height'#2#25#3'Top'#2#9#5'Width'#3#174#0#0#0#9'TGroupBox'#19'NewAncestorGro' + +'upBox'#5'Align'#7#8'alBottom'#7'Caption'#6#19'NewAncestorGroupBox'#12'Clien' + +'tHeight'#3#175#0#11'ClientWidth'#3#192#0#11'ParentColor'#9#8'TabOrder'#2#1#6 + +'Height'#3#192#0#3'Top'#2''''#5'Width'#3#196#0#0#8'TListBox'#19'NewAncestors' + +'ListBox'#5'Align'#7#8'alClient'#16'ClickOnSelChange'#8#8'TabOrder'#2#0#8'To' + +'pIndex'#2#255#6'Height'#3#175#0#5'Width'#3#192#0#0#0#0#0#7'TButton'#8'OkBut' + +'ton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#2'Ok'#11'ModalResu' + +'lt'#2#1#8'TabOrder'#2#2#4'Left'#3#192#0#6'Height'#2#25#3'Top'#3#14#1#5'Widt' + +'h'#2'['#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11#7'akRight'#8'akBottom' + +#0#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#3#4'Left'#3'@'#1 + +#6'Height'#2#25#3'Top'#3#14#1#5'Width'#2'['#0#0#0 ]); diff --git a/designer/changeclassdialog.pas b/designer/changeclassdialog.pas index 2984e0c26d..a731646173 100644 --- a/designer/changeclassdialog.pas +++ b/designer/changeclassdialog.pas @@ -36,7 +36,7 @@ interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, - Buttons, AVGLvlTree, LazarusIDEStrConsts, ComponentReg; + Buttons, AVGLvlTree, PropEdits, LazarusIDEStrConsts, ComponentReg; type TChangeClassDlg = class(TForm) @@ -51,6 +51,7 @@ type NewGroupBox: TGroupBox; OldGroupBox: TGroupBox; procedure ChangeClassDlgCreate(Sender: TObject); + procedure NewClassComboBoxEditingDone(Sender: TObject); private FClasses: TAvgLvlTree; FNewClass: TClass; @@ -63,6 +64,7 @@ type procedure FillAncestorListBox(AClass: TClass; AListBox: TListBox); procedure AddClass(const AClass: TPersistentClass); procedure AddComponentClass(const AClass: TComponentClass); + function CompareClasses(Tree: TAvgLvlTree; Class1, Class2: TClass): integer; public destructor Destroy; override; procedure FillNewClassComboBox; @@ -71,33 +73,54 @@ type end; -function ShowChangeClassDialog(APersistent: TPersistent): TModalResult; - +function ShowChangeClassDialog(ADesigner: TIDesigner; + APersistent: TPersistent): TModalResult; +function ChangePersistentClass(ADesigner: TIDesigner; APersistent: TPersistent; + NewClass: TClass): TModalResult; implementation -function ShowChangeClassDialog(APersistent: TPersistent): TModalResult; +function ShowChangeClassDialog(ADesigner: TIDesigner; + APersistent: TPersistent): TModalResult; var ChangeClassDlg: TChangeClassDlg; begin Result:=mrCancel; - MessageDlg('Not implemented yet','Not implemented yet',mtInformation,[mbOk],0); - exit; + //MessageDlg('Not implemented yet','Not implemented yet',mtInformation,[mbOk],0); + //exit; ChangeClassDlg:=TChangeClassDlg.Create(Application); try ChangeClassDlg.ThePersistent:=APersistent; ChangeClassDlg.FillNewClassComboBox; + if ChangeClassDlg.ShowModal=mrOk then begin + Result:=ChangePersistentClass(ADesigner,APersistent, + ChangeClassDlg.NewClass); + end; finally ChangeClassDlg.Free; end; end; -function CompareClasses(Class1, Class2: TClass): integer; +function ChangePersistentClass(ADesigner: TIDesigner; APersistent: TPersistent; + NewClass: TClass): TModalResult; begin - // TODO - Result:=0; + // select only this persistent + GlobalDesignHook.SelectOnlyThis(APersistent); + // stream selection + + // parse + + // change class + + // check properties + + // delete selection + + // insert streamed selection + + Result:=mrCancel; end; { TChangeClassDlg } @@ -112,6 +135,11 @@ begin CancelButton.Caption:='Cancel'; end; +procedure TChangeClassDlg.NewClassComboBoxEditingDone(Sender: TObject); +begin + UpdateNewInfo; +end; + procedure TChangeClassDlg.SetThePersistent(const AValue: TPersistent); begin if FThePersistent=AValue then exit; @@ -129,6 +157,7 @@ end; procedure TChangeClassDlg.UpdateInfo; begin UpdateNewInfo; + UpdateOldInfo; end; procedure TChangeClassDlg.UpdateOldInfo; @@ -146,7 +175,21 @@ begin end; procedure TChangeClassDlg.UpdateNewInfo; +var + ANode: TAvgLvlTreeNode; begin + FNewClass:=nil; + if FClasses<>nil then begin + ANode:=FClasses.FindLowest; + while (ANode<>nil) do begin + FNewClass:=TClass(ANode.Data); + if (CompareText(NewClass.ClassName,NewClassComboBox.Text)=0) then + break + else + FNewClass:=nil; + ANode:=FClasses.FindSuccessor(ANode); + end; + end; FillAncestorListBox(NewClass,NewAncestorsListBox); if NewClass<>nil then NewClassComboBox.Text:=NewClass.ClassName @@ -175,7 +218,8 @@ end; procedure TChangeClassDlg.AddClass(const AClass: TPersistentClass); begin - + if FClasses.FindPointer(AClass)<>nil then exit; + FClasses.Add(AClass); end; procedure TChangeClassDlg.AddComponentClass(const AClass: TComponentClass); @@ -183,6 +227,54 @@ begin AddClass(AClass); end; +function TChangeClassDlg.CompareClasses(Tree: TAvgLvlTree; Class1, + Class2: TClass): integer; +// sort: +// transforming ThePersistent to descending classes is easy +// transforming ThePersistent to ascending classes is medium +// +// count distance between, that means: find nearest shared ancestor, then +// give two points for every step from ThePersistent to ancestor and one point +// for every step from ancestor to class +// +// otherwise sort for classnames + + function AncestorDistance(ChildClass, AncestorClass: TClass): integer; + begin + Result:=0; + while (ChildClass<>nil) and (ChildClass<>AncestorClass) do begin + ChildClass:=ChildClass.ClassParent; + inc(Result); + end; + end; + + function RelationDistance(SrcClass, DestClass: TClass): integer; + var + Ancestor: TClass; + begin + // find shared ancestor of + Ancestor:=SrcClass; + while (Ancestor<>nil) and (not DestClass.InheritsFrom(Ancestor)) do + Ancestor:=Ancestor.ClassParent; + // going to the ancestor is normally more difficult than going away + Result:=2*AncestorDistance(SrcClass,Ancestor) + +AncestorDistance(DestClass,Ancestor); + end; + +var + Dist1: LongInt; + Dist2: LongInt; +begin + Result:=0; + if (ThePersistent<>nil) then begin + Dist1:=RelationDistance(ThePersistent.ClassType,Class1); + Dist2:=RelationDistance(ThePersistent.ClassType,Class2); + Result:=Dist1-Dist2; + if Result<>0 then exit; + end; + Result:=CompareText(Class1.ClassName,Class2.ClassName); +end; + destructor TChangeClassDlg.Destroy; begin FClasses.Free; @@ -191,12 +283,36 @@ begin end; procedure TChangeClassDlg.FillNewClassComboBox; +var + ANode: TAvgLvlTreeNode; + List: TStringList; begin - FClasses:=TAvgLvlTree.Create(@CompareClasses); + // create/clear tree + if FClasses=nil then + FClasses:=TAvgLvlTree.Create(@CompareClasses) + else + FClasses.Clear; + // add class of ThePersistent if ThePersistent<>nil then AddClass(TPersistentClass(ThePersistent.ClassType)); + // add all registered component classes if (IDEComponentPalette<>nil) then IDEComponentPalette.IterateRegisteredClasses(@AddComponentClass); + // add list of classnames + List:=TStringList.Create; + ANode:=FClasses.FindLowest; + while ANode<>nil do begin + List.Add(TClass(ANode.Data).ClassName); + ANode:=FClasses.FindSuccessor(ANode); + end; + // assign to combobox + NewClassComboBox.Items.Assign(List); + if (NewClassComboBox.Items.IndexOf(NewClassComboBox.Text)<0) + and (NewClassComboBox.Items.Count>0) then + NewClassComboBox.Text:=NewClassComboBox.Items[0]; + UpdateNewInfo; + // clean up + List.Free; end; initialization diff --git a/designer/designer.pp b/designer/designer.pp index 7eae6bd01f..007302ab55 100644 --- a/designer/designer.pp +++ b/designer/designer.pp @@ -721,7 +721,7 @@ procedure TDesigner.DoShowChangeClassDialog; begin if (ControlSelection.Count=1) and (not ControlSelection.LookupRootSelected) then - ShowChangeClassDialog(ControlSelection[0].Persistent); + ShowChangeClassDialog(Self,ControlSelection[0].Persistent); end; procedure TDesigner.GiveComponentsNames; diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 7453b2fc61..51678c5017 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -43,7 +43,7 @@ uses // components AVL_Tree, PropEdits, ObjectInspector, IDECommands, // IDE - JITForms, NonControlForms, AbstractFormEditor, ComponentReg, IDEProcs, + JITForms, NonControlForms, FormEditingIntf, ComponentReg, IDEProcs, ComponentEditors, KeyMapping, EditorOptions, DesignerProcs; Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool]; @@ -160,14 +160,18 @@ each control that's dropped onto the form const OldMethodName, NewMethodName: shortstring); procedure SaveHiddenDesignerFormProperties(AComponent: TComponent); + function DesignerCount: integer; override; + function GetDesigner(Index: integer): TIDesigner; override; + function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor; function CreateUniqueComponentName(AComponent: TComponent): string; function CreateUniqueComponentName(const AClassName: string; - OwnerComponent: TComponent): string; + OwnerComponent: TComponent): string; Function CreateComponentInterface(AComponent: TComponent): TIComponentInterface; procedure CreateChildComponentInterfaces(AComponent: TComponent); Function CreateComponent(ParentCI : TIComponentInterface; - TypeClass: TComponentClass; X,Y,W,H : Integer): TIComponentInterface; override; + TypeClass: TComponentClass; + X,Y,W,H : Integer): TIComponentInterface; override; Function CreateComponentFromStream(BinStream: TStream; AncestorType: TComponentClass; Interactive: boolean): TIComponentInterface; override; @@ -895,6 +899,23 @@ begin NonControlForm.DoSaveBounds; end; +function TCustomFormEditor.DesignerCount: integer; +begin + Result:=JITFormList.Count+JITDataModuleList.Count; +end; + +function TCustomFormEditor.GetDesigner(Index: integer): TIDesigner; +var + AForm: TCustomForm; +begin + if Index