implemented datamodules

git-svn-id: trunk@4222 -

components/codetools/basiccodetools.pas

@@ -122,8 +122,7 @@ procedure RaiseCatchableException(const Msg: string);
 // functions / procedures
 
 { These functions are not context sensitive. Especially they ignore compiler
-  settings and compiler directives. They exist only for easy usage, they are not
+  settings and compiler directives. They exist only for basic usage.
-  used by the CodeTools
 }
 
 // source type
@@ -197,14 +196,15 @@ function AddFormComponentToSource(Source:TSourceLog; FormBodyStartPos: integer;
 function RemoveFormComponentFromSource(Source:TSourceLog;
   FormBodyStartPos: integer;
   ComponentName, ComponentClassName: string): boolean;
+function FindClassAncestorName(const Source, FormClassName: string): string;
 
 // code search
-function SearchCodeInSource(const Source,Find:string; StartPos:integer;
+function SearchCodeInSource(const Source, Find: string; StartPos:integer;
-   var EndFoundPosition:integer;  CaseSensitive:boolean):integer;
+   var EndFoundPosition: integer; CaseSensitive: boolean):integer;
-function ReadNextPascalAtom(const Source:string;
+function ReadNextPascalAtom(const Source: string;
-   var Position,AtomStart:integer):string;
+   var Position, AtomStart: integer): string;
-function ReadRawNextPascalAtom(const Source:string;
+procedure ReadRawNextPascalAtom(const Source: string;
-   var Position,AtomStart:integer):string;
+   var Position, AtomStart: integer);
 
 
 //-----------------------------------------------------------------------------
@@ -901,67 +901,86 @@ begin
   Result:=true;
 end;
 
-function ReadNextPascalAtomEx(const Source : string;var Position,EndPosition : integer;CaseSensitive : boolean; var Atom : string):boolean;
+function FindClassAncestorName(const Source, FormClassName: string): string;
+var
+  SrcPos, AtomStart: integer;
 begin
-     Atom := ReadNextPascalAtom(Source,Position,EndPosition);
+  Result:='';
-     if not(CaseSensitive) then Atom := lowerCase(Atom);
+  if SearchCodeInSource(Source,FormClassName+'=class(',1,SrcPos,false)<1 then
-     Result := (Position > length(Source));
+    exit;
+  Result:=ReadNextPascalAtom(Source,SrcPos,AtomStart);
+  if (Result<>'') and (not IsValidIdent(Result)) then
+    Result:='';
 end;
 
+function SearchCodeInSource(const Source, Find: string; StartPos: integer;
+  var EndFoundPosition: integer; CaseSensitive: boolean):integer;
 // search pascal atoms of Find in Source
-
+// returns the start pos
-function SearchCodeInSource(const Source,Find:string; StartPos:integer;
-   var EndFoundPosition:integer;  CaseSensitive:boolean):integer;
 var
-	FindAtomStart     : integer;
+  FindLen: Integer;
-	FindPos           : integer;
+  SrcLen: Integer;
-	Position          : integer;
+  Position: Integer;
-	AtomStart         : integer;
+  FirstFindPos: Integer;
-	FirstSrcAtomStart : integer;
+  FindAtomStart: Integer;
-	CompareSrcPosition: integer;
+  AtomStart: Integer;
-	FindAtom          : string ;
+  FindAtomLen: Integer;
-	SrcAtom           : string;
+  AtomLen: Integer;
-	HasFound          : boolean;
+  SrcPos: Integer;
-	FirstFindAtom     : string;
+  FindPos: Integer;
-	FirstFindPos      : integer;
+  SrcAtomStart: Integer;
+  FirstFindAtomStart: Integer;
 begin
   Result:=-1;
   if (Find='') or (StartPos>length(Source)) then exit;
+  
+  FindLen:=length(Find);
+  SrcLen:=length(Source);
 
   Position:=StartPos;
+  AtomStart:=StartPos;
   FirstFindPos:=1;
+  FirstFindAtomStart:=1;
 
-  {search first atom in find}
+  // search first atom in find
-
+  ReadRawNextPascalAtom(Find,FirstFindPos,FirstFindAtomStart);
-  if ReadNextPascalAtomEx(Find,FirstFindPos,FindAtomStart,CaseSensitive,FirstFindAtom) then exit;
+  FindAtomLen:=FirstFindPos-FirstFindAtomStart;
+  if FirstFindAtomStart>FindLen then exit;
 
   repeat
-
+    // read next atom
-     if ReadNextPascalAtomEx(Source,Position,AtomStart,CaseSensitive,SrcAtom) then break;
+    ReadRawNextPascalAtom(Source,Position,AtomStart);
-
+    if AtomStart>SrcLen then exit;
-     if SrcAtom=FirstFindAtom then begin
+    AtomLen:=Position-AtomStart;
-      {first atom found}
+    
-      FirstSrcAtomStart  := AtomStart;
+    if (AtomLen=FindAtomLen)
-      CompareSrcPosition := Position;
+    and (CompareText(@Find[FirstFindAtomStart],FindAtomLen,
-      FindPos := FirstFindPos;
+                     @Source[AtomStart],AtomLen,CaseSensitive)=0)
-
+    then begin
-      {read next source and find atoms and compare}
+      // compare all atoms
-
+      SrcPos:=Position;
+      SrcAtomStart:=SrcPos;
+      FindPos:=FirstFindPos;
+      FindAtomStart:=FindPos;
       repeat
-
+        // read the next atom from the find
-        if ReadNextPascalAtomEx(Find,FindPos,FindAtomStart,CaseSensitive,FindAtom) then break;        
+        ReadRawNextPascalAtom(Find,FindPos,FindAtomStart);
-        if ReadNextPascalAtomEx(Source,CompareSrcPosition,AtomStart,CaseSensitive,SrcAtom) then break;
+        if FindAtomStart>FindLen then begin
-
+          // found !
-        HasFound := SrcAtom = FindAtom;
+          EndFoundPosition:=SrcPos;
-
+          Result:=AtomStart;
-        if HasFound then begin
+          exit;
-           Result := FirstSrcAtomStart;
-           EndFoundPosition := CompareSrcPosition;
-           exit;
         end;
-
+        // read the next atom from the source
-      until not(HasFound);
+        ReadRawNextPascalAtom(Source,SrcPos,SrcAtomStart);
-     end;
+        // compare
+        if (CompareText(@Find[FindAtomStart],FindPos-FindAtomStart,
+                        @Source[SrcAtomStart],SrcPos-SrcAtomStart,
+                        CaseSensitive)<>0)
+        then
+          break;
+      until false;
+    end;
   until false;
 end;
 
@@ -1156,7 +1175,8 @@ var DirectiveName:string;
   DirStart,DirEnd,EndPos:integer;
 begin
   repeat
-    Result:=ReadRawNextPascalAtom(Source,Position,AtomStart);
+    ReadRawNextPascalAtom(Source,Position,AtomStart);
+    Result:=copy(Source,AtomStart,Position-AtomStart);
     if (copy(Result,1,2)='{$') or (copy(Result,1,3)='(*$') then begin
       if copy(Result,1,2)='{$' then begin
         DirStart:=3;
@@ -1181,8 +1201,8 @@ begin
   until false;
 end;
 
-function ReadRawNextPascalAtom(const Source:string; 
+procedure ReadRawNextPascalAtom(const Source:string;
-  var Position,AtomStart:integer):string;
+  var Position,AtomStart:integer);
 var Len:integer;
   c1,c2:char;
 begin
@@ -1328,7 +1348,6 @@ begin
       end;
     end;
   end;
-  Result:=copy(Source,AtomStart,Position-AtomStart);
 end;
 
 function LineEndCount(const Txt: string;

components/codetools/codetoolmanager.pas

@@ -368,6 +368,8 @@ type
     function RenameForm(Code: TCodeBuffer;
       const OldFormName, OldFormClassName: string;
       const NewFormName, NewFormClassName: string): boolean;
+    function FindFormAncestor(Code: TCodeBuffer; const FormClassName: string;
+      var AncestorClassName: string; DirtySearch: boolean): boolean;
 
     // form components
     function PublishedVariableExists(Code: TCodeBuffer;
@@ -1970,6 +1972,28 @@ begin
   end;
 end;
 
+function TCodeToolManager.FindFormAncestor(Code: TCodeBuffer;
+  const FormClassName: string; var AncestorClassName: string;
+  DirtySearch: boolean): boolean;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  writeln('TCodeToolManager.FindFormAncestor A ',Code.Filename,' ',FormClassName);
+  {$ENDIF}
+  AncestorClassName:='';
+  if not InitCurCodeTool(Code) then exit;
+  try
+    Result:=FCurCodeTool.FindFormAncestor(UpperCaseStr(FormClassName),
+                                          AncestorClassName);
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
+  if (not Result) and DirtySearch then begin
+    AncestorClassName:=FindClassAncestorName(Code.Source,FormClassName);
+    Result:=AncestorClassName<>'';
+  end;
+end;
+
 function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
   const AClassName, AVarName: string): boolean;
 begin

components/codetools/stdcodetools.pas

@@ -128,6 +128,8 @@ type
     function RenameForm(const OldFormName, OldFormClassName: string;
           const NewFormName, NewFormClassName: string;
           SourceChangeCache: TSourceChangeCache): boolean;
+    function FindFormAncestor(const UpperClassName: string;
+          var AncestorClassName: string): boolean;
 
     // form components
     function FindPublishedVariable(const UpperClassName,
@@ -1135,6 +1137,32 @@ begin
   end;
 end;
 
+function TStandardCodeTool.FindFormAncestor(const UpperClassName: string;
+  var AncestorClassName: string): boolean;
+var
+  ClassNode: TCodeTreeNode;
+begin
+  Result:=false;
+  AncestorClassName:='';
+  if UpperClassName='' then exit;
+  BuildTree(true);
+  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  if (ClassNode=nil) then exit;
+  // search the ancestor name
+  MoveCursorToNodeStart(ClassNode);
+  ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
+  if UpAtomIs('PACKED') then ReadNextAtom;
+  ReadNextAtom;
+  if AtomIsChar('(') then begin
+    ReadNextAtom;
+    if AtomIsIdentifier(false) then
+      AncestorClassName:=GetAtom;
+  end;
+  if AncestorClassName='' then
+    AncestorClassName:='TObject';
+  Result:=true;
+end;
+
 {-------------------------------------------------------------------------------
   function TStandardCodeTool.ReplaceIdentifiers(IdentList: TStrings;
     SourceChangeCache: TSourceChangeCache): boolean;

designer/designerprocs.pas

@@ -81,14 +81,6 @@ const
   NonVisualCompWidth = NonVisualCompIconWidth+2*NonVisualCompBorder;
 
 
-type
-  TGetDesignerFormEvent =
-    function(AComponent: TComponent): TCustomForm of object;
-
-var
-  OnGetDesignerForm: TGetDesignerFormEvent;
-
-function GetDesignerForm(AComponent: TComponent): TCustomForm;
 function GetParentLevel(AControl: TControl): integer;
 function ControlIsInDesignerVisible(AControl: TControl): boolean;
 function ComponentIsInvisible(AComponent: TComponent): boolean;
@@ -277,19 +269,6 @@ begin
   Result:=(AComponent is TMenuItem);
 end;
 
-function GetDesignerForm(AComponent: TComponent): TCustomForm;
-var
-  Owner: TComponent;
-begin
-  Result:=nil;
-  if Assigned(OnGetDesignerForm) then
-    Result:=OnGetDesignerForm(AComponent)
-  else begin
-    Owner:=AComponent.Owner;
-    if Owner is TCustomForm then Result:=TCustomForm(Owner);
-  end;
-end;
-
 { TDesignerDeviceContext }
 
 function TDesignerDeviceContext.GetDCOrigin: TPoint;

designer/jitform/jitform.pas

@@ -57,6 +57,8 @@ type
   TJITDataModule = class (TDataModule)
   protected
     class function NewInstance : TObject; override;
+    procedure ValidateRename(AComponent: TComponent;
+                             const CurName, NewName: string); override;
   public
   end;
 
@@ -111,5 +113,16 @@ begin
   TSetDesigningComponent.SetDesigningOfControl(TComponent(Result),true);
 end;
 
+procedure TJITDataModule.ValidateRename(AComponent: TComponent; const CurName,
+  NewName: string);
+var
+  Designer: TIDesigner;
+begin
+  inherited ValidateRename(AComponent, CurName, NewName);
+  Designer:=FindRootDesigner(Self);
+  if Designer <> nil then
+    Designer.ValidateRename(AComponent, CurName, NewName);
+end;
+
 end.
 

designer/noncontrolforms.pas

@@ -109,6 +109,10 @@ begin
   if FLookupRoot=AValue then exit;
   DoSaveBounds;
   FLookupRoot:=AValue;
+  if FLookupRoot<>nil then begin
+    Caption:=FLookupRoot.Name;
+    writeln('TNonControlForm.SetLookupRoot ',FLookupRoot.Name,':',FLookupRoot.ClassName);
+  end;
   DoLoadBounds;
 end;
 
@@ -124,10 +128,12 @@ begin
   inherited Create(TheOwner);
   FFrameWidth:=1;
   ControlStyle:=ControlStyle-[csAcceptsControls];
+  writeln('TNonControlForm.Create ');
 end;
 
 destructor TNonControlForm.Destroy;
 begin
+  writeln('TNonControlForm.Destroy ');
   inherited Destroy;
 end;
 
@@ -136,11 +142,13 @@ var
   ARect: TRect;
 begin
   inherited Paint;
-  ARect:=Rect(FrameWidth,FrameWidth,
-                                ClientWidth-FrameWidth,ClientHeight-FrameWidth);
   with Canvas do begin
     Brush.Color:=clWhite;
+    ARect:=Rect(FrameWidth,FrameWidth,
+                                ClientWidth-FrameWidth,ClientHeight-FrameWidth);
     FillRect(ARect);
+    ARect:=Rect(0,0,ClientWidth+1,ClientHeight+1);
+    Pen.Color:=clBlack;
     Frame3d(ARect, FrameWidth, bvLowered);
   end;
 end;
@@ -191,6 +199,7 @@ begin
     NewTop:=CurDataModule.DesignOffset.Y;
     NewWidth:=CurDataModule.DesignSize.X;
     NewHeight:=CurDataModule.DesignSize.Y;
+writeln('TDataModuleForm.DoLoadBounds ',NewLeft,',',NewTop,',',NewWidth,',',NewHeight);
     SetBounds(NewLeft,NewTop,NewWidth,NewHeight);
   end;
 end;
@@ -205,6 +214,7 @@ begin
     CurDataModule.DesignOffset.Y:=Top;
     CurDataModule.DesignSize.X:=Width;
     CurDataModule.DesignSize.Y:=Height;
+writeln('TDataModuleForm.DoSaveBounds ',Left,',',Top,',',Width,',',Height);
   end;
   inherited DoSaveBounds;
 end;

designer/propedits.pp

@@ -905,6 +905,9 @@ type
   TPropHookGetComponentNames = procedure(TypeData:PTypeData;
                                          Proc:TGetStringProc) of object;
   TPropHookGetRootClassName = function:ShortString of object;
+  TPropHookBeforeAddComponent = function(Sender: TObject;
+                                         AComponentClass: TComponentClass;
+                                         Parent: TComponent): boolean of object;
   TPropHookComponentRenamed = procedure(AComponent: TComponent) of object;
   TPropHookComponentAdded = procedure(AComponent: TComponent; Select: boolean
                                       ) of object;
@@ -940,6 +943,7 @@ type
     htGetComponentNames,
     htGetRootClassName,
     htComponentRenamed,
+    htBeforeAddComponent,
     htComponentAdded,
     htComponentDeleting,
     htDeleteComponent,
@@ -989,6 +993,9 @@ type
     function GetComponentName(AComponent: TComponent):ShortString;
     procedure GetComponentNames(TypeData:PTypeData; const Proc:TGetStringProc);
     function GetRootClassName:ShortString;
+    function BeforeAddComponent(Sender: TObject;
+                                AComponentClass: TComponentClass;
+                                Parent: TComponent): boolean;
     procedure ComponentRenamed(AComponent: TComponent);
     procedure ComponentAdded(AComponent: TComponent; Select: boolean);
     procedure ComponentDeleting(AComponent: TComponent);
@@ -1045,6 +1052,10 @@ type
                                  OnGetRootClassName: TPropHookGetRootClassName);
     procedure RemoveHandlerGetRootClassName(
                                  OnGetRootClassName: TPropHookGetRootClassName);
+    procedure AddHandlerBeforeAddComponent(
+                             OnBeforeAddComponent: TPropHookBeforeAddComponent);
+    procedure RemoveHandlerBeforeAddComponent(
+                             OnBeforeAddComponent: TPropHookBeforeAddComponent);
     procedure AddHandlerComponentRenamed(
                                  OnComponentRenamed: TPropHookComponentRenamed);
     procedure RemoveHandlerComponentRenamed(
@@ -4380,6 +4391,21 @@ begin
     Result:=LookupRoot.ClassName;
 end;
 
+function TPropertyEditorHook.BeforeAddComponent(Sender: TObject;
+  AComponentClass: TComponentClass; Parent: TComponent): boolean;
+var
+  i: Integer;
+  Handler: TPropHookBeforeAddComponent;
+begin
+  i:=GetHandlerCount(htBeforeAddComponent);
+  while GetNextHandlerIndex(htBeforeAddComponent,i) do begin
+    Handler:=TPropHookBeforeAddComponent(FHandlers[htBeforeAddComponent][i]);
+    Result:=Handler(Sender,AComponentClass,Parent);
+    if not Result then exit;
+  end;
+  Result:=true;
+end;
+
 procedure TPropertyEditorHook.ComponentRenamed(AComponent: TComponent);
 var
   i: Integer;
@@ -4669,6 +4695,18 @@ begin
   RemoveHandler(htGetRootClassName,TMethod(OnGetRootClassName));
 end;
 
+procedure TPropertyEditorHook.AddHandlerBeforeAddComponent(
+  OnBeforeAddComponent: TPropHookBeforeAddComponent);
+begin
+  AddHandler(htBeforeAddComponent,TMethod(OnBeforeAddComponent));
+end;
+
+procedure TPropertyEditorHook.RemoveHandlerBeforeAddComponent(
+  OnBeforeAddComponent: TPropHookBeforeAddComponent);
+begin
+  RemoveHandler(htBeforeAddComponent,TMethod(OnBeforeAddComponent));
+end;
+
 procedure TPropertyEditorHook.AddHandlerComponentRenamed(
   OnComponentRenamed: TPropHookComponentRenamed);
 begin

ide/customformeditor.pp

@@ -38,9 +38,10 @@ uses
 {$IFDEF IDE_MEM_CHECK}
   MemCheck,
 {$ENDIF}
-  Classes, AbstractFormeditor, Controls, PropEdits, TypInfo, ObjectInspector,
+  Classes, SysUtils, AbstractFormeditor, Controls, PropEdits, TypInfo,
-  Forms, Menus, Dialogs, AVL_Tree, JITForms, NonControlForms, ComponentReg,
+  Forms, Menus, Dialogs, AVL_Tree, ObjectInspector, JITForms, NonControlForms,
-  IDEProcs, ComponentEditors, KeyMapping, EditorOptions, Designerprocs;
+  ComponentReg, IDEProcs, ComponentEditors, KeyMapping, EditorOptions,
+  Designerprocs;
 
 Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
 
@@ -137,10 +138,21 @@ each control that's dropped onto the form
     Procedure DeleteControl(AComponent: TComponent; FreeComponent: boolean);
     Function FindComponentByName(const Name : ShortString) : TIComponentInterface; override;
     Function FindComponent(AComponent: TComponent): TIComponentInterface; override;
+    
     function IsJITComponent(AComponent: TComponent): boolean;
     function GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
+    function FindJITList(AComponent: TComponent): TJITComponentList;
     function GetDesignerForm(AComponent: TComponent): TCustomForm;
     function FindNonControlForm(LookupRoot: TComponent): TNonControlForm;
+    function CreateNonControlForm(LookupRoot: TComponent): TNonControlForm;
+    procedure RenameJITComponent(AComponent: TComponent;
+                                 const NewName: shortstring);
+    procedure UpdateDesignerFormName(AComponent: TComponent);
+    function CreateNewJITMethod(AComponent: TComponent;
+                                const AMethodName: shortstring): TMethod;
+    procedure RenameJITMethod(AComponent: TComponent;
+                           const OldMethodName, NewMethodName: shortstring);
+    procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
     
     function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
     function CreateUniqueComponentName(AComponent: TComponent): string;
@@ -173,7 +185,7 @@ implementation
 
 
 uses
-  SysUtils, Math;
+  Math;
 
 function CompareComponentInterfaces(Data1, Data2: Pointer): integer;
 var
@@ -786,6 +798,17 @@ begin
     Result:=nil;
 end;
 
+function TCustomFormEditor.FindJITList(AComponent: TComponent
+  ): TJITComponentList;
+begin
+  if JITFormList.IndexOf(AComponent)>=0 then
+    Result:=JITFormList
+  else if JITDataModuleList.IndexOf(AComponent)>=0 then
+    Result:=JITDataModuleList
+  else
+    Result:=nil;
+end;
+
 function TCustomFormEditor.GetDesignerForm(AComponent: TComponent
   ): TCustomForm;
 var
@@ -793,6 +816,8 @@ var
 begin
   Result:=nil;
   OwnerComponent:=AComponent.Owner;
+  if OwnerComponent=nil then
+    OwnerComponent:=AComponent;
   if OwnerComponent is TCustomForm then
     Result:=TCustomForm(OwnerComponent)
   else
@@ -811,6 +836,73 @@ begin
     Result:=nil;
 end;
 
+function TCustomFormEditor.CreateNonControlForm(LookupRoot: TComponent
+  ): TNonControlForm;
+begin
+  if FindNonControlFormNode(LookupRoot)<>nil then
+    RaiseException('TCustomFormEditor.CreateNonControlForm exists already');
+  if LookupRoot is TDataModule then begin
+    Result:=TDataModuleForm.Create(nil);
+    Result.LookupRoot:=LookupRoot;
+    FNonControlForms.Add(Result);
+  end else
+    RaiseException('TCustomFormEditor.CreateNonControlForm Unknown type '
+      +LookupRoot.ClassName);
+end;
+
+procedure TCustomFormEditor.RenameJITComponent(AComponent: TComponent;
+  const NewName: shortstring);
+var
+  JITComponentList: TJITComponentList;
+begin
+  JITComponentList:=FindJITList(AComponent);
+  if JITComponentList=nil then
+    RaiseException('TCustomFormEditor.RenameJITComponent');
+  JITComponentList.RenameComponentClass(AComponent,NewName);
+end;
+
+procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
+var
+  ANonControlForm: TNonControlForm;
+begin
+  ANonControlForm:=FindNonControlForm(AComponent);
+writeln('TCustomFormEditor.UpdateDesignerFormName ',ANonControlForm<>nil,' ',AComponent.Name);
+  if ANonControlForm<>nil then
+    ANonControlForm.Caption:=AComponent.Name;
+end;
+
+function TCustomFormEditor.CreateNewJITMethod(AComponent: TComponent;
+  const AMethodName: shortstring): TMethod;
+var
+  JITComponentList: TJITComponentList;
+begin
+  JITComponentList:=FindJITList(AComponent);
+  if JITComponentList=nil then
+    RaiseException('TCustomFormEditor.CreateNewJITMethod');
+  Result:=JITComponentList.CreateNewMethod(AComponent,AMethodName);
+end;
+
+procedure TCustomFormEditor.RenameJITMethod(AComponent: TComponent;
+  const OldMethodName, NewMethodName: shortstring);
+var
+  JITComponentList: TJITComponentList;
+begin
+  JITComponentList:=FindJITList(AComponent);
+  if JITComponentList=nil then
+    RaiseException('TCustomFormEditor.RenameJITMethod');
+  JITComponentList.RenameMethod(AComponent,OldMethodName,NewMethodName);
+end;
+
+procedure TCustomFormEditor.SaveHiddenDesignerFormProperties(
+  AComponent: TComponent);
+var
+  NonControlForm: TNonControlForm;
+begin
+  NonControlForm:=FindNonControlForm(AComponent);
+  if NonControlForm<>nil then
+    NonControlForm.DoSaveBounds;
+end;
+
 function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
   ): TBaseComponentEditor;
 var

ide/newdialog.pas

@@ -550,10 +550,8 @@ begin
   Add(NewCategory);
   NewCategory.Add(TNewIDEItemTemplate.Create(niiUnit,'Unit',niifCopy,[]));
   NewCategory.Add(TNewIDEItemTemplate.Create(niiForm,'Form',niifCopy,[]));
-  {$IFDEF EnableDataMods}
   NewCategory.Add(TNewIDEItemTemplate.Create(niiDataModule,'Data Module',
                                              niifCopy,[]));
-  {$ENDIF}
   NewCategory.Add(TNewIDEItemTemplate.Create(niiText,'Text',niifCopy,[]));
   
   // category project

ide/project.pp

@@ -447,7 +447,7 @@ type
     property FirstRequiredDependency: TPkgDependency
                                                   read FFirstRequiredDependency;
     property FirstUnitWithEditorIndex: TUnitInfo read GetFirstUnitWithEditorIndex;
-    property FirstUnitWithForm: TUnitInfo read GetFirstUnitWithComponent;
+    property FirstUnitWithComponent: TUnitInfo read GetFirstUnitWithComponent;
     property Flags: TProjectFlags read FFlags write SetFlags;
     property IconPath: String read fIconPath write fIconPath;
     property JumpHistory: TProjectJumpHistory
@@ -2638,6 +2638,9 @@ end.
 
 {
   $Log$
+  Revision 1.126  2003/06/01 21:09:09  mattias
+  implemented datamodules
+
   Revision 1.125  2003/06/01 11:23:01  mattias
   splittet designer form and lookup root
 

lcl/forms.pp

@@ -336,7 +336,7 @@ type
     procedure UpdateShowing; override;
     procedure UpdateWindowState;
     procedure ValidateRename(AComponent: TComponent;
-                             const CurName, NewName: string);override;
+                             const CurName, NewName: string); override;
     procedure VisibleChanging; override;
     procedure WndProc(var TheMessage : TLMessage); override;
   public
@@ -790,7 +790,15 @@ type
 function SaveFocusState: TFocusState;
 procedure RestoreFocusState(FocusState: TFocusState);
 
+type
+  TGetDesignerFormEvent =
+    function(AComponent: TComponent): TCustomForm of object;
+
+var
+  OnGetDesignerForm: TGetDesignerFormEvent;
+
 function GetParentForm(Control:TControl): TCustomForm;
+function GetDesignerForm(AComponent: TComponent): TCustomForm;
 function FindRootDesigner(AComponent: TComponent): TIDesigner;
 
 function IsAccel(VK : Word; const Str : ShortString): Boolean;
@@ -1000,24 +1008,24 @@ end;
 function FindRootDesigner(AComponent: TComponent): TIDesigner;
 var
   Form: TCustomForm;
+begin
+  Result:=nil;
+  Form:=GetDesignerForm(AComponent);
+  if Form<>nil then
+    Result:=Form.Designer;
+end;
+
+function GetDesignerForm(AComponent: TComponent): TCustomForm;
+var
+  Owner: TComponent;
 begin
   Result:=nil;
   if AComponent=nil then exit;
-  while (AComponent<>nil) do begin
+  if Assigned(OnGetDesignerForm) then
-    if (AComponent is TCustomForm) then begin
+    Result:=OnGetDesignerForm(AComponent)
-      Form:=TCustomForm(AComponent);
+  else begin
-      if Form.Parent=nil then begin
+    Owner:=AComponent.Owner;
-        Result:=Form.Designer;
+    if Owner is TCustomForm then Result:=TCustomForm(Owner);
-        exit;
-      end;
-    end;
-    if AComponent is TControl then begin
-      AComponent:=TControl(AComponent).Parent;
-    end else if (AComponent.Owner<>nil) then begin
-      AComponent:=AComponent.Owner;
-    end else begin
-      exit;
-    end;
   end;
 end;
 

lcl/include/customform.inc

@@ -625,18 +625,18 @@ Begin
   inherited RequestAlign;
 end;
 
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
-{       TCustomForm SetDesigner                                          }
+       TCustomForm SetDesigner
-{------------------------------------------------------------------------------}
+------------------------------------------------------------------------------}
 Procedure TCustomForm.SetDesigner(Value : TIDesigner);
 Begin
   FDesigner := Value;
 end;
 
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
-{       TCustomForm ValidateRename                                             }
+       TCustomForm ValidateRename
-{  if AComponent is nil, then the name of Self is changed                      }
+  if AComponent is nil, then the name of Self is changed
-{------------------------------------------------------------------------------}
+------------------------------------------------------------------------------}
 procedure TCustomForm.ValidateRename(AComponent: TComponent;
   const CurName, NewName: String);
 begin
@@ -1426,6 +1426,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.100  2003/06/01 21:09:09  mattias
+  implemented datamodules
+
   Revision 1.99  2003/05/24 08:51:41  mattias
   implemented designer close query
 

lcl/lresources.pp

@@ -68,6 +68,7 @@ function LFMtoLRSfile(LFMfilename:ansistring):boolean;
 function LFMtoLRSstream(LFMStream,LFCStream:TStream):boolean;
  // returns true if successful
 function FindLFMClassName(LFMStream:TStream):AnsiString;
+function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
 
 type
   TDelphiStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
@@ -177,14 +178,21 @@ begin
 end;
 
 function FindLFMClassName(LFMStream:TStream):ansistring;
-// the classname is the last word of the first line
+{ examples:
+  object Form1: TForm1
+  inherited AboutBox2: TAboutBox2
+
+  -> the classname is the last word of the first line
+}
 var c:char;
   StartPos,EndPos:integer;
 begin
   Result:='';
   StartPos:=-1;
   c:=' ';
+  // read till end of line
   repeat
+    // remember last non identifier char position
     if (not (c in ['a'..'z','A'..'Z','0'..'9','_'])) then
       StartPos:=LFMStream.Position;
     LFMStream.Read(c,1);
@@ -192,10 +200,13 @@ begin
   until c in [#10,#13];
   if StartPos<0 then exit;
   EndPos:=LFMStream.Position-1;
+  if EndPos-StartPos>255 then exit;
   SetLength(Result,EndPos-StartPos);
   LFMStream.Position:=StartPos;
   LFMStream.Read(Result[1],length(Result));
   LFMStream.Position:=0;
+  if (Result='') or (not IsValidIdent(Result)) then
+    Result:='';
 end;
 
 function LFMtoLRSfile(LFMfilename:ansistring):boolean;
@@ -832,6 +843,48 @@ begin
   FStream.Write(Buf,Count);
 end;
 
+function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
+// 0 = ok
+// -1 = error while streaming AForm to binary stream
+// -2 = error while streaming binary stream to text file
+var
+  BinStream: TMemoryStream;
+  Driver: TAbstractObjectWriter;
+  Writer: TWriter;
+begin
+  Result:=0;
+  BinStream:=TMemoryStream.Create;
+  try
+    try
+      // write component to binary stream
+      Driver:=TBinaryObjectWriter.Create(BinStream,4096);
+      try
+        Writer:=TWriter.Create(Driver);
+        try
+          Writer.WriteDescendent(AComponent,nil);
+        finally
+          Writer.Free;
+        end;
+      finally
+        Driver.Free;
+      end;
+    except
+      Result:=-1;
+      exit;
+    end;
+    try
+      // transform binary to text
+      BinStream.Position:=0;
+      ObjectBinaryToText(BinStream,LFMStream);
+    except
+      Result:=-2;
+      exit;
+    end;
+  finally
+    BinStream.Free;
+  end;
+end;
+
 procedure DelphiObjectBinaryToText(Input, Output: TStream);
 var
   NestingLevel: Integer;

packager/componentreg.pas

@@ -38,7 +38,7 @@ unit ComponentReg;
 interface
 
 uses
-  Classes, SysUtils,
+  Classes, SysUtils, Controls,
   {$IFDEF CustomIDEComps}
   CustomIDEComps,
   {$ENDIF}
@@ -86,6 +86,7 @@ type
     function GetPriority: TComponentPriority; virtual;
     procedure AddToPalette; virtual;
     function CanBeCreatedInDesigner: boolean; virtual;
+    procedure ShowHideControl(Show: boolean);
   public
     property ComponentClass: TComponentClass read FComponentClass;
     property PageName: string read FPageName;
@@ -121,6 +122,7 @@ type
     procedure Remove(AComponent: TRegisteredComponent);
     function FindComponent(const CompClassName: string): TRegisteredComponent;
     function FindButton(Button: TComponent): TRegisteredComponent;
+    procedure ShowHideControls(Show: boolean);
   public
     property Items[Index: integer]: TRegisteredComponent read GetItems; default;
     property PageName: string read FPageName;
@@ -172,6 +174,7 @@ type
     function FindButton(Button: TComponent): TRegisteredComponent;
     function CreateNewClassName(const Prefix: string): string;
     function IndexOfPageComponent(AComponent: TComponent): integer;
+    procedure ShowHideControls(Show: boolean);
   public
     property Pages[Index: integer]: TBaseComponentPage read GetItems; default;
     property UpdateLock: integer read FUpdateLock;
@@ -268,6 +271,12 @@ begin
   Result:=true;
 end;
 
+procedure TRegisteredComponent.ShowHideControl(Show: boolean);
+begin
+  if ComponentClass.InheritsFrom(TControl) then
+    Visible:=Show;
+end;
+
 { TBaseComponentPage }
 
 function TBaseComponentPage.GetItems(Index: integer): TRegisteredComponent;
@@ -379,6 +388,14 @@ begin
   Result:=nil;
 end;
 
+procedure TBaseComponentPage.ShowHideControls(Show: boolean);
+var
+  i: Integer;
+begin
+  for i:=0 to Count-1 do
+    Items[i].ShowHideControl(Show);
+end;
+
 { TBaseComponentPalette }
 
 function TBaseComponentPalette.GetItems(Index: integer): TBaseComponentPage;
@@ -577,6 +594,16 @@ begin
     Result:=-1;
 end;
 
+procedure TBaseComponentPalette.ShowHideControls(Show: boolean);
+var
+  i: Integer;
+begin
+  BeginUpdate(false);
+  for i:=0 to Count-1 do
+    Pages[i].ShowHideControls(Show);
+  EndUpdate;
+end;
+
 
 initialization
   IDEComponentPalette:=nil;