From 19919c7035ac84a2d3d0e66d3a541cf316d6de37 Mon Sep 17 00:00:00 2001 From: marc Date: Mon, 14 Jul 2008 00:40:42 +0000 Subject: [PATCH] * 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 | 11 +++-- lcl/include/icon.inc | 88 +++++++++++++++++++++++++++++++++++-- lcl/include/rasterimage.inc | 46 ++++++++++++++++++- lcl/lclstrconsts.pas | 4 ++ 4 files changed, 141 insertions(+), 8 deletions(-) diff --git a/lcl/graphics.pp b/lcl/graphics.pp index de91b10140..dc935df9c7 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -391,10 +391,13 @@ const type TCanvas = class; - - // standard LCL graphic formats - TCustomBitmap = class; // base 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; diff --git a/lcl/include/icon.inc b/lcl/include/icon.inc index 6c40bb07b6..349eae9949 100644 --- a/lcl/include/icon.inc +++ b/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; diff --git a/lcl/include/rasterimage.inc b/lcl/include/rasterimage.inc index be02b606de..6d4c5df31b 100644 --- a/lcl/include/rasterimage.inc +++ b/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); diff --git a/lcl/lclstrconsts.pas b/lcl/lclstrconsts.pas index b753621ddb..a511f7bbf6 100644 --- a/lcl/lclstrconsts.pas +++ b/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 '