MG: fixed replacing form resources

git-svn-id: trunk@2747 -

components/codetools/codeatom.pas

@@ -76,6 +76,7 @@ type
     EndPos: integer;   // char behind Atom
     Flag: TCommonAtomFlag;
   end;
+  PAtomPosition = ^TAtomPosition;
   
 const
   StartAtomPosition: TAtomPosition = (StartPos:1; EndPos:1; Flag:cafNone);
@@ -101,6 +102,25 @@ type
     destructor Destroy; override;
   end;
   
+  TAtomList = class
+  private
+    FCapacity: integer;
+    FCount: integer;
+    FItems: {$ifdef FPC}^{$else}array of {$endif}TAtomPosition;
+    function GetItems(Index: integer): TAtomPosition;
+    procedure SetCapacity(const AValue: integer);
+    procedure SetItems(Index: integer; const AValue: TAtomPosition);
+    procedure Grow;
+  public
+    procedure Add(NewAtom: TAtomPosition);
+    procedure Clear;
+    constructor Create;
+    destructor Destroy; override;
+    property Capacity: integer read FCapacity write SetCapacity;
+    property Count: integer read FCount;
+    property Items[Index: integer]: TAtomPosition read GetItems write SetItems; default;
+  end;
+  
   
   TWordToAtomFlag = class(TKeyWordFunctionList)
   private
@@ -257,6 +277,64 @@ begin
 end;
 
 
+{ TAtomList }
+
+function TAtomList.GetItems(Index: integer): TAtomPosition;
+begin
+  Result:=FItems[Index];
+end;
+
+procedure TAtomList.SetCapacity(const AValue: integer);
+begin
+  if FCapacity=AValue then exit;
+  FCapacity:=AValue;
+  if FItems<>nil then begin
+    if FCapacity>0 then begin
+      ReallocMem(FItems,SizeOf(TAtomPosition)*FCapacity);
+    end else begin
+      FreeMem(FItems);
+      FItems:=nil;
+    end;
+  end else begin
+    if FCapacity>0 then
+      GetMem(FItems,SizeOf(TAtomPosition)*FCapacity);
+  end;
+end;
+
+procedure TAtomList.SetItems(Index: integer; const AValue: TAtomPosition);
+begin
+  FItems[Index]:=AValue;
+end;
+
+procedure TAtomList.Grow;
+begin
+  Capacity:=Capacity*2+10;
+end;
+
+procedure TAtomList.Add(NewAtom: TAtomPosition);
+begin
+  if FCount=FCapacity then Grow;
+  inc(FCount);
+  Items[Count-1]:=NewAtom;
+end;
+
+procedure TAtomList.Clear;
+begin
+  FCount:=0;
+  Capacity:=0;
+end;
+
+constructor TAtomList.Create;
+begin
+  inherited Create;
+end;
+
+destructor TAtomList.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
 //-----------------------------------------------------------------------------
 procedure InternalInit;
 begin

ide/main.pp

@@ -2638,6 +2638,7 @@ begin
           FormSavingOk:=false;
         end;
       until Result<>mrRetry;
+      
       // create lazarus form resource code
       if FormSavingOk then begin
         if ResourceCode=nil then begin
@@ -2676,6 +2677,17 @@ begin
               CodeToolBoss.RemoveLazarusResource(ResourceCode,
                                                'T'+AnUnitInfo.FormResourceName);
             end;
+            if (not CodeToolBoss.AddLazarusResourceHeaderComment(ResourceCode,
+               'This is an automatically created Lazarus Resource file')) then
+            begin
+              ACaption:='Resource save error';
+              AText:='Unable to add resource header comment'
+                +' to resource file '#13
+                +'"'+ResourceCode.FileName+'".'#13
+                +'Probably a syntax error.';
+              Result:=MessageDlg(ACaption,AText,mtError,[mbIgnore,mbAbort],0);
+              if Result=mrAbort then exit;
+            end;
             if (not CodeToolBoss.AddLazarusResource(ResourceCode,
                'T'+AnUnitInfo.FormName,CompResourceCode)) then
             begin
@@ -6154,6 +6166,7 @@ begin
       NewName,NewClassName);
     ApplyBossResult('Unable to rename form in source.'#13
                     +'See messages.');
+    ActiveUnitInfo.FormName:=NewName;
 
     // rename form class
     FormEditor1.JITFormList.RenameFormClass(TForm(AComponent),NewClassName);
@@ -6676,6 +6689,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.352  2002/08/27 08:21:28  lazarus
+  MG: fixed replacing form resources
+
   Revision 1.351  2002/08/24 15:49:55  lazarus
   MG: loading forms now creates all TComponentInterfaces, fixed removing components