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

fixed compilation 1.0.10, started change class editor

Browse Source 
git-svn-id: trunk@5696 -
This commit is contained in:
mattias 2004-07-20 21:36:16 +00:00
parent 0b3c4f7832
commit fe3c2b2ab2
8 changed files with 404 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -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

108
designer/changeclassdialog.lfm Normal file
View File

@ -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

32
designer/changeclassdialog.lrs Normal file
View File

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

206
designer/changeclassdialog.pas Normal file
View File

@ -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.

32
designer/designer.pp
View File

@ -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

1
ide/lazarusidestrconsts.pas
View File

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

9
ide/sortselectiondlg.pas
View File

@ -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.

18
packager/componentreg.pas
View File

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