PHP DM Gate v0.9 » NewDIBBitmap <span class="vd">[Delphi, Windows]</span>

QAZ (05.04.11 14:20) [0]

Как корректно высвобождать память от битмапа созданного NewDIBBitmap через free бывает утечка памяти или при выходе из процедуры с локальной переменной Bitmap выкидывает в окно CPU?

<Цитата>
Jon © (07.04.11 02:21) [1]

I can confirm a memory leak with both NewDIBBitmap and NewBitmap.
Tested with KOL v3 and v2 - so maybe it is just how memory is allocated.
The following sample program will demonstrate the memory usage:

program Test;

uses
Windows, Messages, KOL;

var
DIBBitmap: PBitmap;
lblHeap: PControl;

procedure btnCreateClick(Dummy: Pointer; Sender: PObj);
begin
if Assigned(DIBBitmap) then
Free_And_Nil(DIBBitmap);
// DIBBitmap := NewBitmap(ScreenWidth, ScreenHeight);
// DIBBitmap.PixelFormat := pf24bit;
DIBBitmap := NewDIBBitmap(ScreenWidth, ScreenHeight, pf24bit);
end;

procedure btnFillClick(Dummy: Pointer; Sender: PObj);
var
DC: HDC;
begin
if not Assigned(DIBBitmap) then
Exit;
DC := GetDC(GetDesktopWindow);
BitBlt(DIBBitmap.Canvas.Handle, 0, 0, DIBBitmap.Width, DIBBitmap.Height, DC, 0, 0, SRCCOPY);
ReleaseDC(GetDesktopWindow, DC);
end;

procedure btnSaveClick(Dummy: Pointer; Sender: PObj);
begin
if Assigned(DIBBitmap) then
DIBBitmap.SaveToFile(ChangeFileExt(ParamStr(0), '.bmp'));
end;

procedure btnFreeClick(Dummy: Pointer; Sender: PObj);
begin
if Assigned(DIBBitmap) then
Free_And_Nil(DIBBitmap);
end;

procedure TimerTick(Dummy: Pointer; Sender: PObj);
var
HeapStatus: THeapStatus;
begin
HeapStatus := GetHeapStatus;
lblHeap.Caption := Int2Str(HeapStatus.TotalAllocated);
end;

begin
Applet := NewForm(nil, 'DIBBitmap Test');
with NewButton(Applet, 'Create')^ do
OnClick := TOnEvent(MakeMethod(nil, @btnCreateClick));
with NewButton(Applet, 'Fill').PlaceDown^ do
OnClick := TOnEvent(MakeMethod(nil, @btnFillClick));
with NewButton(Applet, 'Save').PlaceDown^ do
OnClick := TOnEvent(MakeMethod(nil, @btnSaveClick));
with NewButton(Applet, 'Free').PlaceDown^ do
OnClick := TOnEvent(MakeMethod(nil, @btnFreeClick));
lblHeap := NewLabel(Applet,'Heap Status').PlaceDown.ResizeParent;
with NewTimer(500)^ do
begin
OnTimer := TOnEvent(MakeMethod(nil, @TimerTick));
Enabled := True;
end;
Run(Applet);
end.

<Цитата>
Jon © (07.04.11 04:38) [2]

Note: The memory leak is NOT present with PAS_VERSION

<Цитата>
Jon © (07.04.11 16:18) [3]

The problem is the asm version of TBitmap.GetCanvas
Replace the asm function with the pas code and leak is fixed
I hope that Vladimir (or another skilled in asm) will be able to fix the code

<Цитата>
Thaddy © (07.04.11 19:36) [4]

DeleteDc is not called for CreateCompatibleDc.

<Цитата>
Jon © (08.04.11 23:06) [5]

> DeleteDc is not called for CreateCompatibleDc

But the PAS version of TBitmap.GetCanvas does not call DeleteDc and that works correctly.

<Цитата>
Vladimir Kladov © (09.04.11 06:04) [6]

I do not see any problem with your test, Jon. Just click Create-Fill-Save-Free or Create-Fill-Free several times. Something is not released immediately but it is released later and final number is the same.

Even if to change fill procedure with the code

procedure btnFillClick(Dummy: Pointer; Sender: PObj);
//var DC: HDC;
begin
if not Assigned(DIBBitmap) then
Exit;
//DC := GetDC(GetDesktopWindow);
//BitBlt(DIBBitmap.Canvas.Handle, 0, 0, DIBBitmap.Width, DIBBitmap.Height, DC, 0, 0, SRCCOPY);
//ReleaseDC(GetDesktopWindow, DC);
DIBBitmap.Canvas.Brush.Color := clRed;
DIBBitmap.Canvas.FillRect( DIBBitmap.BoundsRect );
end;

final result is the same: number shown is stable 6680 (after the second loop Create-Fill-Free).

<Цитата>
Jon © (09.04.11 14:17) [7]

> Something is not released immediately but it is released later

OK, thanks for the explanation.

<Цитата>