diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 5e6415e53d..0709ca0fd7 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -1186,6 +1186,7 @@ type procedure LoadFromIntfImage(IntfImage: TLazIntfImage); procedure SaveToStream(AStream: TStream); override; procedure GetSupportedSourceMimeTypes(List: TStrings); override; + procedure GetSize(out AWidth, AHeight: Integer); procedure Mask(ATransparentColor: TColor); procedure SetHandles(ABitmap, AMask: HBITMAP); virtual; abstract; // called when handles are set by user function ReleaseBitmapHandle: HBITMAP; @@ -1204,9 +1205,6 @@ type write SetTransparentColor default clDefault; property TransparentMode: TTransparentMode read FTransparentMode write SetTransparentMode default tmAuto; - {$IFDEF DebugBitmap} - DebugEnabled: boolean; - {$ENDIF} end; TSharedCustomBitmap = class(TSharedRasterImage) diff --git a/lcl/include/icon.inc b/lcl/include/icon.inc index 5515075d75..0b4850e59a 100644 --- a/lcl/include/icon.inc +++ b/lcl/include/icon.inc @@ -272,9 +272,10 @@ procedure TCustomIcon.Assign(Source: TPersistent); begin if Source is TCustomIcon then begin - FCurrent := TCustomIcon(Source).Current; - end - else if Source is TRasterImage + FCurrent := -1; + end; + + if Source is TRasterImage then begin Clear; @@ -286,6 +287,11 @@ begin end; inherited Assign(Source); + + if Source is TCustomIcon + then begin + FCurrent := TCustomIcon(Source).Current; + end; end; procedure TCustomIcon.AssignImage(ASource: TRasterImage); diff --git a/lcl/include/imglist.inc b/lcl/include/imglist.inc index 1c51f6bf85..82221197cd 100644 --- a/lcl/include/imglist.inc +++ b/lcl/include/imglist.inc @@ -640,6 +640,10 @@ begin if AImage = nil then Exit; // Paul: dont optimize. We need to call HandleNeeded before checking of maskhandle + // mwe: we should use MaskHandle without checking, but since TRasterImage only + // has a Transparent property and no Masked property, masks would also get + // generated for alpha images. Therefore we re rely now on the fact that a + // "native" mask handle is generated when a bitmaphandle is created. img := AImage.Handle; if AMask = nil then begin diff --git a/lcl/include/rasterimage.inc b/lcl/include/rasterimage.inc index ca8c11015b..c0fbcd0fd1 100644 --- a/lcl/include/rasterimage.inc +++ b/lcl/include/rasterimage.inc @@ -19,9 +19,32 @@ } procedure TRasterImage.Assign(Source: TPersistent); + procedure CopyMask(AMask: HBITMAP); + var + RI: TRawImage; + msk, dummy: HBITMAP; + begin + // we need a winapi.CopyImage here (would make things easier) + // in theory, it should not matter if a HBITMAP was created as bitmap or as mask + // since there is a description problem in gtk, create both (we cannot create mask only) + // todo: fix gtk + if not RawImage_FromBitmap(RI, AMask, AMask) then Exit; + msk := 0; + dummy := 0; + RawImage_CreateBitmaps(RI, dummy, msk {, True}); + RI.FreeData; + DeleteObject(dummy); + + if BitmapHandleAllocated + then UpdateHandles(BitmapHandle, msk) + else UpdateHandles(0, msk); + end; + + var SrcImage: TRasterImage absolute Source; SrcFPImage: TFPCustomImage absolute Source; + SrcRawImage, DstRawImage: PRawImage; IntfImage: TLazIntfImage; ImgHandle,ImgMaskHandle: HBitmap; begin @@ -29,8 +52,14 @@ begin if Source is TRasterImage then begin - // TRasterImage can share image data - + if MaskHandleAllocated + then begin + // Clear mask first mask + if BitmapHandleAllocated + then UpdateHandles(BitmapHandle, 0) + else UpdateHandles(0, 0); + end; + FTransparent := SrcImage.Transparent; FTransparentMode := SrcImage.TransparentMode; FTransparentColor := SrcImage.TransparentColor; @@ -43,21 +72,41 @@ begin FreeCanvasContext; // release old FImage FSharedImage.Release; - // share FImage with assigned graphic - FSharedImage := SrcImage.FSharedImage; - FSharedImage.Reference; - // We only can share images of the same type and when neither we or source is updating - // Since we "share" it first, the unshare code will create a copy - if (FUpdateCount > 0) - or (SrcImage.FUpdateCount > 0) - or not CanShareImage(SrcImage.GetSharedImageClass) + // We only can share images of the same type ... + if CanShareImage(SrcImage.GetSharedImageClass) then begin - UnshareImage(True); - FreeSaveStream; + // share FImage with assigned graphic + FSharedImage := SrcImage.FSharedImage; + FSharedImage.Reference; + + // when updating, unshare + // Since we "share" it first, the unshare code will create a copy + if (FUpdateCount > 0) + or (SrcImage.FUpdateCount > 0) + then begin + UnshareImage(True); + FreeSaveStream; + end; + end + else begin + // not sharable, create rawimage copy + FSharedImage := GetSharedImageClass.Create; + FSharedImage.Reference; + + // copy raw image + SrcRawImage := SrcImage.GetRawImagePtr; + DstRawImage := GetRawImagePtr; + if (SrcRawImage <> nil) and (DstRawImage <> nil) + then with SrcRawImage^ do + ExtractRect(Rect(0, 0, Description.Width, Description.Height), DstRawImage^); end; end; + if SrcImage.MaskHandleAllocated + then CopyMask(SrcImage.MaskHandle); + + if FUpdateCount = 0 then Changed(Self); @@ -697,6 +746,24 @@ begin Result := TSharedRasterImage; end; +procedure TRasterImage.GetSize(out AWidth, AHeight: Integer); +var + Desc: PRawImageDescription; +begin + Desc := GetRawImageDescriptionPtr; + if (Desc = nil) or (Desc^.Format = ricfNone) + then begin + AWidth := 0; + AHeight := 0; + end + else begin + AWidth := Desc^.Width; + AHeight := Desc^.Height; + end; +end; + + + procedure TRasterImage.ReadData(Stream: TStream); function GetImageClass: TRasterImageClass; const