fixed compilation 1.0.10, started change class editor

git-svn-id: trunk@5696 -

.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

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

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
+]);

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 <http://www.gnu.org/copyleft/gpl.html>. 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.
+

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

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';

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.

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;