FW_Saveimage() memory leak issue *Fixed*

[dutch]

Dear All,

I use below function to reduce image size and quality but I use multiple image (1000). This procedure consume memory almost 2Gb and got an error
"Unrecoverable error 90006 hb_xgrab can't allocate memory"
How to solve this issue? Thank you in advance.

*-----------------------------------*
FUNCTION SaveImage( cFile, cNewFile )
local oImage
local aImg, nQuality

nQuality := iif(filesize(cFile)>200000,15, iif(filesize(cFile)>150000, 20, 25 ))

if filesize(cFile) >= 32768 // 65536

oImage := GdiBmp():New( cFile )
oImage:Resize( oImage:GetWidth()/1.3, oImage:GetHeight()/1.3 )
oImage:Save( cNewFile )
oImage:End()

aImg := Fw_ReadImage( nil, cFile )
FW_SaveImage( aImg[ 1 ], cNewFile, nQuality )
PalBmpFree( aImg )

Memory( -1 )

end
Return nil

[Antonio Linares]

Dear Dutch,

Please replace Memory( -1 ) with:

SysRefresh()
hb_gcAll()

[dutch]

Dear Antonio,

I replaced as your recommend but It does not help. I try to resize the image for 500 images. The memory was started is 40MB and after resized take 1,400MB.

Dear Dutch,

Please replace Memory( -1 ) with:

SysRefresh()
hb_gcAll()

[Antonio Linares]

Dear Dutch,

many thanks for your feedback.

Ok, first lets try to identify where the memory leak comes from.

Please comment out this section and run your code again:

Code: Select all | Expand

/* oImage := GdiBmp():New( cFile )
oImage:Resize( oImage:GetWidth()/1.3, oImage:GetHeight()/1.3 )
oImage:Save( cNewFile )
oImage:End()
*/

waiting for your news

[cnavarro]

Dear Dutch
This code run ok for me
I have tried many files and have not found any problems
I have not needed to clear the memory
Can you send me one of the files you are using for testing?

Code: Select all | Expand

#include "fivewin.ch"

Function Main()

   // SaveImage( "olga1.jpg", "olga2.jpg", "olga3.jpg" )
   SaveImage( "fivedit.jpg", "fivedit2.jpg", "fivedit3.jpg" )
   

Return nil


FUNCTION SaveImage( cFile, cNewFile, cOtherFile )
local oImage
local aImg
local nQuality

nQuality := iif(filesize(cFile)>200000,15, iif(filesize(cFile)>150000, 20, 25 ))

// if filesize(cFile) >= 32768 // 65536

   oImage := GdiBmp():New( cFile )
   // ? oImage:GetWidth()
   oImage:Resize( oImage:GetWidth()/1.3, oImage:GetHeight()/1.3 )
   oImage:Save( cNewFile )
   oImage:End()

   aImg := Fw_ReadImage( nil, cFile )
   // xbrowse( aImg )
   FW_SaveImage( aImg[ 1 ], cOtherFile, nQuality )
   PalBmpFree( aImg )

   // Memory( -1 )

// end
Return nil

[dutch]

Dear Antonio,

I tested with your recommend, it's still memory leak.

Dear Dutch,

many thanks for your feedback.

Ok, first lets try to identify where the memory leak comes from.

Please comment out this section and run your code again:

Code: Select all | Expand

/* oImage := GdiBmp():New( cFile )
oImage:Resize( oImage:GetWidth()/1.3, oImage:GetHeight()/1.3 )
oImage:Save( cNewFile )
oImage:End()
*/

waiting for your news

[dutch]

Dear cnavarro,

It will effect when you run with 1000 records as below.

Code: Select all | Expand

do while !oRs:eof()
     Downloadfile( oRs:image, cFile )  // function download file from oRs (blob in MariaDb)
     SaveImage( cFile, cNewFile )
     oRs:Skip()
end

I will make small sample and send to you all for testing.

Thanks in advance,

Dear Dutch
This code run ok for me
I have tried many files and have not found any problems
I have not needed to clear the memory
Can you send me one of the files you are using for testing?

Code: Select all | Expand

#include "fivewin.ch"

Function Main()

   // SaveImage( "olga1.jpg", "olga2.jpg", "olga3.jpg" )
   SaveImage( "fivedit.jpg", "fivedit2.jpg", "fivedit3.jpg" )
   

Return nil


FUNCTION SaveImage( cFile, cNewFile, cOtherFile )
local oImage
local aImg
local nQuality

nQuality := iif(filesize(cFile)>200000,15, iif(filesize(cFile)>150000, 20, 25 ))

// if filesize(cFile) >= 32768 // 65536

   oImage := GdiBmp():New( cFile )
   // ? oImage:GetWidth()
   oImage:Resize( oImage:GetWidth()/1.3, oImage:GetHeight()/1.3 )
   oImage:Save( cNewFile )
   oImage:End()

   aImg := Fw_ReadImage( nil, cFile )
   // xbrowse( aImg )
   FW_SaveImage( aImg[ 1 ], cOtherFile, nQuality )
   PalBmpFree( aImg )

   // Memory( -1 )

// end
Return nil

[karinha]

Code: Select all | Expand

// C:\FWH\SAMPLES\DUTCH1.PRG

#include "FiveWin.ch"

FUNCTION Main()

   LOCAL cFile    := "..\BitMaps\OLGA1.jpg"
   LOCAL cNewFile := "C:\TMP\OLGANEW.jpg"

   HB_GCALL( .F. )

   CLEAR MEMORY // Optional

   SaveImage( cFile, cNewFile )

RETURN NIL

FUNCTION SaveImage( cFile, cNewFile )

   LOCAL oImage
   LOCAL aImg, nQuality

   nQuality := IIF( Filesize( cFile ) > 200000, 15, ;
               IIF( Filesize( cFile ) > 150000, 20, 25 ) )

   IF Filesize( cFile ) >= 32768 // 65536

      oImage := GdiBmp():New( cFile )

      oImage:Resize( oImage:GetWidth() / 1.3, oImage:GetHeight() / 1.3 )
      oImage:Save( cNewFile )

      oImage:End()

      SYSREFRESH()

      aImg := Fw_ReadImage( NIL, cFile )

      FW_SaveImage( aImg[ 1 ], cNewFile, nQuality )

      PalBmpFree( aImg )

   ENDIF

   HB_GCALL( .T. )

   CLEAR MEMORY

   IF FILE( "C:\TMP\OLGANEW.JPG" )

      ? "Listo, Done! check your image file if it is not corrupt!"

   ENDIF

RETURN NIL

// FIN / END

Regards, saludos.

[dutch]

Dear All,

This link contain sql (mysql) database and sample code.

https://drive.google.com/drive/folders/ ... sp=sharing

This my sample as below.

#include 'FiveWin.ch'

static oWnd, oServer
static cCurDir, cTempPath

*-------------------------*
Function Main
local oBtn, oErr

Public oFont
Public cDatabase

cDatabase := 'backup'

FW_SetUnicode( .T. )

MYSQL_TinyIntAsLogical( .T. )

SET EPOCH TO year(date())-90
SET DATE FORMAT TO 'DD/MM/YY'
SET TIME FORMAT TO 'hh:mm:ss'
SET DATE BRITISH

TRY

FWCONNECT oServer HOST '127.0.0.1' USER 'admin' PASSWORD 'nimda' DATABASE cDatabase PORT 3306

CATCH oErr

MsgStop( hb_dumpvar( oErr ) )

return nil

END

oFont := TFont():New( 'Tahoma',, -14, .F., .F., 0, 0, 400, .F., .F., .F., 222, 3, 2, 1, , 34 )

cCurDir := curdrive()+':\'+curdir()+'\'

if !lIsDir(cCurDir+'TEMP')
lMkDir(cCurDir+'TEMP')
endif

cTempPath := cCurDir+'TEMP\'

DEFINE WINDOW oWnd FROM 0, 0 TO 400, 600 PIXEL TITLE 'Test Resize Image'

oWnd:SetFont( oFont )

@ 100, 100 BUTTON oBtn PROMPT 'Run Now' SIZE 80, 40 PIXEL ACTION ReSizeGstImg() // TestBrow() //

ACTIVATE WINDOW oWNd CENTER

return nil

//*------------------------*
//Procedure TestBrow
//local GSI
//GSI := oServer:RowSet('SELECT * FROM gstimg ')
//
//XBROWSER GSI
//
//GSI:Close()
//return

*---------------------------*
Procedure ReSizeGstImg()
local nStart, nEnd

nStart := nEnd := 0

GetImgId( @nStart, @nEnd )

if nStart > 0 .and. nEnd > nStart
if MsgYesNo('Start Resize Guest Image?')

MsgMeter2( {|oMeter, oText, oDlg, lEnd| ResizeImgNow( oMeter, nStart, nEnd ) }, 'Guest', "Resize Process" )

MsgWait("Resize Guest Image complete",,2)

end
end
return


*---------------------------------------------*
Procedure ResizeImgNow(oMeter, nStart, nEnd )
local GSI
local cTempFile, cTmpFile, cFileName, nTry, nTotalRec, nPer, n

nPer := 9
n := 0

GSI := oServer:RowSet('SELECT * FROM gstimg WHERE gsi_id>='+ltrim(str(nStart))+' and gsi_id<='+ltrim(str(nEnd)))

if (nTotalRec := GSI:KeyCount()) > 0
do while !GSI:eof()
n++
cTmpFile := cTempPath+ltrim(str(GSI:gsi_id))+'B.JPG'
cTempFile := cTempPath+ltrim(str(GSI:gsi_id))+'A.JPG'

DownloadFile( GSI, 'gsi_image1', cTempFile )

if file(cTempFile)
if filesize(cTempFile) > 32768
nTry := 0

Saveimage( cTempFile, cTmpFile )

Memory( -1 )

cFileName := StrTran( cTmpFile, '\', '/' )

oServer:Execute('UPDATE gstimg SET gsi_image1=LOAD_FILE("'+cFileName+'") WHERE gsi_id='+ltrim(str(GSI:gsi_id)))

end

end

GSI:Skip()

if ((n*100)/nTotalRec) > nPer
nPer += 10
oMeter:SetPos( nPer )
end
SysRefresh()

end
GSI:Close()
end

return


*-----------------------------------*
FUNCTION SaveImage( cFile, cNewFile )
local oImage
local aImg, nQuality, nMultiple

nQuality := iif(filesize(cFile)>200000,15, iif(filesize(cFile)>150000, 20, 25 ))

oImage := GdiBmp():New( cFile )
nMultiple:= 1-round((oImage:GetWidth()-800)/(oImage:GetWidth()),2)
oImage:Resize( oImage:GetWidth()*nMultiple, oImage:GetHeight()*nMultiple )
oImage:Save( cNewFile )
oImage:End()

aImg := Fw_ReadImage( nil, cNewFile )
FW_SaveImage( aImg[ 1 ], cNewFile, nQuality )
PalBmpFree( aImg )


return nil

*---------------------------------*
Procedure GetImgId( nStart, nEnd )
local oDlg, oGet[2], oSay, oBtn
local nNum1, nNum2, lSave

lSave := .F.
nNum1 := 0
nNum2 := 0

DEFINE DIALOG oDlg FROM 0, 0 TO 100, 320 PIXEL TITLE 'Guest Image Id' ;
FONT MEMVAR->oFont

oDlg:lHelpIcon := .F.

@ 12,10 SAY oSay PROMPT 'Start Id' SIZE 50, 13 PIXEL OF oDlg
@ 30,10 SAY oSay PROMPT 'End Id' SIZE 50, 13 PIXEL OF oDlg

@ 10,60 GET oGet[1] VAR nNum1 SIZE 50, 13 PIXEL OF oDlg VALID nNum1 > 0 ;
PICTURE '9999999999' ;
RIGHT
@ 28,60 GET oGet[2] VAR nNum2 SIZE 50, 13 PIXEL OF oDlg VALID nNum2 > 0 .and. nNum2 > nNum1;
PICTURE '9999999999' ;
RIGHT

@ 10,115 BUTTON oBtn PROMPT 'Save' SIZE 40, 30 PIXEL OF oDlg ;
ACTION (lSave := .T. , oDlg:End())

ACTIVATE DIALOG oDlg CENTER

if lSave
nStart:= nNum1
nEnd := nNum2
else
nStart:= 0
nEnd := 0
end

return

*---------------------------------------------------------------------------*
Procedure DownloadFile( oRs, cFieldName, cFileName )
local nBufSize, cBuffer, hTarget, oFile, cDateTime

cDateTime := ''

if file(cFileName)

ferase(cFileName)

end
if !empty(oRs:FieldGet(cFieldName)) .and. !file(cFileName)

Memory( -1 )

nBufSize:=10485760
cBuffer:=Space(nBufSize)

hTarget := FCreate(cFileName)
oFile := oRs:FieldGet(cFieldName)
FWrite( hTarget, oFile )

FClose( hTarget )

end

return

*----------------------------------------------------*
function MsgMeter2( bAction, cMsg, cTitle, lBoton )
local oDlg, oMeter, oBtn //, oFont
local lEnd := .f., lCancel := .f.
local nVal := 0

DEFAULT bAction := { || nil },;
cMsg := "Progressing...", cTitle := "Progress Bar",;
lBoton := .f.

Private oText

DEFINE DIALOG oDlg FROM 1, 1 TO 120, 340 PIXEL TITLE cTitle ;
FONT MEMVAR->oFont

oDlg:lHelpIcon := .F.

@ 10, 10 SAY oText VAR cMsg SIZE 130, 9 OF oDlg PIXEL
@ 30, 10 PROGRESS oMeter SIZE 150, 12 OF oDlg PIXEL


if lBoton
@ 50, 200 BUTTON oBtn PROMPT "Cancel" OF oDlg ;
ACTION ( lEnd:= .t., lCancel:= .t. ) SIZE 40, 15 PIXEL
endif

oDlg:bStart = { || Eval( bAction, oMeter, oText, oDlg, @lEnd, oBtn ),;
lEnd := .t., oDlg:End() }

ACTIVATE DIALOG oDlg CENTERED ;
ON INIT (oMeter:SetRange( 0, 100 ), oMeter:SetStep( 1 )) ;
VALID lEnd

return lCancel

Thank you in advance,

[Antonio Linares]

Dear Dutch,

Could you please comment this line and try it again ? Trying to locate the memory leak, thanks

// keep commented the above code

aImg := Fw_ReadImage( nil, cFile )
// FW_SaveImage( aImg[ 1 ], cNewFile, nQuality )
PalBmpFree( aImg )

[dutch]

Dear Antonio,

Yes, FW_Saveimage() has consumed the memory. It did not take memory much (30mb-40mb / 1000 pictures) after remark this line.

Dear Dutch,

Could you please comment this line and try it again ? Trying to locate the memory leak, thanks

// keep commented the above code

aImg := Fw_ReadImage( nil, cFile )
// FW_SaveImage( aImg[ 1 ], cNewFile, nQuality )
PalBmpFree( aImg )

[Antonio Linares]

Dear Dutch,

I am emailing you a modified fivehc.lib

Please try your code with it

many thanks

[dutch]

Dear Antonio,

I got an error while compile & link as below;

Turbo Incremental Link 6.80 Copyright (c) 1997-2017 Embarcadero Technologies, Inc.
Error: Unresolved external '_hb_vmCDP' referenced from D:\FWH1901\LIB\FIVEHC.LIB|fwunicode
Error: Unable to perform link
EZ4FO6.EXE - 2 error(s), 24 warning(s)

Thank you in advance for your help.

Dear Dutch,

I am emailing you a modified fivehc.lib

Please try your code with it

many thanks

[dutch]

Dear Antonio,

I still use FWH 1901.
I subscribed up to 2304 but I cannot move forward, because of Drag & Drop that I mention.

bDragBegin and bDropOver problem *Unresolve*
since Sep 12, 2023
viewtopic.php?p=276556#p276556

[Antonio Linares]

Dear Dutch,

I have built and test your app using Harbour and xHarbour and FWH 25.01

I have sent you everything to test it. It seems to work fine.

waiting for your feedback, thanks