diff --git a/.gitattributes b/.gitattributes index 31782d40be..19365ac1d6 100644 --- a/.gitattributes +++ b/.gitattributes @@ -295,6 +295,9 @@ 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 +designer/changeclassdialog.pas svneol=native#text/pascal designer/controlselection.pp svneol=native#text/pascal designer/customeditor.pp svneol=native#text/pascal designer/designer.pp svneol=native#text/pascal diff --git a/designer/changeclassdialog.lfm b/designer/changeclassdialog.lfm new file mode 100644 index 0000000000..c036adf4fc --- /dev/null +++ b/designer/changeclassdialog.lfm @@ -0,0 +1,108 @@ +object ChangeClassDlg: TChangeClassDlg + Caption = 'ChangeClassDlg' + ClientHeight = 311 + ClientWidth = 423 + OnCreate = ChangeClassDlgCreate + HorzScrollBar.Page = 424 + VertScrollBar.Page = 312 + Left = 291 + Height = 311 + Top = 163 + Width = 423 + object OldGroupBox: TGroupBox + Caption = 'OldGroupBox' + ClientHeight = 231 + ClientWidth = 196 + ParentColor = True + TabOrder = 0 + Left = 8 + Height = 248 + Top = 8 + Width = 200 + object OldClassLabel: TLabel + Caption = 'OldClassLabel' + Left = 6 + Height = 32 + Top = 2 + Width = 185 + end + object OldAncestorGroupBox: TGroupBox + Align = alBottom + Caption = 'OldAncestorGroupBox' + ClientHeight = 175 + ClientWidth = 192 + ParentColor = True + TabOrder = 1 + Height = 192 + Top = 39 + Width = 196 + object OldAncestorsListBox: TListBox + Align = alClient + ClickOnSelChange = False + TabOrder = 0 + TopIndex = -1 + Height = 175 + Width = 192 + end + end + end + object NewGroupBox: TGroupBox + Caption = 'NewGroupBox' + ClientHeight = 231 + ClientWidth = 196 + ParentColor = True + TabOrder = 1 + Left = 216 + Height = 248 + Top = 8 + Width = 200 + object NewClassComboBox: TComboBox + MaxLength = 0 + TabOrder = 0 + Text = 'NewClassComboBox' + Left = 14 + Height = 25 + Top = 9 + Width = 174 + end + object NewAncestorGroupBox: TGroupBox + Align = alBottom + Caption = 'NewAncestorGroupBox' + ClientHeight = 175 + ClientWidth = 192 + ParentColor = True + TabOrder = 1 + Height = 192 + Top = 39 + Width = 196 + object NewAncestorsListBox: TListBox + Align = alClient + ClickOnSelChange = False + TabOrder = 0 + TopIndex = -1 + Height = 175 + Width = 192 + end + end + end + object OkButton: TButton + Anchors = [akRight, akBottom] + Caption = 'Ok' + ModalResult = 1 + TabOrder = 2 + Left = 192 + Height = 25 + Top = 270 + Width = 91 + end + object CancelButton: TButton + Anchors = [akRight, akBottom] + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + Left = 320 + Height = 25 + Top = 270 + Width = 91 + end +end diff --git a/designer/changeclassdialog.lrs b/designer/changeclassdialog.lrs new file mode 100644 index 0000000000..8055a74a13 --- /dev/null +++ b/designer/changeclassdialog.lrs @@ -0,0 +1,32 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TChangeClassDlg','FORMDATA',[ + 'TPF0'#15'TChangeClassDlg'#14'ChangeClassDlg'#7'Caption'#6#14'ChangeClassDlg' + +#12'ClientHeight'#3'7'#1#11'ClientWidth'#3#167#1#8'OnCreate'#7#20'ChangeClas' + +'sDlgCreate'#18'HorzScrollBar.Page'#3#168#1#18'VertScrollBar.Page'#3'8'#1#4 + +'Left'#3'#'#1#6'Height'#3'7'#1#3'Top'#3#163#0#5'Width'#3#167#1#0#9'TGroupBox' + +#11'OldGroupBox'#7'Caption'#6#11'OldGroupBox'#12'ClientHeight'#3#231#0#11'Cl' + +'ientWidth'#3#196#0#11'ParentColor'#9#8'TabOrder'#2#0#4'Left'#2#8#6'Height'#3 + +#248#0#3'Top'#2#8#5'Width'#3#200#0#0#6'TLabel'#13'OldClassLabel'#7'Caption'#6 + +#13'OldClassLabel'#4'Left'#2#6#6'Height'#2' '#3'Top'#2#2#5'Width'#3#185#0#0#0 + +#9'TGroupBox'#19'OldAncestorGroupBox'#5'Align'#7#8'alBottom'#7'Caption'#6#19 + +'OldAncestorGroupBox'#12'ClientHeight'#3#175#0#11'ClientWidth'#3#192#0#11'Pa' + +'rentColor'#9#8'TabOrder'#2#1#6'Height'#3#192#0#3'Top'#2''''#5'Width'#3#196#0 + +#0#8'TListBox'#19'OldAncestorsListBox'#5'Align'#7#8'alClient'#16'ClickOnSelC' + +'hange'#8#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#3#175#0#5'Width'#3#192 + +#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 +]); diff --git a/designer/changeclassdialog.pas b/designer/changeclassdialog.pas new file mode 100644 index 0000000000..6ad17c6ef1 --- /dev/null +++ b/designer/changeclassdialog.pas @@ -0,0 +1,206 @@ +{ /*************************************************************************** + ChangeClassDialog.pas - Lazarus IDE unit + ---------------------------------------- + + ***************************************************************************/ + + *************************************************************************** + * * + * 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. * + * * + *************************************************************************** + + Author: Mattias Gaertner + + Abstract: + Functions and Dialog to change the class of a designer component. +} +unit ChangeClassDialog; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + Buttons, AVGLvlTree, LazarusIDEStrConsts, ComponentReg; + +type + TPersistentClass = class of TPersistent; + + TChangeClassDlg = class(TForm) + NewClassComboBox: TComboBox; + NewAncestorGroupBox: TGroupBox; + NewAncestorsListBox: TListBox; + OldAncestorGroupBox: TGroupBox; + OldAncestorsListBox: TListBox; + OldClassLabel: TLabel; + OkButton: TButton; + CancelButton: TButton; + NewGroupBox: TGroupBox; + OldGroupBox: TGroupBox; + procedure ChangeClassDlgCreate(Sender: TObject); + private + FClasses: TAvgLvlTree; + FNewClass: TClass; + FThePersistent: TPersistent; + procedure SetNewClass(const AValue: TClass); + procedure SetThePersistent(const AValue: TPersistent); + procedure UpdateInfo; + procedure UpdateOldInfo; + procedure UpdateNewInfo; + procedure FillAncestorListBox(AClass: TClass; AListBox: TListBox); + procedure AddClass(const AClass: TPersistentClass); + procedure AddComponentClass(const AClass: TComponentClass); + public + destructor Destroy; override; + procedure FillNewClassComboBox; + property ThePersistent: TPersistent read FThePersistent write SetThePersistent; + property NewClass: TClass read FNewClass write SetNewClass; + end; + + +function ShowChangeClassDialog(APersistent: TPersistent): TModalResult; + +implementation + +function ShowChangeClassDialog(APersistent: TPersistent): TModalResult; +var + ChangeClassDlg: TChangeClassDlg; +begin + Result:=mrCancel; + MessageDlg('Not implemented yet','Not implemented yet',mtInformation,[mbOk],0); + exit; + + ChangeClassDlg:=TChangeClassDlg.Create(Application); + try + ChangeClassDlg.ThePersistent:=APersistent; + ChangeClassDlg.FillNewClassComboBox; + finally + ChangeClassDlg.Free; + end; +end; + +function CompareClasses(Class1, Class2: TClass): integer; +begin + // TODO + Result:=0; +end; + +{ TChangeClassDlg } + +procedure TChangeClassDlg.ChangeClassDlgCreate(Sender: TObject); +begin + OldGroupBox.Caption:='Old Class'; + NewGroupBox.Caption:='New Class'; + OldAncestorGroupBox.Caption:='Old Ancestors'; + NewAncestorGroupBox.Caption:='New Ancestors'; + OkButton.Caption:='Ok'; + CancelButton.Caption:='Cancel'; +end; + +procedure TChangeClassDlg.SetThePersistent(const AValue: TPersistent); +begin + if FThePersistent=AValue then exit; + FThePersistent:=AValue; + UpdateInfo; +end; + +procedure TChangeClassDlg.SetNewClass(const AValue: TClass); +begin + if FNewClass=AValue then exit; + FNewClass:=AValue; + UpdateNewInfo; +end; + +procedure TChangeClassDlg.UpdateInfo; +begin + UpdateNewInfo; +end; + +procedure TChangeClassDlg.UpdateOldInfo; +begin + FillAncestorListBox(ThePersistent.ClassType,OldAncestorsListBox); + if ThePersistent<>nil then begin + if ThePersistent is TComponent then + OldClassLabel.Caption:= + TComponent(ThePersistent).Name+':'+ThePersistent.ClassName + else + OldClassLabel.Caption:=ThePersistent.ClassName; + end else begin + OldClassLabel.Caption:='no class'; + end; +end; + +procedure TChangeClassDlg.UpdateNewInfo; +begin + FillAncestorListBox(NewClass,NewAncestorsListBox); + if NewClass<>nil then + NewClassComboBox.Text:=NewClass.ClassName + else + NewClassComboBox.Text:=''; +end; + +procedure TChangeClassDlg.FillAncestorListBox(AClass: TClass; AListBox: TListBox + ); +var + List: TStringList; + + procedure AddAncestor(CurClass: TClass); + begin + if CurClass=nil then exit; + List.Insert(0,CurClass.ClassName); + AddAncestor(CurClass.ClassParent); + end; + +begin + List:=TStringList.Create; + AddAncestor(AClass); + AListBox.Items.Assign(List); + List.Free; +end; + +procedure TChangeClassDlg.AddClass(const AClass: TPersistentClass); +begin + +end; + +procedure TChangeClassDlg.AddComponentClass(const AClass: TComponentClass); +begin + AddClass(AClass); +end; + +destructor TChangeClassDlg.Destroy; +begin + FClasses.Free; + FClasses:=nil; + inherited Destroy; +end; + +procedure TChangeClassDlg.FillNewClassComboBox; +begin + FClasses:=TAvgLvlTree.Create(@CompareClasses); + if ThePersistent<>nil then + AddClass(TPersistentClass(ThePersistent.ClassType)); + if (IDEComponentPalette<>nil) then + IDEComponentPalette.IterateRegisteredClasses(@AddComponentClass); +end; + +initialization + {$I changeclassdialog.lrs} + +end. + diff --git a/designer/designer.pp b/designer/designer.pp index 3c5e011b77..e405d51a36 100644 --- a/designer/designer.pp +++ b/designer/designer.pp @@ -41,7 +41,7 @@ uses LazarusIDEStrConsts, EnvironmentOpts, KeyMapping, ComponentReg, NonControlForms, AlignCompsDlg, SizeCompsDlg, ScaleCompsDlg, TabOrderDlg, DesignerProcs, PropEdits, ComponentEditors, CustomFormEditor, - ControlSelection; + ControlSelection, ChangeClassDialog; type TDesigner = class; @@ -82,6 +82,7 @@ type private FAlignMenuItem: TMenuItem; FBringToFrontMenuItem: TMenuItem; + fChangeClassMenuItem: TMenuItem; FCopyMenuItem: TMenuItem; FCutMenuItem: TMenuItem; FDeleteSelectionMenuItem: TMenuItem; @@ -176,11 +177,13 @@ type function DoCopySelectionToClipboard: boolean; procedure DoPasteSelectionFromClipboard; procedure DoShowTabOrderEditor; + procedure DoShowChangeClassDialog; procedure GiveComponentsNames; procedure NotifyComponentAdded(AComponent: TComponent); // popup menu procedure BuildPopupMenu; + procedure OnComponentEditorVerbMenuItemClick(Sender: TObject); procedure OnAlignPopupMenuClick(Sender: TObject); procedure OnMirrorHorizontalPopupMenuClick(Sender: TObject); procedure OnMirrorVerticalPopupMenuClick(Sender: TObject); @@ -193,8 +196,8 @@ type procedure OnCutMenuClick(Sender: TObject); procedure OnPasteMenuClick(Sender: TObject); procedure OnDeleteSelectionMenuClick(Sender: TObject); + procedure OnChangeClassMenuClick(Sender: TObject); procedure OnSnapToGridOptionMenuClick(Sender: TObject); - procedure OnComponentEditorVerbMenuItemClick(Sender: TObject); procedure OnShowOptionsMenuItemClick(Sender: TObject); procedure OnSnapToGuideLinesOptionMenuClick(Sender: TObject); @@ -711,6 +714,13 @@ begin Modified; end; +procedure TDesigner.DoShowChangeClassDialog; +begin + if (ControlSelection.Count=1) and (not ControlSelection.LookupRootSelected) + then + ShowChangeClassDialog(ControlSelection[0].Component); +end; + procedure TDesigner.GiveComponentsNames; var i: Integer; @@ -1871,6 +1881,11 @@ begin DoDeleteSelectedComponents; end; +procedure TDesigner.OnChangeClassMenuClick(Sender: TObject); +begin + DoShowChangeClassDialog; +end; + procedure TDesigner.OnSnapToGridOptionMenuClick(Sender: TObject); begin EnvironmentOptions.SnapToGrid:=not EnvironmentOptions.SnapToGrid; @@ -2299,10 +2314,21 @@ begin with FDeleteSelectionMenuItem do begin Caption:= fdmDeleteSelection; OnClick:=@OnDeleteSelectionMenuClick; - Enabled:= ControlSelIsNotEmpty and (not LookupRootIsSelected); + Enabled:= CompsAreSelected; end; FPopupMenu.Items.Add(FDeleteSelectionMenuItem); + AddSeparator; + + // extras + fChangeClassMenuItem:=TMenuItem.Create(FPopupMenu); + with fChangeClassMenuItem do begin + Caption:= lisChangeClass; + OnClick:=@OnChangeClassMenuClick; + Enabled:= CompsAreSelected and (ControlSelection.Count=1); + end; + FPopupMenu.Items.Add(fChangeClassMenuItem); + AddSeparator; // options diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index b82dc935a0..72501a05a6 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -1032,6 +1032,7 @@ resourcestring fdmBringTofront='Bring to front'; fdmSendtoback='Send to back'; fdmDeleteSelection='Delete selection'; + lisChangeClass = 'Change Class'; fdmSnapToGridOption='Option: Snap to grid'; fdmSnapToGuideLinesOption='Option: Snap to guide lines'; fdmShowOptions='Show Options for form editing'; diff --git a/ide/sortselectiondlg.pas b/ide/sortselectiondlg.pas index 8612698af7..d597a150fd 100644 --- a/ide/sortselectiondlg.pas +++ b/ide/sortselectiondlg.pas @@ -122,6 +122,13 @@ begin SortSelectionDialog.Free; end; +function ShowSortSelectionDialogBase(const TheText: string; + Highlighter: TObject; var SortedText: string): TModalResult; +begin + Result:=ShowSortSelectionDialog(TheText,Highlighter as TSynCustomHighlighter, + SortedText); +end; + type TTextBlockCompareSettings = class public @@ -597,7 +604,7 @@ begin end; initialization - TextTools.ShowSortSelectionDialogFunc:=@ShowSortSelectionDialog; + TextTools.ShowSortSelectionDialogFunc:=@ShowSortSelectionDialogBase; TextTools.SortTextFunc:=@SortText; end. diff --git a/packager/componentreg.pas b/packager/componentreg.pas index 7627e9b99c..f7c1b4f553 100644 --- a/packager/componentreg.pas +++ b/packager/componentreg.pas @@ -29,7 +29,7 @@ Author: Mattias Gaertner Abstract: - + Classes and functions to register components. } unit ComponentReg; @@ -139,6 +139,7 @@ type TEndUpdatePaletteEvent = procedure(Sender: TObject; PaletteChanged: boolean) of object; + TGetComponentClass = procedure(const AClass: TComponentClass) of object; TBaseComponentPalette = class private @@ -177,6 +178,7 @@ type function CreateNewClassName(const Prefix: string): string; function IndexOfPageComponent(AComponent: TComponent): integer; procedure ShowHideControls(Show: boolean); + procedure IterateRegisteredClasses(Proc: TGetComponentClass); public property Pages[Index: integer]: TBaseComponentPage read GetItems; default; property UpdateLock: integer read FUpdateLock; @@ -619,6 +621,20 @@ begin EndUpdate; end; +procedure TBaseComponentPalette.IterateRegisteredClasses( + Proc: TGetComponentClass); +var + i: Integer; + APage: TBaseComponentPage; + j: Integer; +begin + for i:=0 to Count-1 do begin + APage:=Pages[i]; + for j:=0 to APage.Count-1 do + Proc(APage[j].ComponentClass); + end; +end; + initialization IDEComponentPalette:=nil;