FiveTech Support Forums

*-----------------------------------*
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

Dear Dutch,

Please replace Memory( -1 ) with:

SysRefresh()

hb_gcAll()

Antonio Linares wrote: Dear Dutch,

Please replace Memory( -1 ) with:

SysRefresh()
hb_gcAll()

Antonio Linares wrote: 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 Collapse

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

waiting for your news

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

cnavarro wrote: 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 Collapse

#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

#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

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 wrote: 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 )

Dear Dutch,

I am emailing you a modified fivehc.lib

Please try your code with it

many thanks

Antonio Linares wrote: Dear Dutch,

I am emailing you a modified fivehc.lib

Please try your code with it

many thanks

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