Skip to content
GitLab
  • Menu
Projects Groups Snippets
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
    • Contribute to GitLab
    • Switch to GitLab Next
  • Sign in / Register
  • Lazarus Lazarus
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 2,093
    • Issues 2,093
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 7
    • Merge requests 7
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • Code review
    • Insights
    • Issue
    • Repository
  • External wiki
    • External wiki
  • Activity
  • Graph
  • Create a new issue
  • Commits
  • Issue Boards
Collapse sidebar

Scheduled maintenance on the database layer will take place on 2022-07-02. We expect GitLab.com to be unavailable for up to 2 hours starting from 06:00 UTC. Kindly follow our status page for updates and read more in our blog post.

  • FPC
  • Lazarus
  • LazarusLazarus
  • Issues
  • #35372
Closed
Open
Created Apr 13, 2019 by FPC Admin account@fpc_adminOwner

Tbitmap.LoadFromRawImage creates memory leaks of image size.

Original Reporter info from Mantis: jamie @jamie
  • Reporter name: jamie philbrook

Description:

If you use the Tbitmap.LoadFromRawImage it recreates the image and
does not clean up the old one, leaving behind memory when freeing the
object.

See Post
https://forum.lazarus.freepascal.org/index.php/topic,45016.0.html

Steps to reproduce:

EDITED BY MFR:

Code to reproduce, from forum:

    procedure TForm1.Button1Click(Sender: TObject);
    Var
      A,B:TBitmap;
    begin
      A := Tbitmap.Create; B := Tbitmap.Create;
      A.PixelFormat := pf24bit; B.PixelFormat := pf24bit;
      A.SetSize(320,240); B.SetSize(320, 240);
      A.Canvas.Changed;  //Force a DIB GUI type in windows.
      A.LoadFromRawImage(B.RawImage,false);  //Keep B as RAW only..
      A.Free;
      B.Free;
    end;                                                                      

Below suggested fix from reporter (procedure is in TRasterImage, not TBitmap)
----

See posted articles and fixes that I have tested and works on my end...

I didn't recompile or rebuild the LCL for this fix, I simply tested with
a local override of the procedure..
procedure TBitmap.LoadFromRawImage(const AImage: TRawImage; ADataOwner: Boolean);
var
  img: PRawImage;
begin
  BeginUpdate;
  try
    Clear;
    if AImage.Description.Format = ricfNone then Exit; // empty image

    img := GetRawImagePtr;
    img^.Description := AImage.Description;
    if ADataOwner
    then begin
      img^.DataSize := AImage.DataSize;
      img^.Data := AImage.Data;
      img^.MaskSize := AImage.MaskSize;
      img^.Mask := AImage.Mask;
      img^.PaletteSize := AImage.PaletteSize;
      img^.Palette := AImage.Palette;
    end
    else begin
      // copy needed
      img^.DataSize := AImage.DataSize;
      if img^.DataSize > 0
      then begin
        //GetMem(img^.Data, img^.DataSize);
        ReallocMem(img^.Data, img^.DataSize);
        Move(AImage.Data^, img^.Data^, img^.DataSize);
      end
      else img^.Data := nil;

      img^.MaskSize := AImage.MaskSize;
      if img^.MaskSize > 0
      then begin
        //GetMem(img^.Mask, img^.MaskSize);
        Reallocmem(img^.Mask, img^.MaskSize);
        Move(AImage.Mask^, img^.Mask^, img^.MaskSize);
      end
      else img^.Mask := nil;

      img^.PaletteSize := AImage.PaletteSize;
      if img^.PaletteSize > 0
      then begin
       // GetMem(img^.Palette, img^.PaletteSize);
        ReallocMem(img^.Palette, img^.PaletteSize);
        Move(AImage.Palette^, img^.Palette^, img^.PaletteSize);
      end
      else img^.Palette := nil;
    end;
  finally
    EndUpdate;
  end;                                                    

Mantis conversion info:

  • Mantis ID: 35372
  • OS: Found on Windows but not related
  • OS Build: 10
  • Build: Current release.
  • Platform: most likely all
  • Version: 2.0
  • Fixed in version: 2.0.4
  • Fixed in revision: 61202 (#76b9420c)
  • Target version: 2.0.4
Assignee
Assign to
Time tracking