added RTTI check for unitname of design components

git-svn-id: trunk@6844 -

ide/lazarusidestrconsts.pas

@@ -1676,6 +1676,8 @@ resourcestring
   lisCodeToolsDefsprojectSpecific = '%s, project specific';
   lisCodeToolsDefsnoneSelected = 'none selected';
   lisCodeToolsDefsInvalidParent = 'Invalid parent';
+  lisACanNotHoldTControlsYouCanOnlyPutNonVisualComponen = 'A %s can not hold '
+    +'TControls.%sYou can only put non visual components on it.';
   lisCodeToolsDefsAutoCreatedNodesReadOnly = 'Auto created nodes can not be '
     +'edited,%snor can they have non auto created child nodes.';
   lisCodeToolsDefsInvalidParentNode = 'Invalid parent node';

ide/main.pp

@@ -10995,9 +10995,9 @@ begin
   Result:=false;
   if (not (AParent is TControl))
   and (APersistentClass.InheritsFrom(TControl)) then begin
-    MessageDlg('Invalid parent',
+    MessageDlg(lisCodeToolsDefsInvalidParent,
-      'A '+AParent.ClassName+' can not hold TControls.'#13
+      Format(lisACanNotHoldTControlsYouCanOnlyPutNonVisualComponen, [
-      +'You can only put non visual components on it.',
+        AParent.ClassName, #13]),
       mtError,[mbCancel],0);
     UpdateIDEComponentPalette;
     exit;
@@ -11402,6 +11402,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.847  2005/02/25 20:19:46  mattias
+  added RTTI check for unitname of design components
+
   Revision 1.846  2005/02/18 18:08:20  mattias
   project dependencies are now added/removed/renamed in the project main uses section
 

ideintf/propedits.pp

@@ -1384,6 +1384,7 @@ var
   GlobalDesignHook: TPropertyEditorHook;
 
 function ClassTypeInfo(Value: TClass): PTypeInfo;
+function GetClassUnitName(Value: TClass): string;
 procedure CreateComponentEvent(AComponent: TComponent; const EventName: string);
 
 
@@ -1410,7 +1411,7 @@ type
     FColumns: TListColumns;
     FModalResult:TModalResult;
   public
-    function PTypeInfos(const PropName:shortstring):PTypeInfo;
+    function PTypeInfos(const PropName:shortstring): PTypeInfo;
     constructor Create;
     destructor Destroy;  override;
   published
@@ -6183,6 +6184,20 @@ begin
     Result:=TComponent(Result).Owner;
 end;
 
+function GetClassUnitName(Value: TClass): string;
+var
+  TheTypeInfo: PTypeInfo;
+  TheTypeData: PTypeData;
+begin
+  Result:='';
+  TheTypeInfo:=ClassTypeInfo(Value);
+  if TheTypeInfo=nil then exit;
+  TheTypeData:=GetTypeData(TheTypeInfo);
+  if TheTypeData=nil then exit;
+  Result:=TheTypeData^.UnitName;
+  //debugln('GetClassUnitName A Result="',Result,'"');
+end;
+
 procedure CreateComponentEvent(AComponent: TComponent; const EventName: string);
 var
   CurDesigner: TIDesigner;

packager/packagedefs.pas

@@ -48,8 +48,9 @@ uses
   Classes, SysUtils, LCLProc, LResources, Graphics,
   {$IFNDEF VER1_0}AVL_Tree{$ELSE}OldAvLTree{$ENDIF}, Laz_XMLCfg,
   DefineTemplates, CodeToolManager, EditDefineTree, CompilerOptions, Forms,
-  FileUtil, LazarusIDEStrConsts, IDEProcs, ComponentReg, TransferMacros,
+  FileUtil, PropEdits,
-  FileReferenceList, PublishModule;
+  LazarusIDEStrConsts, IDEProcs, ComponentReg,
+  TransferMacros, FileReferenceList, PublishModule;
 
 type
   TLazPackage = class;
@@ -2918,8 +2919,16 @@ begin
 end;
 
 function TPkgComponent.GetUnitName: string;
+var
+  TIUnitName: String;
 begin
   Result:=PkgFile.UnitName;
+  // compare with RTTI unit name
+  if ComponentClass<>nil then begin
+    TIUnitName:=GetClassUnitName(ComponentClass);
+    if CompareText(TIUnitName,Result)<>0 then
+      Result:=TIUnitName;
+  end;
 end;
 
 function TPkgComponent.GetPriority: TComponentPriority;