paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 20:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: designer: started creating nested frames

Browse Source 
git-svn-id: trunk@15200 -
This commit is contained in:
mattias 2008-05-21 15:00:34 +00:00
parent 64ca931ca0
commit d0c1ddd0d2
6 changed files with 145 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
designer/jitforms.pp
View File

@ -27,11 +27,6 @@
and such stuff. Also these forms can be loaded from streams and missing
components and methods are added just-in-time to the class definition.
Hence the name for the class: TJITForms.
Subcomponents are looked up in the list of registered components
(TJITForms.RegCompList).
ToDo:
-Add recursion needed for frames.
}
unit JITForms;
@ -48,7 +43,7 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, AvgLvlTree, TypInfo, LCLProc, LResources, Forms, Controls,
LCLMemManager, LCLIntf, Dialogs, JITForm, ComponentReg, IDEProcs,
LCLMemManager, LCLIntf, Dialogs, JITForm, IDEProcs,
BasePkgManager;
type
@ -70,6 +65,9 @@ type
TJITFindAncestorBinStream = procedure(Sender: TObject; AClass: TClass;
var BinStream: TExtMemoryStream;
var IsBaseClass, Abort: boolean) of object;
TJITFindClass = procedure(Sender: TObject;
const ComponentClassName: string;
var ComponentClass: TComponentClass) of object;
{ TJITComponentList }
@ -85,6 +83,7 @@ type
FCurUnknownProperty: string;
FErrors: TLRPositionLinks;
FOnFindAncestorBinStream: TJITFindAncestorBinStream;
FOnFindClass: TJITFindClass;
FOnPropertyNotFound: TJITPropertyNotFoundEvent;
protected
FCurReadErrorMsg: string;
@ -175,6 +174,7 @@ type
read FOnPropertyNotFound write FOnPropertyNotFound;
property OnFindAncestorBinStream: TJITFindAncestorBinStream
read FOnFindAncestorBinStream write FOnFindAncestorBinStream;
property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass;
property CurReadJITComponent: TComponent read FCurReadJITComponent;
property CurReadClass: TClass read FCurReadClass;
property CurReadChild: TComponent read FCurReadChild;
@ -1558,19 +1558,15 @@ end;
procedure TJITComponentList.ReaderFindComponentClass(Reader: TReader;
const FindClassName: Ansistring; var ComponentClass: TComponentClass);
var
RegComp: TRegisteredComponent;
begin
fCurReadChild:=nil;
fCurReadChildClass:=ComponentClass;
FCurUnknownClass:=FindClassName;
if ComponentClass=nil then begin
RegComp:=IDEComponentPalette.FindComponent(FindClassName);
if RegComp<>nil then begin
//debugln('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
// +''' is registered');
ComponentClass:=RegComp.ComponentClass;
end else begin
if Assigned(OnFindClass) then
OnFindClass(Self,FindClassName,ComponentClass);
fCurReadChildClass:=ComponentClass;
if ComponentClass=nil then begin
DebugLn('[TJITComponentList.ReaderFindComponentClass] '''+FindClassName
+''' is unregistered');
// The reader will create a ReaderError automatically

42
ide/checklfmdlg.pas
View File

@ -40,7 +40,8 @@ uses
LFMTrees,
// IDE
PropEdits, IDEDialogs, ComponentReg, PackageIntf, IDEWindowIntf,
LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs, EditorOptions;
CustomFormEditor, LazarusIDEStrConsts, OutputFilter, IDEProcs, IDEOptionDefs,
EditorOptions;
type
TCheckLFMDialog = class(TForm)
@ -133,23 +134,46 @@ var
end;
end;
procedure FindMissingClass(ObjNode: TLFMObjectNode);
var
i: Integer;
AClassName: String;
RegComp: TRegisteredComponent;
begin
AClassName:=ObjNode.TypeName;
// search in already missing classes
if (MissingClasses<>nil) then begin
for i:=0 to MissingClasses.Count-1 do
if SysUtils.CompareText(AClassName,MissingClasses[i])=0 then
exit;
end;
// search in designer base classes
if BaseFormEditor1.FindDesignerBaseClassByName(AClassName,true)<>nil then
exit;
// search in registered classes
RegComp:=IDEComponentPalette.FindComponent(ObjNode.TypeName);
if (RegComp<>nil) and (RegComp.GetUnitName<>'') then exit;
// class is missing
DebugLn(['FindMissingClass ',ObjNode.Name,':',ObjNode.TypeName,' IsInherited=',ObjNode.IsInherited]);
if MissingClasses=nil then
MissingClasses:=TStringList.Create;
MissingClasses.Add(AClassName);
end;
procedure FindMissingClasses;
var
Node: TLFMTreeNode;
ObjNode: TLFMObjectNode;
RegComp: TRegisteredComponent;
begin
Node:=LFMTree.Root;
if Node=nil then exit;
// skip root
Node:=Node.Next;
// check all other
while Node<>nil do begin
if Node is TLFMObjectNode then begin
ObjNode:=TLFMObjectNode(Node);
RegComp:=IDEComponentPalette.FindComponent(ObjNode.TypeName);
if (RegComp=nil) or (RegComp.GetUnitName='') then begin
DebugLn(['FindMissingClasses ',ObjNode.Name,':',ObjNode.TypeName,' IsInherited=',ObjNode.IsInherited]);
if MissingClasses=nil then
MissingClasses:=TStringList.Create;
MissingClasses.Add(ObjNode.TypeName);
end;
FindMissingClass(ObjNode);
end;
Node:=Node.Next;
end;

69
ide/customformeditor.pp
View File

@ -141,6 +141,9 @@ each control that's dropped onto the form
procedure JITListFindAncestorBinStream(Sender: TObject; AClass: TClass;
var BinStream: TExtMemoryStream;
var IsBaseClass, Abort: boolean);
procedure JITListFindClass(Sender: TObject;
const ComponentClassName: string;
var ComponentClass: TComponentClass);
function GetDesignerBaseClasses(Index: integer): TComponentClass; override;
procedure OnDesignerMenuItemClick(Sender: TObject); virtual;
@ -251,7 +254,7 @@ each control that's dropped onto the form
function DesignerBaseClassCount: Integer; override;
procedure UnregisterDesignerBaseClass(AClass: TComponentClass); override;
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; override;
function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; override;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; override;
// define properties
procedure FindDefineProperty(const APersistentClassName,
@ -335,6 +338,8 @@ function TryFreeComponent(var AComponent: TComponent): boolean;
procedure RegisterStandardClasses;
var
BaseFormEditor1: TCustomFormEditor = nil;
implementation
@ -817,6 +822,15 @@ end;
{ TCustomFormEditor }
constructor TCustomFormEditor.Create;
procedure InitJITList(List: TJITComponentList);
begin
List.OnReaderError:=@JITListReaderError;
List.OnPropertyNotFound:=@JITListPropertyNotFound;
List.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
List.OnFindClass:=@JITListFindClass;
end;
var
l: Integer;
begin
@ -829,14 +843,10 @@ begin
FDesignerBaseClasses.Add(StandardDesignerBaseClasses[l]);
JITFormList := TJITForms.Create;
JITFormList.OnReaderError:=@JITListReaderError;
JITFormList.OnPropertyNotFound:=@JITListPropertyNotFound;
JITFormList.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
InitJITList(JITFormList);
JITNonFormList := TJITNonFormComponents.Create;
JITNonFormList.OnReaderError:=@JITListReaderError;
JITNonFormList.OnPropertyNotFound:=@JITListPropertyNotFound;
JITNonFormList.OnFindAncestorBinStream:=@JITListFindAncestorBinStream;
InitJITList(JITNonFormList);
DesignerMenuItemClick:=@OnDesignerMenuItemClick;
OnGetDesignerForm:=@GetDesignerForm;
@ -1781,10 +1791,20 @@ begin
end;
function TCustomFormEditor.FindDesignerBaseClassByName(
const AClassName: shortstring): TComponentClass;
const AClassName: shortstring; WithDefaults: boolean): TComponentClass;
var
i: Integer;
begin
if WithDefaults then begin
for i:=Low(StandardDesignerBaseClasses) to high(StandardDesignerBaseClasses)
do begin
if CompareText(AClassName,StandardDesignerBaseClasses[i].ClassName)=0 then
begin
Result:=StandardDesignerBaseClasses[i];
exit;
end;
end;
end;
for i:=FDesignerBaseClasses.Count-1 downto 0 do begin
Result:=DesignerBaseClasses[i];
if CompareText(Result.ClassName,AClassName)=0 then exit;
@ -1861,12 +1881,12 @@ var
if APersistent<>nil then
debugln('TCustomFormEditor.GetDefineProperties ComponentClass ',
AClassName,' is a resource,'
+' but inheriting design is not yet implemented');
+' but inheriting design properties is not yet implemented');
end;
// try default classes
if (APersistent=nil) then begin
AncestorClass:=FindDesignerBaseClassByName(AClassName);
AncestorClass:=FindDesignerBaseClassByName(AClassName,true);
if AncestorClass<>nil then begin
if not CreateTempPersistent(AncestorClass) then exit;
end;
@ -2106,6 +2126,35 @@ begin
end;
end;
procedure TCustomFormEditor.JITListFindClass(Sender: TObject;
const ComponentClassName: string; var ComponentClass: TComponentClass);
var
AnUnitInfo: TUnitInfo;
Component: TComponent;
RegComp: TRegisteredComponent;
begin
DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
RegComp:=IDEComponentPalette.FindComponent(ComponentClassName);
if RegComp<>nil then begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
ComponentClass:=RegComp.ComponentClass;
end else begin
// ToDo: search only in reachable forms
AnUnitInfo:=Project1.FirstUnitWithComponent;
while AnUnitInfo<>nil do begin
Component:=AnUnitInfo.Component;
if SysUtils.CompareText(Component.ClassName,ComponentClassName)=0 then
begin
DebugLn(['TCustomFormEditor.JITListFindClass found nested class '+DbgSName(Component)+' in unit '+AnUnitInfo.Filename]);
ComponentClass:=TComponentClass(Component.ClassType);
break;
end;
AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
end;
end;
DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' Class=',DbgSName(ComponentClass)]);
end;
function TCustomFormEditor.GetDesignerBaseClasses(Index: integer
): TComponentClass;
begin

2
ide/formeditor.pp
View File

@ -59,6 +59,7 @@ procedure CreateFormEditor;
begin
if FormEditor1=nil then begin
FormEditor1 := TFormEditor.Create;
BaseFormEditor1 := FormEditor1;
FormEditingHook := FormEditor1;
IDECmdScopeDesignerOnly.AddWindowClass(TDesignerIDECommandForm);
end;
@ -70,6 +71,7 @@ begin
FormEditingHook:=nil;
FormEditor1.Free;
FormEditor1:=nil;
BaseFormEditor1 := nil;
end;
procedure TFormEditor.SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg);

54
ide/main.pp
View File

@ -5368,6 +5368,10 @@ var
LCLVersion: string;
MissingClasses: TStrings;
LFMComponentName: string;
i: Integer;
NestedClassName: string;
NestedClass: TComponentClass;
NestedUnitInfo: TUnitInfo;
begin
debugln('TMainIDE.DoLoadLFM A ',AnUnitInfo.Filename,' IsPartOfProject=',dbgs(AnUnitInfo.IsPartOfProject),' ');
@ -5424,11 +5428,38 @@ begin
exit;
end;
// load missing component classes (e.g. ancestor and frames)
Result:=DoLoadAncestorDependencyHidden(AnUnitInfo,NewClassName,OpenFlags,
AncestorType,AncestorUnitInfo);
if Result<>mrOk then begin
DebugLn(['TMainIDE.DoLoadLFM DoLoadAncestorDependencyHidden failed for ',AnUnitInfo.Filename]);
exit;
end;
if MissingClasses<>nil then begin
for i:=MissingClasses.Count-1 downto 0 do begin
{$IFNDEF EnableTFrame}
if i>=0 then continue;// just skip
{$ENDIF}
NestedClassName:=MissingClasses[i];
if SysUtils.CompareText(NestedClassName,AncestorType.ClassName)=0 then
begin
MissingClasses.Delete(i);
end else begin
DebugLn(['TMainIDE.DoLoadLFM loading nested class ',NestedClassName,' needed by ',AnUnitInfo.Filename]);
NestedClass:=nil;
NestedUnitInfo:=nil;
Result:=DoLoadComponentDependencyHidden(AnUnitInfo,NestedClassName,
OpenFlags,true,NestedClass,NestedUnitInfo);
if Result<>mrOk then begin
DebugLn(['TMainIDE.DoLoadLFM DoLoadComponentDependencyHidden NestedClassName=',NestedClassName,' failed for ',AnUnitInfo.Filename]);
exit;
end;
end;
end;
end;
BinStream:=nil;
try
Result:=DoLoadAncestorDependencyHidden(AnUnitInfo,NewClassName,OpenFlags,
AncestorType,AncestorUnitInfo);
// convert text to binary format
BinStream:=TExtMemoryStream.Create;
TxtLFMStream:=TExtMemoryStream.Create;
@ -5555,13 +5586,7 @@ function TMainIDE.FindBaseComponentClass(const AComponentClassName,
begin
// find the ancestor class
if AComponentClassName<>'' then begin
if CompareText(AComponentClassName,'TForm')=0 then begin
AComponentClass:=TForm;
end else if CompareText(AComponentClassName,'TDataModule')=0 then begin
AComponentClass:=TDataModule;
end else if CompareText(AComponentClassName,'TFrame')=0 then begin
AComponentClass:=TFrame;
end else if (DescendantClassName<>'')
if (DescendantClassName<>'')
and (CompareText(AComponentClassName,'TCustomForm')=0) then begin
// this is a common user mistake
MessageDlg(lisCodeTemplError, Format(
@ -5581,7 +5606,7 @@ begin
exit;
end else begin
// search in the registered base classes
AComponentClass:=FormEditor1.FindDesignerBaseClassByName(AComponentClassName);
AComponentClass:=FormEditor1.FindDesignerBaseClassByName(AComponentClassName,true);
end;
end else begin
// default is TForm
@ -5784,7 +5809,7 @@ begin
AncestorClass) then
begin
DebugLn(['TMainIDE.DoLoadAncestorDependencyHidden FindUnitComponentClass failed for AncestorClassName=',AncestorClassName]);
exit;
exit(mrCancel);
end;
// try loading the ancestor first (unit, lfm and component instance)
@ -5814,6 +5839,7 @@ begin
if AncestorClass=nil then
AncestorClass:=TForm;
//DebugLn('TMainIDE.DoLoadAncestorDependencyHidden Filename="',AnUnitInfo.Filename,'" AncestorClassName=',AncestorClassName,' AncestorClass=',dbgsName(AncestorClass));
Result:=mrOk;
end;
function TMainIDE.DoLoadComponentDependencyHidden(AnUnitInfo: TUnitInfo;
@ -5949,7 +5975,7 @@ var
end;
end;
debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' Loading ancestor unit ',UnitFilename);
debugln('TMainIDE.DoLoadComponentDependencyHidden ',AnUnitInfo.Filename,' Loading referenced form ',UnitFilename);
// load unit source
TheModalResult:=LoadCodeBuffer(UnitCode,UnitFilename,[lbfCheckIfText]);
if TheModalResult<>mrOk then begin
@ -5987,7 +6013,7 @@ var
begin
Result:=false;
AComponentClass:=
FormEditor1.FindDesignerBaseClassByName(AComponentClassName);
FormEditor1.FindDesignerBaseClassByName(AComponentClassName,true);
if AComponentClass<>nil then begin
DebugLn(['TMainIDE.DoLoadComponentDependencyHidden.TryRegisteredClasses found: ',AComponentClass.ClassName]);
TheModalResult:=mrOk;

2
ideintf/formeditingintf.pas
View File

@ -126,7 +126,7 @@ type
property DesignerBaseClasses[Index: integer]: TComponentClass read GetDesignerBaseClasses;
procedure UnregisterDesignerBaseClass(AClass: TComponentClass); virtual; abstract;
function IndexOfDesignerBaseClass(AClass: TComponentClass): integer; virtual; abstract;
function FindDesignerBaseClassByName(const AClassName: shortstring): TComponentClass; virtual; abstract;
function FindDesignerBaseClassByName(const AClassName: shortstring; WithDefaults: boolean): TComponentClass; virtual; abstract;
// designers
function DesignerCount: integer; virtual; abstract;