MG: added jitform error messagedlg

git-svn-id: trunk@3291 -

designer/jitforms.pp

@@ -49,12 +49,29 @@ uses
 
 type
   //----------------------------------------------------------------------------
+  TJITFormError = (
+      jfeNone,
+      jfeUnknown,
+      jfeUnknownProperty,
+      jfeUnknownComponentClass,
+      jfeReaderError
+    );
+  TJITFormErrors = set of TJITFormError;
+  
+  TJITReaderErrorEvent = procedure(Sender: TObject; ErrorType: TJITFormError;
+    var Action: TModalResult) of object;
+  
+  
   // Just-In-Time-Form List
   TJITForms = class(TPersistent)
   private
-    FForms: TList; // list of TJITForm
+    FCurReadErrorMsg: string;
     FCurReadForm:TForm;
     FCurReadClass:TClass;
+    FCurReadComponent: TComponent;
+    FCurReadComponentClass: TComponentClass;
+    FForms: TList; // list of TJITForm
+    FOnReaderError: TJITReaderErrorEvent;
     FRegCompList:TRegisteredComponentList;
     // jit procedures
     function CreateVMTCopy(SourceClass:TClass; const NewClassName:ShortString):Pointer;
@@ -84,7 +101,10 @@ type
     function GetClassNameFromStream(s:TStream):shortstring;
     function DoCreateJITForm(NewFormName,NewClassName:shortstring):integer;
     function OnFindGlobalComponent(const AName:AnsiString):TComponent;
+    procedure InitReading;
   public
+    constructor Create;
+    destructor Destroy; override;
     property Items[Index:integer]:TForm read GetItem; default;
     function Count:integer;
     property RegCompList:TRegisteredComponentList read FRegCompList write FRegCompList;
@@ -101,8 +121,13 @@ type
     procedure RemoveMethod(JITForm:TForm; AName:ShortString);
     procedure RenameMethod(JITForm:TForm; OldName,NewName:ShortString);
     procedure RenameFormClass(JITForm:TForm; NewName:ShortString);
-    constructor Create;
+    property OnReaderError: TJITReaderErrorEvent
-    destructor Destroy; override;
+      read FOnReaderError write FOnReaderError;
+    property CurReadForm:TForm read FCurReadForm;
+    property CurReadClass:TClass read FCurReadClass;
+    property CurReadComponent: TComponent read FCurReadComponent;
+    property CurReadComponentClass: TComponentClass read FCurReadComponentClass;
+    property CurReadErrorMsg: string read FCurReadErrorMsg;
   published
     // the dummy template 'procedure of object' for all events
     procedure DoNothing;
@@ -324,6 +349,7 @@ begin
       {$IFDEF IDE_VERBOSE}
       writeln('[TJITForms.AddJITFormFromStream] 4');
       {$ENDIF}
+      InitReading;
       Reader.ReadRootComponent(FCurReadForm);
       if FCurReadForm.Name='' then begin
         NewName:=FCurReadForm.ClassName;
@@ -362,6 +388,13 @@ begin
   Result:=Application.FindComponent(AName);
 end;
 
+procedure TJITForms.InitReading;
+begin
+  FCurReadComponentClass:=nil;
+  FCurReadComponent:=nil;
+  FCurReadErrorMsg:='';
+end;
+
 procedure TJITForms.AddNewMethod(JITForm:TForm; AName:ShortString);
 begin
   CreateNewmethod(JITForm,AName);
@@ -656,16 +689,21 @@ procedure TJITForms.ReaderError(Reader: TReader; const ErrorMsg: Ansistring;
 // ToDo: use SUnknownProperty when it is published by the fpc team
 const
   SUnknownProperty = 'Unknown property';
+var
+  ErrorType: TJITFormError;
+  Action: TModalResult;
 begin
-  // ToDo: let user decide if an error is evil
+  ErrorType:=jfeReaderError;
+  Action:=mrCancel;
+  FCurReadErrorMsg:=ErrorMsg;
+  // find out, what error occured
   if RightStr(ErrorMsg,length(SUnknownProperty))=SUnknownProperty then begin
-    { this property is not defined
+    ErrorType:=jfeUnknownProperty;
-      This means:
+    Action:=mrIgnore;
-        A) The property is not yet implemented -> ignore (skip)
-        B) The property was renamed or removed -> skip
-    }
-    Handled:=true;
   end;
+  if Assigned(OnReaderError) then
+    OnReaderError(Self,ErrorType,Action);
+  Handled:=Action in [mrIgnore];
   writeln('>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
   writeln('[TJITForms.ReaderError] "'+ErrorMsg+'" ignoring=',Handled);
   writeln('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<');
@@ -675,7 +713,11 @@ procedure TJITForms.ReaderFindComponentClass(Reader: TReader;
   const FindClassName: Ansistring;  var ComponentClass: TComponentClass);
 var
   RegComp:TRegisteredComponent;
+  Action: TModalResult;
+  ErrorType: TJITFormError;
 begin
+  fCurReadComponent:=nil;
+  fCurReadComponentClass:=ComponentClass;
   if ComponentClass=nil then begin
     RegComp:=FRegCompList.FindComponentClassByName(FindClassName);
     if RegComp<>nil then begin
@@ -685,6 +727,10 @@ begin
     end else begin
       writeln('[TJITForms.ReaderFindComponentClass] '''+FindClassName
          +''' is unregistered');
+      Action:=mrCancel;
+      ErrorType:=jfeUnknownComponentClass;
+      if Assigned(OnReaderError) then
+        OnReaderError(Self,ErrorType,Action);
     end;
   end;
 end;
@@ -692,6 +738,8 @@ end;
 procedure TJITForms.ReaderCreateComponent(Reader: TReader;
   ComponentClass: TComponentClass; var Component: TComponent);
 begin
+  fCurReadComponent:=Component;
+  fCurReadComponentClass:=ComponentClass;
 //  writeln('[TJITForms.ReaderCreateComponent] Class='''+ComponentClass.ClassName+'''');
 end;
 
@@ -699,3 +747,4 @@ end;
 
 
 end.
+

ide/customformeditor.pp

@@ -38,8 +38,8 @@ uses
 {$IFDEF IDE_MEM_CHECK}
   MemCheck,
 {$ENDIF}
-  Classes, AbstractFormeditor, Controls, PropEdits, TypInfo, ObjectInspector ,
+  Classes, AbstractFormeditor, Controls, PropEdits, TypInfo, ObjectInspector,
-  Forms, IDEComp, JITForms, Compreg, ComponentEditors;
+  Forms, IDEComp, JITForms, Compreg, ComponentEditors, Dialogs;
 
 Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
 
@@ -122,6 +122,8 @@ TCustomFormEditor
     procedure SetSelectedComponents(TheSelectedComponents : TComponentSelectionList);
     procedure OnObjectInspectorModified(Sender: TObject);
     procedure SetObj_Inspector(AnObjectInspector: TObjectInspector); virtual;
+    procedure JITFormListReaderError(Sender: TObject; ErrorType: TJITFormError;
+          var Action: TModalResult); virtual;
   public
     JITFormList : TJITForms;
     constructor Create;
@@ -586,6 +588,7 @@ begin
   FSelectedComponents := TComponentSelectionList.Create;
   JITFormList := TJITForms.Create;
   JITFormList.RegCompList := RegCompList;
+  JITFormList.OnReaderError:=@JITFormListReaderError;
 end;
 
 destructor TCustomFormEditor.Destroy;
@@ -799,6 +802,43 @@ begin
   end;
 end;
 
+procedure TCustomFormEditor.JITFormListReaderError(Sender: TObject;
+  ErrorType: TJITFormError; var Action: TModalResult);
+var
+  aCaption, aMsg: string;
+  DlgType: TMsgDlgType;
+  Buttons: TMsgDlgButtons;
+  HelpCtx: Longint;
+begin
+  aCaption:='Error reading form';
+  aMsg:='';
+  DlgType:=mtError;
+  Buttons:=[mbCancel];
+  HelpCtx:=0;
+  
+  with JITFormList do begin
+    aMsg:=aMsg+'Form: ';
+    if CurReadForm<>nil then
+      aMsg:=aMsg+CurReadForm.Name+':'+CurReadForm.ClassName
+    else
+      aMsg:=aMsg+'?';
+    if CurReadComponent<>nil then
+      aMsg:=aMsg+#13'Component: '
+        +CurReadComponent.Name+':'+CurReadComponent.ClassName
+    else if CurReadComponentClass<>nil then
+      aMsg:=aMsg+#13'Component Class: '+CurReadComponentClass.ClassName;
+  end;
+  aMsg:=aMsg+#13+JITFormList.CurReadErrorMsg;
+  
+  case ErrorType of
+    jfeUnknownProperty:
+      begin
+        Buttons:=[mbIgnore,mbCancel];
+      end;
+  end;
+  Action:=MessageDlg(aCaption,aMsg,DlgType,Buttons,HelpCtx);
+end;
+
 function TCustomFormEditor.GetPropertyEditorHook: TPropertyEditorHook;
 begin
   Result:=Obj_Inspector.PropertyEditorHook;