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

IDE: added New file item inherited component based on bug/patch 1287

Browse Source 
git-svn-id: trunk@15076 -
This commit is contained in:
mattias 2008-05-08 12:39:46 +00:00
parent a1c2e3700b
commit e98cde9ee1
9 changed files with 435 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ide/lazarusidestrconsts.pas
View File

@ -2470,6 +2470,8 @@ resourcestring
// new dialog
lisNewDlgNoItemSelected = 'No item selected';
lisErrorOpeningComponent = 'Error opening component';
lisUnableToOpenAncestorComponent = 'Unable to open ancestor component';
lisNewDlgPleaseSelectAnItemFirst = 'Please select an item first.';
lisNewDlgCreateANewEditorFileChooseAType = 'Create a new editor file.%'
+'sChoose a type.';
@ -2477,6 +2479,9 @@ resourcestring
+'type.';
lisChooseOneOfTheseItemsToCreateANewFile = 'Choose one of these items to '
+'create a new File';
lisChooseOneOfTheseItemsToInheritFromAnExistingOne = 'Choose one of these items to '
+'inherit from an existing one';
lisInheritedItem = 'Inherited Item';
lisChooseOneOfTheseItemsToCreateANewProject = 'Choose one of these items to '
+'create a new Project';
lisChooseOneOfTheseItemsToCreateANewPackage = 'Choose one of these items to '
@ -2487,6 +2492,7 @@ resourcestring
lisNewDlgCreateANewUnitWithADataModule = 'Create a new unit with a datamodule.';
lisNewDlgCreateANewUnitWithAFrame = 'Create a new unit with a frame';
lisNewDlgCreateANewEmptyTextFile = 'Create a new empty text file.';
lisNewDlgInheritAnExistingComponent = 'Inherit from an existing component.';
lisASimplePascalProgramFileThisCanBeUsedForQuickAndDi = 'A simple Pascal '
+'Program file.%sThis can be used for quick and dirty testing.%sBetter '
+'create a new project.';

80
ide/main.pp
View File

@ -691,6 +691,9 @@ type
const CursorPosition: TPoint; TopLine: integer;
PageIndex: integer; Flags: TOpenFlags): TModalResult; override;
function DoRevertEditorFile(const Filename: string): TModalResult; override;
function DoOpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags;
out Component: TComponent): TModalResult; override;
function DoSaveAll(Flags: TSaveFlags): TModalResult;
procedure DoRestart;
procedure DoExecuteRemoteControl;
@ -2028,6 +2031,7 @@ end;
procedure TMainIDE.SetupStandardProjectTypes;
begin
NewIDEItems.Add(TNewLazIDEItemCategoryFile.Create(FileDescGroupName));
NewIDEItems.Add(TNewLazIDEItemCategoryInheritedItem.Create(InheritedItemsGroupName));
NewIDEItems.Add(TNewLazIDEItemCategoryProject.Create(ProjDescGroupName));
// file descriptors
@ -2043,6 +2047,8 @@ begin
RegisterProjectFileDescriptor(TFileDescSimplePascalProgram.Create);
RegisterProjectFileDescriptor(TFileDescText.Create);
RegisterProjectFileDescriptor(TFileDescInheritedComponent.Create, InheritedItemsGroupName);
// project descriptors
LazProjectDescriptors:=TLazProjectDescriptors.Create;
RegisterProjectDescriptor(TProjectApplicationDescriptor.Create);
@ -4351,6 +4357,69 @@ begin
Result:=mrOk;
end;
function TMainIDE.DoOpenComponent(const UnitFilename: string;
OpenFlags: TOpenFlags; CloseFlags: TCloseFlags;
out Component: TComponent): TModalResult;
var
AnUnitInfo: TUnitInfo;
LFMFilename: String;
UnitCode: TCodeBuffer;
LFMCode: TCodeBuffer;
begin
if not FileExistsInIDE(UnitFilename,[]) then begin
DebugLn(['TMainIDE.DoOpenComponent file not found ',UnitFilename]);
exit(mrCancel);
end;
AnUnitInfo:=Project1.UnitInfoWithFilename(UnitFilename);
if (not (ofRevert in OpenFlags))
and (AnUnitInfo<>nil) and (AnUnitInfo.Component<>nil) then begin
// already open
Component:=AnUnitInfo.Component;
Result:=mrOk;
exit;
end;
LFMFilename:=ChangeFileExt(UnitFilename,'.lfm');
if not FileExistsInIDE(LFMFilename,[]) then begin
DebugLn(['TMainIDE.DoOpenComponent file not found ',LFMFilename]);
exit(mrCancel);
end;
// load unit source
Result:=LoadCodeBuffer(UnitCode,UnitFilename,[lbfCheckIfText]);
if Result<>mrOk then begin
debugln('TMainIDE.DoOpenComponent Failed loading ',UnitFilename);
exit;
end;
// create unit info
if AnUnitInfo=nil then begin
AnUnitInfo:=TUnitInfo.Create(UnitCode);
AnUnitInfo.ReadUnitNameFromSource(true);
Project1.AddFile(AnUnitInfo,false);
end;
// load lfm source
Result:=LoadCodeBuffer(LFMCode,LFMFilename,[lbfCheckIfText]);
if Result<>mrOk then begin
debugln('TMainIDE.DoOpenComponent Failed loading ',LFMFilename);
exit;
end;
// load resource
Result:=DoLoadLFM(AnUnitInfo,LFMCode,OpenFlags,CloseFlags);
if Result<>mrOk then begin
debugln('TMainIDE.DoOpenComponent DoLoadLFM failed ',LFMFilename);
exit;
end;
Component:=AnUnitInfo.Component;
if Component<>nil then
Result:=mrOk
else
Result:=mrCancel;
end;
function TMainIDE.DoShowSaveFileAsDialog(AnUnitInfo: TUnitInfo;
var ResourceCode: TCodeBuffer): TModalResult;
var
@ -5958,7 +6027,7 @@ begin
AnUnitInfo.LoadingComponent:=true;
try
// search component lfm
debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' AComponentName=',AComponentClassName,' AComponentClass=',dbgsName(AComponentClass));
debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' AComponentClassName=',AComponentClassName,' AComponentClass=',dbgsName(AComponentClass));
// first search the resource of ComponentUnitInfo
if ComponentUnitInfo<>nil then begin
@ -6714,7 +6783,8 @@ var
LFMCode: TCodeBuffer;
AProject: TProject;
begin
debugln('TMainIDE.DoNewEditorFile A NewFilename=',NewFilename);
//debugln('TMainIDE.DoNewEditorFile A NewFilename=',NewFilename);
// empty NewFilename is ok, it will be auto generated
SaveSourceEditorChangesToCodeCache(-1);
// convert macros in filename
@ -6799,8 +6869,10 @@ begin
// create component
AncestorType:=NewFileDescriptor.ResourceClass;
//DebugLn(['TMainIDE.DoNewFile AncestorType=',dbgsName(AncestorType),' ComponentName',NewUnitInfo.ComponentName]);
if AncestorType<>nil then begin
LFMSourceText:=NewFileDescriptor.GetResourceSource;
LFMSourceText:=NewFileDescriptor.GetResourceSource(NewUnitInfo.ComponentName);
//DebugLn(['TMainIDE.DoNewFile LFMSourceText=',LFMSourceText]);
if LFMSourceText<>'' then begin
// the NewFileDescriptor provides a custom .lfm source
// -> put it into a new .lfm buffer and load it
@ -6809,6 +6881,7 @@ begin
LFMCode.Source:=LFMSourceText;
//debugln('TMainIDE.DoNewEditorFile A ',LFMFilename);
Result:=DoLoadLFM(NewUnitInfo,LFMCode,[],[]);
//DebugLn(['TMainIDE.DoNewFile ',dbgsName(NewUnitInfo.Component),' ',dbgsName(NewUnitInfo.Component.ClassParent)]);
end else begin
// create a default form/datamodule
Result:=CreateNewForm(NewUnitInfo,AncestorType,nil);
@ -14383,3 +14456,4 @@ initialization
end.

93
ide/mainintf.pas
View File

@ -233,7 +233,6 @@ type
function GetLocalizedDescription: string; override;
end;
{ TFileDescPascalUnitWithDataModule }
TFileDescPascalUnitWithDataModule = class(TFileDescPascalUnitWithResource)
@ -254,6 +253,32 @@ type
function GetLocalizedDescription: string; override;
end;
{ TFileDescInheritedItem }
TFileDescInheritedItem = class(TFileDescPascalUnitWithResource)
private
FInheritedUnits: string;
public
function GetResourceSource(const ResourceName: string): string; override;
function GetInterfaceSource(const Filename, SourceName,
ResourceName: string): string; override;
property InheritedUnits: string read FInheritedUnits write FInheritedUnits;
end;
{ TFileDescInheritedComponent }
TFileDescInheritedComponent = class(TFileDescInheritedItem)
private
FInheritedUnit: TUnitInfo;
procedure SetInheritedUnit(const AValue: TUnitInfo);
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
property InheritedUnit: TUnitInfo read FInheritedUnit write SetInheritedUnit;
end;
{ TFileDescSimplePascalProgram }
TFileDescSimplePascalProgram = class(TFileDescPascalUnit)
@ -265,7 +290,6 @@ type
ResourceName: string): string; override;
end;
{ TFileDescText }
TFileDescText = class(TProjectFileDescriptor)
@ -494,5 +518,70 @@ begin
Result := lisNewDlgCreateANewUnitWithAFrame;
end;
{ TFileDescInheritedComponent }
procedure TFileDescInheritedComponent.SetInheritedUnit(const AValue: TUnitInfo
);
begin
if FInheritedUnit=AValue then exit;
FInheritedUnit:=AValue;
InheritedUnits:=FInheritedUnit.UnitName;
end;
constructor TFileDescInheritedComponent.Create;
begin
inherited Create;
Name := FileDescNameLCLInheritedComponent;
ResourceClass := TForm;// will be adjusted on the fly
UseCreateFormStatements := true;
end;
function TFileDescInheritedComponent.GetInterfaceUsesSection: string;
begin
Result:=inherited GetInterfaceUsesSection;
Result := Result+', Forms, Controls, Graphics, Dialogs';
if InheritedUnits<>'' then
Result := Result+', '+InheritedUnits;
end;
function TFileDescInheritedComponent.GetLocalizedName: string;
begin
Result:='Inherited Component';
end;
function TFileDescInheritedComponent.GetLocalizedDescription: string;
begin
Result:=lisNewDlgInheritAnExistingComponent;
end;
{ TFileDescInheritedItem }
function TFileDescInheritedItem.GetResourceSource(const ResourceName: string): string;
begin
Result := 'inherited '+ ResourceName+': T'+ResourceName+LineEnding+
'end';
end;
function TFileDescInheritedItem.GetInterfaceSource(const Filename, SourceName,
ResourceName: string): string;
var
LE: string;
begin
LE:=LineEnding;
Result:=
'type'+LE
+' T'+ResourceName+' = class('+ResourceClass.ClassName+')'+LE
+' private'+LE
+' { private declarations }'+LE
+' public'+LE
+' { public declarations }'+LE
+' end;'+LE
+LE
+'var'+LE
+' '+ResourceName+': T'+ResourceName+';'+LE
+LE;
end;
end.

79
ide/newdialog.lfm
View File

@ -1,24 +1,25 @@
object NewOtherDialog: TNewOtherDialog
Left = 254
Height = 296
Top = 202
Width = 397
HorzScrollBar.Page = 396
VertScrollBar.Page = 295
ActiveControl = CancelButton
Left = 271
Height = 395
Top = 156
Width = 476
HorzScrollBar.Page = 475
VertScrollBar.Page = 394
ActiveControl = ItemsTreeView
BorderIcons = [biSystemMenu]
Caption = 'NewOtherDialog'
ClientHeight = 296
ClientWidth = 397
ClientHeight = 395
ClientWidth = 476
Position = poScreenCenter
LCLVersion = '0.9.25'
object CancelButton: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 293
Left = 372
Height = 29
Top = 261
Top = 360
Width = 98
Anchors = [akRight, akBottom]
AutoSize = True
@ -33,9 +34,9 @@ object NewOtherDialog: TNewOtherDialog
AnchorSideRight.Control = CancelButton
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 212
Left = 291
Height = 29
Top = 261
Top = 360
Width = 75
Anchors = [akRight, akBottom]
AutoSize = True
@ -50,22 +51,22 @@ object NewOtherDialog: TNewOtherDialog
object Panel1: TPanel
AnchorSideBottom.Control = OkButton
Left = 6
Height = 249
Height = 348
Top = 6
Width = 385
Width = 464
Align = alTop
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
BevelOuter = bvNone
ClientHeight = 249
ClientWidth = 385
ClientHeight = 348
ClientWidth = 464
TabOrder = 2
object ItemsTreeView: TTreeView
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideBottom.Control = CancelButton
Height = 249
Width = 182
Height = 348
Width = 178
Align = alClient
DefaultItemHeight = 19
ScrollBars = ssAutoBoth
@ -80,29 +81,49 @@ object NewOtherDialog: TNewOtherDialog
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CancelButton
Left = 187
Height = 249
Width = 198
Left = 183
Height = 348
Width = 281
Align = alRight
Caption = 'DescriptionGroupBox'
ClientHeight = 230
ClientWidth = 194
ClientHeight = 329
ClientWidth = 277
TabOrder = 1
object DescriptionLabel: TLabel
Left = 6
Height = 218
Height = 173
Top = 6
Width = 182
Width = 265
Align = alClient
BorderSpacing.Around = 6
Caption = 'DescriptionLabel'
ParentColor = False
WordWrap = True
end
object InheritableComponentsListView: TListView
Height = 144
Top = 185
Width = 277
Align = alBottom
Columns = <
item
Caption = 'Form'
Width = 100
end
item
Caption = 'Unit'
Width = 250
end>
HideSelection = False
ReadOnly = True
RowSelect = True
TabOrder = 0
ViewStyle = vsReport
end
end
object Splitter1: TSplitter
Left = 182
Height = 249
Left = 178
Height = 348
Width = 5
Align = alRight
ResizeAnchor = akRight
@ -114,7 +135,7 @@ object NewOtherDialog: TNewOtherDialog
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 29
Top = 261
Top = 360
Width = 84
Anchors = [akLeft, akBottom]
AutoSize = True

90
ide/newdialog.lrs
View File

@ -1,47 +1,51 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TNewOtherDialog','FORMDATA',[
'TPF0'#15'TNewOtherDialog'#14'NewOtherDialog'#4'Left'#3#254#0#6'Height'#3'('#1
+#3'Top'#3#202#0#5'Width'#3#141#1#18'HorzScrollBar.Page'#3#140#1#18'VertScrol'
+'lBar.Page'#3''''#1#13'ActiveControl'#7#12'CancelButton'#11'BorderIcons'#11
+#12'biSystemMenu'#0#7'Caption'#6#14'NewOtherDialog'#12'ClientHeight'#3'('#1
+#11'ClientWidth'#3#141#1#8'Position'#7#14'poScreenCenter'#0#7'TButton'#12'Ca'
+'ncelButton'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'
+#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.'
+'Side'#7#9'asrBottom'#4'Left'#3'%'#1#6'Height'#2#29#3'Top'#3#5#1#5'Width'#2
+'b'#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Ar'
+'ound'#2#6#7'Caption'#6#12'CancelButton'#21'Constraints.MinHeight'#2#25#20'C'
+'onstraints.MinWidth'#2'K'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'
+#8'OkButton'#23'AnchorSideRight.Control'#7#12'CancelButton'#24'AnchorSideBot'
+'tom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3
+#212#0#6'Height'#2#29#3'Top'#3#5#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8
+'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#8'OkBut'
+'ton'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#7'Enabled'
+#8#7'OnClick'#7#13'OkButtonClick'#8'TabOrder'#2#1#0#0#6'TPanel'#6'Panel1'#24
+'AnchorSideBottom.Control'#7#8'OkButton'#4'Left'#2#6#6'Height'#3#249#0#3'Top'
+#2#6#5'Width'#3#129#1#5'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#7
+'akRight'#8'akBottom'#0#20'BorderSpacing.Around'#2#6#10'BevelOuter'#7#6'bvNo'
+'ne'#12'ClientHeight'#3#249#0#11'ClientWidth'#3#129#1#8'TabOrder'#2#2#0#9'TT'
+'reeView'#13'ItemsTreeView'#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorS'
+'ideTop.Control'#7#5'Owner'#24'AnchorSideBottom.Control'#7#12'CancelButton'#6
+'Height'#3#249#0#5'Width'#3#182#0#5'Align'#7#8'alClient'#17'DefaultItemHeigh'
+'t'#2#19#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#10'OnDblClick'#7#13
+'OkButtonClick'#18'OnSelectionChanged'#7#29'ItemsTreeViewSelectionChanged'#0
+#0#9'TGroupBox'#19'DescriptionGroupBox'#22'AnchorSideLeft.Control'#7#13'Item'
+'sTreeView'#19'AnchorSideLeft.Side'#7#9'asrBottom'#21'AnchorSideTop.Control'
+#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7
+#9'asrBottom'#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#3#187#0
+#6'Height'#3#249#0#5'Width'#3#198#0#5'Align'#7#7'alRight'#7'Caption'#6#19'De'
+'scriptionGroupBox'#12'ClientHeight'#3#230#0#11'ClientWidth'#3#194#0#8'TabOr'
+'der'#2#1#0#6'TLabel'#16'DescriptionLabel'#4'Left'#2#6#6'Height'#3#218#0#3'T'
+'op'#2#6#5'Width'#3#182#0#5'Align'#7#8'alClient'#20'BorderSpacing.Around'#2#6
+#7'Caption'#6#16'DescriptionLabel'#11'ParentColor'#8#8'WordWrap'#9#0#0#0#9'T'
+'Splitter'#9'Splitter1'#4'Left'#3#182#0#6'Height'#3#249#0#5'Width'#2#5#5'Ali'
+'gn'#7#7'alRight'#12'ResizeAnchor'#7#7'akRight'#0#0#0#7'TButton'#10'HelpButt'
+'on'#22'AnchorSideLeft.Control'#7#5'Owner'#24'AnchorSideBottom.Control'#7#5
+'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#29#3
+'Top'#3#5#1#5'Width'#2'T'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#8'AutoSize'#9
+#20'BorderSpacing.Around'#2#6#7'Caption'#6#10'HelpButton'#21'Constraints.Min'
+'Height'#2#25#20'Constraints.MinWidth'#2'K'#7'OnClick'#7#15'HelpButtonClick'
+#8'TabOrder'#2#3#0#0#0
'TPF0'#15'TNewOtherDialog'#14'NewOtherDialog'#4'Left'#3#15#1#6'Height'#3#139#1
+#3'Top'#3#156#0#5'Width'#3#220#1#18'HorzScrollBar.Page'#3#219#1#18'VertScrol'
+'lBar.Page'#3#138#1#13'ActiveControl'#7#13'ItemsTreeView'#11'BorderIcons'#11
+#12'biSystemMenu'#0#7'Caption'#6#14'NewOtherDialog'#12'ClientHeight'#3#139#1
+#11'ClientWidth'#3#220#1#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#6
+'0.9.25'#0#7'TButton'#12'CancelButton'#23'AnchorSideRight.Control'#7#5'Owner'
+#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#5'Ow'
+'ner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3't'#1#6'Height'#2#29
+#3'Top'#3'h'#1#5'Width'#2'b'#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSi'
+'ze'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'CancelButton'#21'Constra'
+'ints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#11'ModalResult'#2#2#8'Ta'
+'bOrder'#2#0#0#0#7'TButton'#8'OkButton'#23'AnchorSideRight.Control'#7#12'Can'
+'celButton'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'
+#7#9'asrBottom'#4'Left'#3'#'#1#6'Height'#2#29#3'Top'#3'h'#1#5'Width'#2'K'#7
+'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'
+#2#6#7'Caption'#6#8'OkButton'#21'Constraints.MinHeight'#2#25#20'Constraints.'
+'MinWidth'#2'K'#7'Enabled'#8#7'OnClick'#7#13'OkButtonClick'#8'TabOrder'#2#1#0
+#0#6'TPanel'#6'Panel1'#24'AnchorSideBottom.Control'#7#8'OkButton'#4'Left'#2#6
+#6'Height'#3'\'#1#3'Top'#2#6#5'Width'#3#208#1#5'Align'#7#5'alTop'#7'Anchors'
+#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#20'BorderSpacing.Around'#2#6
+#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#3'\'#1#11'ClientWidth'#3#208#1#8
+'TabOrder'#2#2#0#9'TTreeView'#13'ItemsTreeView'#22'AnchorSideLeft.Control'#7
+#5'Owner'#21'AnchorSideTop.Control'#7#5'Owner'#24'AnchorSideBottom.Control'#7
+#12'CancelButton'#6'Height'#3'\'#1#5'Width'#3#178#0#5'Align'#7#8'alClient'#17
+'DefaultItemHeight'#2#19#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#10
+'OnDblClick'#7#13'OkButtonClick'#18'OnSelectionChanged'#7#29'ItemsTreeViewSe'
+'lectionChanged'#0#0#9'TGroupBox'#19'DescriptionGroupBox'#22'AnchorSideLeft.'
+'Control'#7#13'ItemsTreeView'#19'AnchorSideLeft.Side'#7#9'asrBottom'#21'Anch'
+'orSideTop.Control'#7#5'Owner'#23'AnchorSideRight.Control'#7#5'Owner'#20'Anc'
+'horSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#12'CancelB'
+'utton'#4'Left'#3#183#0#6'Height'#3'\'#1#5'Width'#3#25#1#5'Align'#7#7'alRigh'
+'t'#7'Caption'#6#19'DescriptionGroupBox'#12'ClientHeight'#3'I'#1#11'ClientWi'
+'dth'#3#21#1#8'TabOrder'#2#1#0#6'TLabel'#16'DescriptionLabel'#4'Left'#2#6#6
+'Height'#3#173#0#3'Top'#2#6#5'Width'#3#9#1#5'Align'#7#8'alClient'#20'BorderS'
+'pacing.Around'#2#6#7'Caption'#6#16'DescriptionLabel'#11'ParentColor'#8#8'Wo'
+'rdWrap'#9#0#0#9'TListView'#29'InheritableComponentsListView'#6'Height'#3#144
+#0#3'Top'#3#185#0#5'Width'#3#21#1#5'Align'#7#8'alBottom'#7'Columns'#14#1#7'C'
+'aption'#6#4'Form'#5'Width'#2'd'#0#1#7'Caption'#6#4'Unit'#5'Width'#3#250#0#0
+#0#13'HideSelection'#8#8'ReadOnly'#9#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewSt'
+'yle'#7#8'vsReport'#0#0#0#9'TSplitter'#9'Splitter1'#4'Left'#3#178#0#6'Height'
+#3'\'#1#5'Width'#2#5#5'Align'#7#7'alRight'#12'ResizeAnchor'#7#7'akRight'#0#0
+#0#7'TButton'#10'HelpButton'#22'AnchorSideLeft.Control'#7#5'Owner'#24'Anchor'
+'SideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'L'
+'eft'#2#6#6'Height'#2#29#3'Top'#3'h'#1#5'Width'#2'T'#7'Anchors'#11#6'akLeft'
+#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#10'He'
+'lpButton'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#7'On'
+'Click'#7#15'HelpButtonClick'#8'TabOrder'#2#3#0#0#0
]);

140
ide/newdialog.pas
View File

@ -40,9 +40,11 @@ unit NewDialog;
interface
uses
Buttons, Classes, ComCtrls, Controls, Dialogs, Forms, IDEWindowIntf,
LazarusIDEStrConsts, LCLProc, LResources, NewItemIntf, PackageIntf,
ProjectIntf, StdCtrls, SysUtils, ExtCtrls, IDEContextHelpEdit, IDEImagesIntf;
Buttons, SysUtils, Classes, LCLProc, LResources,ComCtrls, Controls, Dialogs,
Forms, StdCtrls, ExtCtrls, FileProcs,
IDEWindowIntf, IDEImagesIntf, NewItemIntf, PackageIntf, ProjectIntf,
LazIDEIntf,
LazarusIDEStrConsts, IDEContextHelpEdit, Project, MainIntf;
type
{ TNewLazIDEItemCategory }
@ -106,6 +108,14 @@ type
function Description: string; override;
end;
{ TNewLazIDEItemCategoryInheritedItem }
TNewLazIDEItemCategoryInheritedItem = class(TNewLazIDEItemCategory)
public
function LocalizedName: string; override;
function Description: string; override;
end;
{ TNewLazIDEItemCategoryProject }
TNewLazIDEItemCategoryProject = class(TNewLazIDEItemCategory)
@ -121,7 +131,7 @@ type
function LocalizedName: string; override;
function Description: string; override;
end;
//----------------------------------------------------------------------------
@ -132,6 +142,7 @@ type
DescriptionGroupBox: TGroupBox;
DescriptionLabel: TLabel;
ItemsTreeView: TTreeView;
InheritableComponentsListView: TListView;
OkButton: TButton;
CancelButton: TButton;
Panel1: TPanel;
@ -143,6 +154,7 @@ type
ImageIndexFolder: integer;
ImageIndexTemplate: integer;
FNewItem: TNewIDEItemTemplate;
procedure FillProjectInheritableItemsList;
procedure FillItemsTree;
procedure SetupComponents;
procedure UpdateDescription;
@ -176,8 +188,14 @@ end;
procedure TNewOtherDialog.OkButtonClick(Sender: TObject);
var
AInheritedNode: TListItem;
ANode: TTreeNode;
NewFile: TNewItemProjectFile;
AncestorComponent: TComponent;
AnUnitInfo: TUnitInfo;
InhCompItem: TFileDescInheritedComponent;
begin
ANode := ItemsTreeView.Selected;
if (ANode = nil) or (ANode.Data = nil) or
(not (TObject(ANode.Data) is TNewIDEItemTemplate)) then
@ -189,10 +207,87 @@ begin
FNewItem := nil;
exit;
end;
FNewItem := TNewIDEItemTemplate(ANode.Data);
FNewItem := TNewIDEItemTemplate(ANode.Data);
// if the selected item is an inherited one
if FNewItem is TNewItemProjectFile then
begin
//
NewFile:=TNewItemProjectFile(FNewItem);
if (NewFile.Descriptor is TFileDescInheritedItem) then
begin
AInheritedNode := nil;
// If we are inheriting from a form
if (NewFile.Descriptor is TFileDescInheritedComponent) then begin
InhCompItem:=TFileDescInheritedComponent(NewFile.Descriptor);
AInheritedNode := InheritableComponentsListView.Selected;
// load the ancestor component
AnUnitInfo:=TUnitInfo(AInheritedNode.Data);
if LazarusIDE.DoOpenComponent(AnUnitInfo.Filename,
[ofOnlyIfExists,ofQuiet,ofLoadHiddenResource,ofUseCache],[],
AncestorComponent)<>mrOk then
begin
MessageDlg(lisErrorOpeningComponent,
lisUnableToOpenAncestorComponent, mtError, [mbCancel], 0);
exit;
end;
// Set the resource class of the file descriptor
InhCompItem.ResourceClass := TPersistentClass(AncestorComponent.ClassType);
InhCompItem.InheritedUnit := AnUnitInfo;
end
else
begin
MessageDlg(lisNewDlgNoItemSelected,
lisNewDlgPleaseSelectAnItemFirst, mtInformation, [mbOK], 0);
FNewItem := nil;
Exit;
end
end;
end;
ModalResult := mrOk;
end;
// Fill the list of inheritable items in the project
procedure TNewOtherDialog.FillProjectInheritableItemsList;
var
aComponentList: TStringList;
i: integer;
alistItem: TListItem;
AnUnitInfo: TUnitInfo;
Begin
try
// Auxiliar stringlist to sort component list
aComponentList := TStringList.Create;
// Loop trough project units which have a component
for i := 0 to Project1.UnitCount-1 do begin
if (not Project1.Units[i].IsPartOfProject)
or (not FilenameIsPascalUnit(Project1.Units[i].Filename)) then
continue;
if Project1.Units[i].ComponentName<>'' then
aComponentList.AddObject(Project1.Units[i].ComponentName, Project1.Units[i]);
end;
// Sort lists (by component name)
aComponentList.Sort;
// Populate components listview, keeping references to each UnitInfo
for i := 0 to aComponentList.Count-1 do
begin
alistItem := InheritableComponentsListView.Items.Add;
alistItem.Caption := aComponentList[i];
AnUnitInfo:=TUnitInfo(aComponentList.Objects[i]);
alistItem.SubItems.Add(AnUnitInfo.ShortFilename);
aListItem.Data := aComponentList.Objects[i];
end;
finally
aComponentList.Free;
end;
end;
procedure TNewOtherDialog.FillItemsTree;
var
NewParentNode: TTreeNode;
@ -259,14 +354,29 @@ procedure TNewOtherDialog.UpdateDescription;
var
Desc: string;
ANode: TTreeNode;
aNewItemTemplate: TNewIDEItemTemplate;
begin
ANode := ItemsTreeView.Selected;
InheritableComponentsListView.Visible := false;
if (ANode <> nil) and (ANode.Data <> nil) then
begin
if TObject(ANode.Data) is TNewLazIDEItemCategory then
Desc := TNewLazIDEItemCategory(ANode.Data).Description
else
Desc := TNewIDEItemTemplate(ANode.Data).Description;
begin
aNewItemTemplate := TNewIDEItemTemplate(ANode.Data);
Desc := aNewItemTemplate.Description;
if aNewItemTemplate is TNewItemProjectFile then
begin
if TNewItemProjectFile(aNewItemTemplate).Descriptor is TFileDescInheritedComponent
then begin
InheritableComponentsListView.Visible := true;
InheritableComponentsListView.Height:=InheritableComponentsListView.Parent.ClientHeight-50;
if InheritableComponentsListView.Items.Count>0 then
InheritableComponentsListView.Selected := InheritableComponentsListView.Items[0];
end
end;
end;
end
else
Desc := '';
@ -276,11 +386,12 @@ end;
constructor TNewOtherDialog.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Caption := lisMenuNewOther;
SetupComponents;
FillItemsTree;
IDEDialogLayoutList.ApplyLayout(Self, 400, 300);
FillProjectInheritableItemsList;
InheritableComponentsListView.Visible := false;
IDEDialogLayoutList.ApplyLayout(Self, 470, 400);
end;
destructor TNewOtherDialog.Destroy;
@ -555,6 +666,19 @@ begin
Result := lisChooseOneOfTheseItemsToCreateANewPackage;
end;
{ TNewLazIDEItemCategoryInheritedItem }
function TNewLazIDEItemCategoryInheritedItem.LocalizedName: string;
begin
Result := lisInheritedItem;
end;
function TNewLazIDEItemCategoryInheritedItem.Description: string;
begin
Result := lisChooseOneOfTheseItemsToInheritFromAnExistingOne;
end;
initialization
{$I newdialog.lrs}

3
ideintf/lazideintf.pas
View File

@ -181,6 +181,9 @@ type
const CursorPosition: TPoint; TopLine: integer;
PageIndex: integer; Flags: TOpenFlags): TModalResult; virtual; abstract;
function DoRevertEditorFile(const Filename: string): TModalResult; virtual; abstract;
function DoOpenComponent(const UnitFilename: string; OpenFlags: TOpenFlags;
CloseFlags: TCloseFlags;
out Component: TComponent): TModalResult; virtual; abstract;
// project
property ActiveProject: TLazProject read GetActiveProject;

4
ideintf/newitemintf.pas
View File

@ -94,6 +94,7 @@ type
private
fCategory: TNewIDEItemCategory;
FVisibleInNewDialog: boolean;
FIsInherited: boolean;
protected
FAllowedFlags: TNewIDEItemFlags;
FDefaultFlag: TNewIDEItemFlag;
@ -111,6 +112,7 @@ type
property Name: string read FName;
property Category: TNewIDEItemCategory read fCategory write fCategory; // main category
property VisibleInNewDialog: boolean read FVisibleInNewDialog write FVisibleInNewDialog;
property IsInheritedItem: boolean read FIsInherited write FIsInherited;
end;
TNewIDEItemTemplateClass = class of TNewIDEItemTemplate;
@ -161,6 +163,7 @@ begin
FDefaultFlag:=ADefaultFlag;
FAllowedFlags:=TheAllowedFlags;
FVisibleInNewDialog:=true;
FIsInherited := False;
Include(FAllowedFlags,FDefaultFlag);
end;
@ -196,3 +199,4 @@ end;
end.

36
ideintf/projectintf.pas
View File

@ -32,7 +32,10 @@ const
FileDescNameDatamodule = 'Datamodule';
FileDescNameFrame = 'Frame';
FileDescNameText = 'Text';
InheritedItemsGroupName = 'Inherited Items';
FileDescNameLCLInheritedComponent = 'Inherited Component';
ProjDescGroupName = 'Project';
ProjDescNameApplication = 'Application';
ProjDescNameProgram = 'Program';
@ -347,7 +350,7 @@ type
constructor Create; virtual;
function GetLocalizedName: string; virtual;
function GetLocalizedDescription: string; virtual;
function GetResourceSource: string; virtual;
function GetResourceSource(const ResourceName: string): string; virtual;
procedure Release;
procedure Reference;
function CreateSource(const Filename, SourceName,
@ -670,44 +673,54 @@ function CompilationExecutableTypeNameToType(const s: string
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor);
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor);
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor; ACategory : String);
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor; ACategory : String);
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor;
const ACategory : String;
DefaultCreateFlag: TNewIDEItemFlag = niifCopy;
const AllowedCreateFlags: TNewIDEItemFlags = [niifCopy]);
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor;
const ACategory : String;
DefaultCreateFlag: TNewIDEItemFlag = niifCopy;
const AllowedCreateFlags: TNewIDEItemFlags = [niifCopy]);
implementation
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor);
begin
RegisterProjectFileDescriptor(FileDesc,FileDescGroupName);
end;
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor; ACategory : String);
procedure RegisterProjectFileDescriptor(FileDesc: TProjectFileDescriptor;
const ACategory : String;
DefaultCreateFlag: TNewIDEItemFlag; const AllowedCreateFlags: TNewIDEItemFlags);
var
NewItemFile: TNewItemProjectFile;
begin
ProjectFileDescriptors.RegisterFileDescriptor(FileDesc);
if FileDesc.VisibleInNewDialog then begin
NewItemFile:=TNewItemProjectFile.Create(FileDesc.Name,niifCopy,[niifCopy]);
NewItemFile:=TNewItemProjectFile.Create(FileDesc.Name,
DefaultCreateFlag,AllowedCreateFlags);
NewItemFile.Descriptor:=FileDesc;
RegisterNewDialogItem(ACategory,NewItemFile);
end;
end;
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor);
begin
RegisterProjectDescriptor(ProjDesc,ProjDescGroupName);
end;
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor; ACategory : String);
procedure RegisterProjectDescriptor(ProjDesc: TProjectDescriptor;
const ACategory : String;
DefaultCreateFlag: TNewIDEItemFlag; const AllowedCreateFlags: TNewIDEItemFlags);
var
NewItemProject: TNewItemProject;
begin
ProjectDescriptors.RegisterDescriptor(ProjDesc);
if ProjDesc.VisibleInNewDialog then begin
NewItemProject:=TNewItemProject.Create(ProjDesc.Name,niifCopy,[niifCopy]);
NewItemProject:=TNewItemProject.Create(ProjDesc.Name,
DefaultCreateFlag,AllowedCreateFlags);
NewItemProject.Descriptor:=ProjDesc;
RegisterNewDialogItem(ACategory,NewItemProject);
end;
@ -863,7 +876,7 @@ begin
Result:=GetLocalizedName;
end;
function TProjectFileDescriptor.GetResourceSource: string;
function TProjectFileDescriptor.GetResourceSource(const ResourceName: string): string;
// This function can override the automatic creation of the .lfm file source.
begin
Result:=''; // if empty, the IDE will create the source automatically
@ -1227,3 +1240,4 @@ initialization
end.