mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-19 23:49:36 +02:00
IDE: designer: improved error messages
git-svn-id: trunk@15228 -
This commit is contained in:
mattias
parent
a75241f932
commit
0f56af6dc6
@ -43,7 +43,8 @@ uses
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, AvgLvlTree, TypInfo, LCLProc, LResources, Forms, Controls,
|
||||
LCLMemManager, LCLIntf, Dialogs, JITForm, IDEProcs,
|
||||
LCLMemManager, LCLIntf, Dialogs,
|
||||
PropEdits, JITForm, IDEProcs,
|
||||
BasePkgManager;
|
||||
|
||||
type
|
||||
@ -57,7 +58,8 @@ type
|
||||
);
|
||||
TJITFormErrors = set of TJITFormError;
|
||||
|
||||
TJITReaderErrorEvent = procedure(Sender: TObject; ErrorType: TJITFormError;
|
||||
TJITReaderErrorEvent = procedure(Sender: TObject; Reader: TReader;
|
||||
ErrorType: TJITFormError;
|
||||
var Action: TModalResult) of object;
|
||||
TJITPropertyNotFoundEvent = procedure(Sender: TObject; Reader: TReader;
|
||||
Instance: TPersistent; var PropName: string; IsPath: boolean;
|
||||
@ -87,10 +89,11 @@ type
|
||||
FOnPropertyNotFound: TJITPropertyNotFoundEvent;
|
||||
protected
|
||||
FCurReadErrorMsg: string;
|
||||
FCurReadJITComponent:TComponent;
|
||||
FCurReadClass:TClass;
|
||||
FCurReadJITComponent: TComponent;
|
||||
FCurReadClass: TClass;
|
||||
FCurReadChild: TComponent;
|
||||
FCurReadChildClass: TComponentClass;
|
||||
FCurReadStreamClass: TClass;
|
||||
FOnReaderError: TJITReaderErrorEvent;
|
||||
FJITComponents: TList;
|
||||
FFlags: TJITCompListFlags;
|
||||
@ -180,6 +183,7 @@ type
|
||||
property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass;
|
||||
property CurReadJITComponent: TComponent read FCurReadJITComponent;
|
||||
property CurReadClass: TClass read FCurReadClass;
|
||||
property CurReadStreamClass: TClass read FCurReadStreamClass;
|
||||
property CurReadChild: TComponent read FCurReadChild;
|
||||
property CurReadChildClass: TComponentClass read FCurReadChildClass;
|
||||
property CurReadErrorMsg: string read FCurReadErrorMsg;
|
||||
@ -620,8 +624,8 @@ end;
|
||||
destructor TJITComponentList.Destroy;
|
||||
begin
|
||||
while FJITComponents.Count>0 do DestroyJITComponent(FJITComponents.Count-1);
|
||||
FJITComponents.Free;
|
||||
FErrors.Free;
|
||||
FreeAndNil(FJITComponents);
|
||||
FreeAndNil(FErrors);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -743,7 +747,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
|
||||
// returns new index
|
||||
// -1 = invalid stream
|
||||
|
||||
procedure ReadStream(AStream: TStream);
|
||||
procedure ReadStream(AStream: TStream; StreamClass: TClass);
|
||||
var
|
||||
Reader:TReader;
|
||||
DestroyDriver: Boolean;
|
||||
@ -752,6 +756,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
|
||||
debugln('[TJITComponentList.AddJITComponentFromStream] InitReading ...');
|
||||
{$ENDIF}
|
||||
|
||||
FCurReadStreamClass:=StreamClass;
|
||||
DestroyDriver:=false;
|
||||
InitReading(AStream,Reader,DestroyDriver);
|
||||
{$IFDEF VerboseJITForms}
|
||||
@ -796,7 +801,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
|
||||
DebugLn(['TJITComponentList.AddJITComponentFromStream.ReadAncestor ',DbgSName(AClass),' HasStream=',AncestorStream<>nil]);
|
||||
{$ENDIF}
|
||||
if AncestorStream<>nil then
|
||||
ReadStream(AncestorStream);
|
||||
ReadStream(AncestorStream,AClass);
|
||||
finally
|
||||
FreeAndNil(AncestorStream);
|
||||
end;
|
||||
@ -828,7 +833,7 @@ begin
|
||||
Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass,Visible);
|
||||
if Result<0 then exit;
|
||||
ReadAncestorStreams;
|
||||
ReadStream(BinStream);
|
||||
ReadStream(BinStream,FCurReadJITComponent.ClassType);
|
||||
|
||||
if FCurReadJITComponent.Name='' then begin
|
||||
NewName:=FCurReadJITComponent.ClassName;
|
||||
@ -870,6 +875,7 @@ procedure TJITComponentList.InitReading(BinStream: TStream;
|
||||
var Reader: TReader; DestroyDriver: Boolean);
|
||||
begin
|
||||
FFlags:=FFlags-[jclAutoRenameComponents];
|
||||
FErrors.Clear;
|
||||
|
||||
MyFindGlobalComponentProc:=@OnFindGlobalComponent;
|
||||
RegisterFindGlobalComponentProc(@MyFindGlobalComponent);
|
||||
@ -916,6 +922,7 @@ begin
|
||||
Result:=-1;
|
||||
Instance:=nil;
|
||||
FCurReadClass:=nil;
|
||||
FCurReadStreamClass:=nil;
|
||||
FCurReadJITComponent:=nil;
|
||||
|
||||
try
|
||||
@ -954,6 +961,7 @@ begin
|
||||
try
|
||||
if FCurReadClass<>nil then
|
||||
FreeJITClass(FCurReadClass);
|
||||
FCurReadStreamClass:=nil;
|
||||
Instance.Free;
|
||||
except
|
||||
on E: Exception do begin
|
||||
@ -1078,6 +1086,7 @@ begin
|
||||
try
|
||||
FCurReadJITComponent:=JITOwnerComponent;
|
||||
FCurReadClass:=JITOwnerComponent.ClassType;
|
||||
FCurReadStreamClass:=FCurReadClass;
|
||||
|
||||
FFlags:=FFlags+[jclAutoRenameComponents];
|
||||
{$IFDEF VerboseJITForms}
|
||||
@ -1556,7 +1565,7 @@ begin
|
||||
FErrors.Add(-1,ErrorBinPos,nil);
|
||||
end;
|
||||
if Assigned(OnReaderError) then
|
||||
OnReaderError(Self,ErrorType,Action);
|
||||
OnReaderError(Self,Reader,ErrorType,Action);
|
||||
Handled:=Action in [mrIgnore];
|
||||
FCurUnknownProperty:='';
|
||||
|
||||
@ -1586,7 +1595,7 @@ end;
|
||||
|
||||
procedure TJITComponentList.ReaderCreateComponent(Reader: TReader;
|
||||
ComponentClass: TComponentClass; var Component: TComponent);
|
||||
{$IFDEF EnableTFrame2}
|
||||
{$IFDEF EnableTFrame}
|
||||
var
|
||||
DestroyDriver: Boolean;
|
||||
SubReader: TReader;
|
||||
@ -1598,7 +1607,7 @@ begin
|
||||
fCurReadChild:=Component;
|
||||
fCurReadChildClass:=ComponentClass;
|
||||
|
||||
{$IFDEF EnableTFrame2}
|
||||
{$IFDEF EnableTFrame}
|
||||
if Assigned(OnFindAncestorBinStream) then begin
|
||||
BinStream:=nil;
|
||||
DestroyDriver:=false;
|
||||
|
||||
@ -133,8 +133,8 @@ each control that's dropped onto the form
|
||||
procedure SetSelection(const ASelection: TPersistentSelectionList);
|
||||
procedure OnObjectInspectorModified(Sender: TObject);
|
||||
procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
|
||||
procedure JITListReaderError(Sender: TObject; ErrorType: TJITFormError;
|
||||
var Action: TModalResult); virtual;
|
||||
procedure JITListReaderError(Sender: TObject; Reader: TReader;
|
||||
ErrorType: TJITFormError; var Action: TModalResult); virtual;
|
||||
procedure JITListPropertyNotFound(Sender: TObject; Reader: TReader;
|
||||
Instance: TPersistent; var PropName: string; IsPath: boolean;
|
||||
var Handled, Skip: Boolean);
|
||||
@ -2005,27 +2005,48 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomFormEditor.JITListReaderError(Sender: TObject;
|
||||
ErrorType: TJITFormError; var Action: TModalResult);
|
||||
Reader: TReader; ErrorType: TJITFormError; var Action: TModalResult);
|
||||
var
|
||||
aCaption, aMsg: string;
|
||||
DlgType: TMsgDlgType;
|
||||
Buttons: TMsgDlgButtons;
|
||||
HelpCtx: Longint;
|
||||
JITComponentList: TJITComponentList;
|
||||
StreamClass: TComponentClass;
|
||||
AnUnitInfo: TUnitInfo;
|
||||
LFMFilename: String;
|
||||
ErrorBinPos: Int64;
|
||||
begin
|
||||
JITComponentList:=TJITComponentList(Sender);
|
||||
aCaption:='Error reading '+JITComponentList.ClassName;
|
||||
aCaption:='Read error';
|
||||
aMsg:='';
|
||||
DlgType:=mtError;
|
||||
Buttons:=[mbCancel];
|
||||
HelpCtx:=0;
|
||||
|
||||
// get current lfm filename
|
||||
LFMFilename:='';
|
||||
if (JITComponentList.CurReadStreamClass<>nil)
|
||||
and (JITComponentList.CurReadStreamClass.InheritsFrom(TComponent)) then begin
|
||||
StreamClass:=TComponentClass(JITComponentList.CurReadStreamClass);
|
||||
AnUnitInfo:=Project1.UnitWithComponentClass(StreamClass);
|
||||
if AnUnitInfo<>nil then begin
|
||||
LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
|
||||
end;
|
||||
end;
|
||||
if LFMFilename<>'' then
|
||||
aCaption:='Error reading '+ExtractFilename(LFMFilename);
|
||||
|
||||
with JITComponentList do begin
|
||||
aMsg:=aMsg+ClassName+': ';
|
||||
if CurReadJITComponent<>nil then
|
||||
aMsg:=aMsg+CurReadJITComponent.Name+':'+CurReadJITComponent.ClassName
|
||||
if LFMFilename<>'' then
|
||||
aMsg:=aMsg+LFMFilename
|
||||
else if CurReadStreamClass<>nil then
|
||||
aMsg:=aMsg+'Stream='+CurReadStreamClass.ClassName
|
||||
else
|
||||
aMsg:=aMsg+'?';
|
||||
aMsg:=aMsg+'JITList='+ClassName;
|
||||
aMsg:=aMsg+': ';
|
||||
if CurReadJITComponent<>nil then
|
||||
aMsg:=aMsg+'Root='+CurReadJITComponent.Name+':'+CurReadJITComponent.ClassName;
|
||||
if CurReadChild<>nil then
|
||||
aMsg:=aMsg+#13'Component: '
|
||||
+CurReadChild.Name+':'+CurReadChild.ClassName
|
||||
@ -2033,6 +2054,10 @@ begin
|
||||
aMsg:=aMsg+#13'Component Class: '+CurReadChildClass.ClassName;
|
||||
aMsg:=aMsg+#13+CurReadErrorMsg;
|
||||
end;
|
||||
if (Reader<>nil) and (Reader.Driver is TLRSObjectReader) then begin
|
||||
ErrorBinPos:=TLRSObjectReader(Reader.Driver).Stream.Position;
|
||||
aMsg:=aMsg+#13+'Stream position: '+dbgs(ErrorBinPos);
|
||||
end;
|
||||
|
||||
case ErrorType of
|
||||
jfeUnknownProperty, jfeReaderError:
|
||||
|
||||
@ -713,6 +713,7 @@ type
|
||||
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
|
||||
function UnitWithEditorIndex(Index:integer): TUnitInfo;
|
||||
function UnitWithComponent(AComponent: TComponent): TUnitInfo;
|
||||
function UnitWithComponentClass(AClass: TComponentClass): TUnitInfo;
|
||||
function UnitWithComponentName(AComponentName: String): TUnitInfo;
|
||||
function UnitComponentInheritingFrom(AClass: TComponentClass;
|
||||
Ignore: TUnitInfo): TUnitInfo;
|
||||
@ -4150,6 +4151,13 @@ begin
|
||||
Result:=Result.fNext[uilWithComponent];
|
||||
end;
|
||||
|
||||
function TProject.UnitWithComponentClass(AClass: TComponentClass): TUnitInfo;
|
||||
begin
|
||||
Result:=fFirst[uilWithComponent];
|
||||
while (Result<>nil) and (Result.Component.ClassType<>AClass) do
|
||||
Result:=Result.fNext[uilWithComponent];
|
||||
end;
|
||||
|
||||
function TProject.UnitWithComponentName(AComponentName: String): TUnitInfo;
|
||||
begin
|
||||
Result := fFirst[uilPartOfProject];
|
||||
|
||||
@ -238,6 +238,7 @@ type
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Sort(LFMPositions: Boolean);
|
||||
function IndexOf(const Position: int64; LFMPositions: Boolean): integer;
|
||||
function IndexOfRange(const FromPos, ToPos: int64;
|
||||
@ -4309,6 +4310,11 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TLRPositionLinks.Clear;
|
||||
begin
|
||||
Count:=0;
|
||||
end;
|
||||
|
||||
procedure TLRPositionLinks.Sort(LFMPositions: Boolean);
|
||||
begin
|
||||
if LFMPositions then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user