* Fixed loading of old graphic streams

* Added TIcon.AssignImage, so one image of an icon can be changed

git-svn-id: trunk@15775 -

lcl/graphics.pp

@@ -391,10 +391,13 @@ const
 
 type
   TCanvas = class;
-
+  
-  // standard LCL graphic formats
+  // base class
-  TCustomBitmap = class;            // base class
+  TRasterImage = class;
+  TRasterImageClass = class of TRasterImage;
+  TCustomBitmap = class;
   TCustomBitmapClass = class of TCustomBitmap;
+  // standard LCL graphic formats
   TBitmap = class;                  // bmp
   TPixmap = class;                  // xpm
   TIcon = class;                    // ico
@@ -1481,6 +1484,7 @@ type
 
     procedure Add(AFormat: TPixelFormat; AHeight, AWidth: Word);
     procedure Assign(Source: TPersistent); override;
+    procedure AssignImage(ASource: TRasterImage); virtual;
     procedure Clear; override;
     procedure Delete(Aindex: Integer);
     procedure Remove(AFormat: TPixelFormat; AHeight, AWidth: Word);
@@ -1779,6 +1783,7 @@ begin
   Result:='['+Result+']';
 end;
 
+
 function LoadCursorFromLazarusResource(ACursorName: String): HCursor;
 var
   CursorImage: TCursorImage;

lcl/include/icon.inc

@@ -270,12 +270,85 @@ end;
 
 procedure TCustomIcon.Assign(Source: TPersistent);
 begin
-  if Source is TCustomIcon then
+  if Source is TCustomIcon
+  then begin
     FCurrent := TCustomIcon(Source).Current;
+  end
+  else if Source is TRasterImage
+  then begin
+    Clear;
+    
+    with TRasterImage(Source) do
+      Self.Add(PixelFormat, Height, Width);
+
+    AssignImage(TRasterImage(Source));
+    Exit;
+  end;
 
   inherited Assign(Source);
 end;
 
+procedure TCustomIcon.AssignImage(ASource: TRasterImage);
+var
+  Image, NewImage: TIconImage;
+  RawImage: PRawImage;
+begin
+  if FCurrent = -1
+  then raise EInvalidGraphicOperation.Create(rsIconNoCurrent);
+
+  if ASource = nil
+  then raise EInvalidGraphicOperation.Create(rsIconImageEmpty);
+
+  Image := TIconImage(TSharedIcon(FSharedImage).FImages[FCurrent]);
+
+  if (Image.Width <> ASource.Width)
+  or (Image.Height <> ASource.Height)
+  then raise EInvalidGraphicOperation.Create(rsIconImageSize);
+  
+  if Image.PixelFormat <> ASource.PixelFormat
+  then raise EInvalidGraphicOperation.Create(rsIconImageFormat);
+
+  UnshareImage(True);
+  FreeCanvasContext;
+  
+  RawImage := ASource.GetRawImage;
+  NewImage := TIconImage.Create(Image.PixelFormat, Image.Height, Image.Width);
+  try
+    NewImage.FImage.Description := RawImage^.Description;
+
+    NewImage.FImage.DataSize := RawImage^.DataSize;
+    if NewImage.FImage.DataSize > 0
+    then begin
+      NewImage.FImage.Data := GetMem(NewImage.FImage.DataSize);
+      Move(RawImage^.Data^, NewImage.FImage.Data^, NewImage.FImage.DataSize);
+    end;
+    NewImage.FImage.MaskSize := RawImage^.MaskSize;
+    if NewImage.FImage.MaskSize > 0
+    then begin
+      NewImage.FImage.Mask := GetMem(NewImage.FImage.MaskSize);
+      Move(RawImage^.Mask^, NewImage.FImage.Mask^, NewImage.FImage.MaskSize);
+    end;
+    NewImage.FImage.PaletteSize := RawImage^.PaletteSize;
+    if NewImage.FImage.PaletteSize > 0
+    then begin
+      NewImage.FImage.Palette := GetMem(NewImage.FImage.PaletteSize);
+      Move(RawImage^.Palette^, NewImage.FImage.Palette^, NewImage.FImage.PaletteSize);
+    end;
+
+    // this cannot be shcanged without adjusting data
+    // NewImage.FImage.Description.MaskBitsPerPixel := 1;
+
+    TSharedIcon(FSharedImage).FImages[FCurrent] := NewImage;
+    NewImage := nil;
+    Image.Free;
+
+  finally
+    NewImage.Free;
+  end;
+
+  Changed(Self);
+end;
+
 procedure TCustomIcon.Clear;
 begin
   if not Empty then
@@ -475,14 +548,15 @@ begin
 
   Position := Stream.Position;
   Stream.Read(Signature, SizeOf(Signature));
+  Stream.Position := Position;
   if Cardinal(Signature) = Cardinal(IconSignature)
   then begin
     // Assume Icon - stream without explicit size
-    Stream.Position := Position;
     LoadFromStream(Stream);
   end
   else begin
-    LoadFromStream(Stream, LEtoN(Size));
+    // use inherited to read, so "old" streams are converted
+    inherited;
   end;
 end;
 
@@ -731,7 +805,7 @@ var
   NewIcon, OldIcon: TSharedIcon;
   n: Integer;
   OldImage, NewImage: TIconImage;
-  OldBitmap: TSharedCustomBitmap;
+//  OldBitmap: TSharedCustomBitmap;
   OldSharedImage: TSharedImage;
 begin
   if FSharedImage.RefCount <= 1 then Exit;
@@ -741,8 +815,12 @@ begin
     NewIcon.Reference;
     if CopyContent
     then begin
+      // in theory we should have a compatible shared image
+      // if not, something internal is wrong
+      (*
       if FSharedImage is TSharedIcon then
       begin
+      *)
         OldIcon := FSharedImage as TSharedIcon;
         for n := 0 to OldIcon.FImages.Count -1 do
         begin
@@ -769,6 +847,7 @@ begin
             Move(OldImage.FImage.Palette^, NewImage.FImage.Palette^, NewImage.FImage.PaletteSize);
           end;
         end;
+(*
       end
       else
       if FSharedImage is TSharedCustomBitmap then
@@ -797,6 +876,7 @@ begin
         end;
         NewImage.FImage.Description.MaskBitsPerPixel := 1;
       end;
+*)
     end;
     FreeCanvasContext;
     OldSharedImage := FSharedImage;

lcl/include/rasterimage.inc

@@ -649,12 +649,56 @@ begin
 end;
 
 procedure TRasterImage.ReadData(Stream: TStream);
+  function GetImageClass: TRasterImageClass;
+  const
+    // need to repeat here since they aren't defined yet
+    IconSignature: array [0..3] of char = #0#0#1#0;
+    CursorSignature: array [0..3] of char = #0#0#2#0;
+  var
+    Sig: array[0..7] of Char;
+    Position: Int64;
+  begin
+    Position := Stream.Position;
+    Stream.Read(Sig[0], SizeOf(Sig));
+    Stream.Position := Position;
+
+    if (Sig[0] = 'B') and (Sig[1] = 'M') then Exit(TBitmap);
+    if CompareMem(@Sig[0], @PNGcomn.Signature[0], 8) then Exit(TPortableNetworkGraphic);
+    if CompareMem(@Sig[0], @IconSignature[0], 4) then Exit(TIcon);
+    if CompareMem(@Sig[0], @CursorSignature[0], 4) then Exit(TCursorImage);
+    if TestStreamIsXPM(Stream) then Exit(TPixmap);
+
+    Result := nil;
+  end;
+
 var
   Size: Longint;
+  ImageClass: TRasterImageClass;
+  Image: TRasterImage;
 begin
   Stream.Read(Size, SizeOf(Size));
   Size := LEtoN(Size);
-  LoadFromStream(Stream, Size);
+  
+  // pre laz 0.9.26 there was no strict relation between graphic format and
+  // classtype, so we need to check if we need some conversion
+  if Size >= 8
+  then ImageClass := GetImageClass
+  else ImageClass := nil;
+
+  if (ImageClass = nil) or ClassType.InheritsFrom(ImageClass)
+  then begin
+    // no conversion needed, or it wasn't a known "old" format
+    LoadFromStream(Stream, Size);
+    Exit;
+  end;
+  
+  Image := ImageClass.Create;
+  Image.LoadFromStream(Stream, Size);
+  try
+    Assign(Image);
+  finally
+    Image.Free;
+  end;
 end;
 
 procedure TRasterImage.WriteData(Stream: TStream);

lcl/lclstrconsts.pas

@@ -196,6 +196,10 @@ ResourceString
   rsUnsupportedBitmapFormat = 'Unsupported bitmap format.';
   rsErrorWhileSavingBitmap = 'Error while saving bitmap.';
   rsDuplicateIconFormat = 'Duplicate icon format.';
+  rsIconImageEmpty = 'Icon image cannot be empty';
+  rsIconImageSize = 'Icon image must have the same size';
+  rsIconNoCurrent = 'Icon has no current image';
+  rsIconImageFormat = 'Icon image must have the same format';
   rsNoWidgetSet = 'No widgetset object. '
     +'Please check if the unit "interfaces" was added to the programs uses clause.';
   rsPressOkToIgnoreAndRiskDataCorruptionPressCancelToK = '%s%sPress Ok to '