Byref in return function

[aloberoger]

In this case how to manange byref function:

Code: Select all

Function CPicture.Clone()ByRef As CPicture
	Dim As CPicture Ptr pClone = new CPicture(This) 
	return ByVal pClone
 End Function
   Function CPicture.FromIPicture(ByVal opic As IPicture Ptr) ByRef As CPicture
   	Return ByVal (New CPicture(opic))
   End Function

Code: Select all

dim byref pic as Cpicture =CPicture.Clone()
                 if pic then delete @pic ?  or nothing to do ?

[fxm]

Could you post more understandable code?

I tried to invent some code that matches your few lines of code:

Code: Select all

Type CPicture
    Dim As String s = "test"
    Declare Function Clone () ByRef As CPicture
    Declare Function FromIPicture (ByVal opic As CPicture Ptr) ByRef As CPicture
    Declare Constructor ()
    Declare Constructor (ByVal opic As CPicture Ptr)
End Type

Constructor CPicture ()
End Constructor

Constructor CPicture (ByVal opic As CPicture Ptr)
    This = *opic
End Constructor

Function CPicture.Clone () ByRef As CPicture
    Dim As CPicture Ptr pClone = new CPicture(This)
    Return ByVal pClone
End Function

Function CPicture.FromIPicture (ByVal opic As CPicture Ptr) ByRef As CPicture
    Return ByVal New CPicture(opic)
End Function


Dim Byref pic As Cpicture = CPicture().Clone()

Print pic.s

'.....
'.....

Delete @pic
@pic = 0

Sleep

[aloberoger]

here is the whole class:

Code: Select all

	 

#Include Once "windows.bi" 
#Include Once "win/ocidl.bi" 
#Include Once "win/olectl.bi"

Type CPicture  extends object
 
public:
	
	Declare Constructor()
	Declare Constructor(ByVal opic As IPicture Ptr)
	Declare Constructor (ByRef opic As Const CPicture) 
	Declare virtual Destructor() 
   Declare Operator let(ByVal opic As IPicture Ptr)
   Declare Operator let(ByRef opic As Const CPicture)
   Declare Operator cast() As IPicture Ptr 
   Declare Function Clone()ByRef As CPicture
   Declare Static Function FromIPicture(ByVal opic As IPicture Ptr) ByRef As CPicture
   Declare Function  FromHandle(ByVal oHandle As LPVOID, ByVal PicType As Short) As BOOLEAN 'PicType== PICTYPE_UNINITIALIZED = -1 ,PICTYPE_NONE=0,PICTYPE_BITMAP=1,PICTYPE_METAFILE=2,PICTYPE_ICON = 3,PICTYPE_ENHMETAFILE=4
	Declare Function	LoadFromRes(sResourceType As  LPCTSTR , sResource As LPCTSTR ) As BOOLEAN
	Declare Function  LoadFromRes(sResourceType As  LPCTSTR , ByVal IDRes As Integer) As BOOLEAN
	Declare Function	LoadFromFile(sFileName As String ) As BOOLEAN
	Declare Function	Draw(pDC As HDC) As BOOLEAN
	Declare Function	Draw(pDC As HDC, Posi As  POINT) As BOOLEAN
	Declare Function	Draw(pDC As HDC, Posi As  POINT,oSize as SIZE ) As BOOLEAN
	Declare Function	Draw(pDC As HDC,nSizeRatio As double ) As BOOLEAN
	Declare Function	Draw(pDC As HDC, Posi As POINT ,nSizeRatio As double ) As BOOLEAN
	Declare Function	Render(pDC As HDC, x As Integer, y As Integer, cx As Integer, cy As Integer) As BOOLEAN
	Declare Property type_() As Long   ' PICTYPE_UNINITIALIZED = -1 ,PICTYPE_NONE=0,PICTYPE_BITMAP=1,PICTYPE_METAFILE=2,PICTYPE_ICON = 3,PICTYPE_ENHMETAFILE=4
	Declare Property Width() As Long   ' in pixels
	Declare Property Height() As Long   ' in pixels
	Declare Property Handle() As LPVOID          '  Can be hbitmap,hIcon,hmetafile or HenhMetafile
	Declare Property Attributes() As ULong     ' can be PICTURE_TRANSPARENT
	Declare Sub  Save(ByVal FileName As String)  '  .bmp, .wmf, .ico, .emf
private:
	Declare Static Function		GetResource(lpName As LPCTSTR ,lpType As LPCTSTR ,pResource As Any Ptr , ByRef nBufSize As Integer) As BOOLEAN
	Declare Sub			UnLoad() 
	Declare Function	LoadFromBuffer(pBuff As Byte Ptr , nSize As Integer) As BOOLEAN
	Declare Function	Draw(pDC As HDC, x As Integer, y As Integer, cx As Integer, cy As Integer) As BOOLEAN
	Declare Function CHimetricToPixel_X(ByVal nWidth As Long) As Long
   Declare Function CHimetricToPixel_Y(ByVal nHeight As Long) As Long
	As IPicture Ptr		m_pPicture 
	enum
		HIMETRIC_PER_INCH	= 2540
	End Enum
End Type




'''''''''''''''''''''''''''''''''''
' Construction/Destruction
'''''''''''''''''''''''''''''''''''

Constructor CPicture()
	m_pPicture	= NULL 
End Constructor

Constructor CPicture(ByVal opic As IPicture Ptr)
     If m_pPicture Then 
     	    m_pPicture->lpvtbl->Release(m_pPicture)
        EndIf
  	   m_pPicture=opic 
End Constructor

 Constructor CPicture(ByRef opic As Const CPicture)
 	  If m_pPicture Then 
     	    m_pPicture->lpvtbl->Release(m_pPicture)
     EndIf
 	   m_pPicture=opic.m_pPicture
 	   If m_pPicture then m_pPicture->lpvtbl->AddRef(m_pPicture)
 End Constructor

Destructor CPicture()
	UnLoad() 
End Destructor


  Operator CPicture.let(ByVal opic As IPicture Ptr)
  	   If m_pPicture Then 
     	    m_pPicture->lpvtbl->Release(m_pPicture)
     EndIf
  	   m_pPicture=opic 	
  End Operator
  
   Operator CPicture.let(ByRef opic As Const CPicture)
    	 If m_pPicture Then 
       	    m_pPicture->lpvtbl->Release(m_pPicture)
     EndIf
    	m_pPicture=opic.m_pPicture
    	If m_pPicture then m_pPicture->lpvtbl->AddRef(m_pPicture)
   End Operator
    
   Operator CPicture.cast() As IPicture Ptr 
     	   Return m_pPicture
   End Operator


 Function CPicture.Clone()ByRef As CPicture
	Dim As CPicture Ptr pClone = new CPicture(This) 
	return ByVal pClone
 End Function



   Function CPicture.FromIPicture(ByVal opic As IPicture Ptr) ByRef As CPicture
   	Return ByVal (New CPicture(opic))
   End Function


Function  CPicture.FromHandle(ByVal oHandle As LPVOID, ByVal PicType As Short) As BOOLEAN
	     UnLoad()
	     'm_pPicture=PictureFromHandle(oHandle,PicType)
	     Return TRUE
End Function

Function CPicture.LoadFromRes(sResourceType As  LPCTSTR , sResource As LPCTSTR ) As BOOLEAN
 
	Dim As boolean bResult = false 

	if (m_pPicture <> NULL) Then
		UnLoad() 
   End If 
	if (m_pPicture = NULL) Then
	 
	  Dim As BYTE Ptr	pBuff = NULL 
		Dim As Integer		nSize = 0 
		if (GetResource(sResource , sResourceType , pBuff, nSize)) Then
		 
			if (nSize > 0) Then
			 
				pBuff = new BYTE[nSize] 

				if (GetResource(sResource, sResourceType ,pBuff, nSize)) Then
				 
					if (LoadFromBuffer(pBuff, nSize)) Then
						bResult = true 
				   End If
            End If
				delete [] pBuff 
			End If
		End If
	End If
	return bResult 
End Function


Function CPicture.LoadFromRes(sResourceType  As LPCTSTR,ByVal IDRes As Integer ) As BOOLEAN
	Dim As boolean bResult = false 

	if (m_pPicture <> NULL) Then
		UnLoad() 
   End If 
	if (m_pPicture = NULL) Then
	 
	  Dim As BYTE Ptr	pBuff = NULL 
		Dim As Integer		nSize = 0 
		if (GetResource(MAKEINTRESOURCE(IDRes) , sResourceType , pBuff, nSize)) Then
		 
			if (nSize > 0) Then
			 
				pBuff = new BYTE[nSize] 

				if (GetResource(MAKEINTRESOURCE(IDRes), sResourceType ,pBuff, nSize)) Then
				 
					if (LoadFromBuffer(pBuff, nSize)) Then
						bResult = true 
				   End If
            End If
				delete [] pBuff 
			End If
		End If
	End If
	return bResult 
End Function



  'Open FileName For Binary Access Read As #FileNo
  '  ReDim B(0 To LOF(FileNo) - 1)
  '  Get #FileNo, , B()
  '  Close #FileNo

Function CPicture.LoadFromFile(sFileName As String ) As BOOLEAN
 
 'OleLoadPictureFile(byval varFileName as VARIANT, byval lplpdisp
 
	Dim As boolean bResult = false 

	if (m_pPicture <> NULL) Then
		UnLoad() 
	End If
	
	
	if (m_pPicture = NULL) Then
	 
		Dim As Integer BSize
		Dim ff As Integer = FreeFile

		 Open sFileName For Binary Access Read As #ff 
		   BSize=LOF(ff)
		   Dim As Byte Ptr pBuff = new BYTE[LOF(ff)] 

			Get #ff,,pBuff[0],BSize 
		
		Close #ff	
		 
		If LoadFromBuffer(pBuff,BSize) Then
					bResult = true 
		End If
		
		Delete  pBuff 
	End If
	
			 
	return bResult 
End Function

Sub CPicture.UnLoad()
 	 If m_pPicture Then 
     	    m_pPicture->lpvtbl->Release(m_pPicture)
     	m_pPicture = NULL    
     EndIf
	 	  
End Sub

Function CPicture.Draw(pDC As HDC) As BOOLEAN
 
	if (m_pPicture <> NULL) Then
	 
		Dim As Long hmWidth 
		Dim As Long hmHeight 

     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
          	 
		Dim As Integer nWidth	= CHimetricToPixel_X(hmWidth) 
		Dim As Integer nHeight	= CHimetricToPixel_Y(hmHeight) 
		
		return Draw(pDC, 0, 0, nWidth, nHeight) 
	End If
	return false 
End Function

Function CPicture.Draw(pDC As HDC, Posi As  Point) As BOOLEAN
 
	if (m_pPicture <> NULL) Then
	 
		Dim As Long hmWidth 
		Dim As Long hmHeight 

     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
  
		Dim As Integer nWidth	= CHimetricToPixel_X(hmWidth) 
		Dim As Integer nHeight	= CHimetricToPixel_Y(hmHeight) 
		
		return Draw(pDC, Posi.x, Posi.y, nWidth, nHeight) 
	End If
	return false 
End Function

Function CPicture.Draw(pDC As HDC, Posi As  Point,oSize as Size ) As BOOLEAN
 
	if (m_pPicture <> NULL) Then
	 
		Dim As Long hmWidth 
		Dim As Long hmHeight 
     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
     	 
		Dim As Integer nWidth	= oSize.cx 
		Dim As Integer nHeight	= oSize.cy 
		
		return Draw(pDC, Posi.x, Posi.y, nWidth, nHeight) 
	End If
	return false 
End Function

Function CPicture.Draw(pDC As HDC,nSizeRatio As double ) As BOOLEAN
 
	if (m_pPicture <> NULL) Then
	 
		Dim As Long hmWidth 
		Dim As Long hmHeight 

     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
     
		Dim As Integer nWidth	=  CHimetricToPixel_X(hmWidth * nSizeRatio) 
		Dim As Integer nHeight	=  CHimetricToPixel_Y(hmHeight * nSizeRatio) 
		
		return Draw(pDC, 0, 0, nWidth, nHeight) 
	End If
	return false 
End Function

Function CPicture.Draw(pDC As HDC, Posi As Point ,nSizeRatio As double ) As BOOLEAN
 
	if (m_pPicture <> NULL) Then
	 
		Dim As Long hmWidth 
		Dim As Long hmHeight 

     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)

		Dim As Integer nWidth	=  CHimetricToPixel_X(hmWidth * nSizeRatio) 
		Dim As Integer nHeight	=  CHimetricToPixel_Y(hmHeight * nSizeRatio) 
		
		return Draw(pDC, Posi.x, Posi.y, nWidth, nHeight) 
	End If
	return false 
End Function

  Function	CPicture.Render(pDC As HDC, x As Integer, y As Integer, cx As Integer, cy As Integer) As BOOLEAN
  	  Return this.Draw(pDC, x, y, cx, cy)
  End Function


Function CPicture.Draw(pDC As HDC, x As Integer, y As Integer, cx As Integer, cy As Integer) As BOOLEAN
 	Dim As Long hmWidth 
	Dim As Long hmHeight 
     	     m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth) 
		     m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
		     
		      If (m_pPicture->lpvtbl->Render(m_pPicture,pDC, x, y, cx, cy, 0, hmHeight, hmWidth, -hmHeight, NULL) =  S_OK) Then
		         Return true 
            End If		     
    	
	return false 
End Function

Function CPicture.LoadFromBuffer(pBuff As Byte Ptr , nSize As Integer) As BOOLEAN
 
	Dim As boolean bResult = false 

	Dim As HGLOBAL hGlobal = GlobalAlloc(GMEM_MOVEABLE, nSize) 
	Dim As LPVOID pData = GlobalLock(hGlobal) 
	memcpy(pData, pBuff, nSize) 
	GlobalUnlock(hGlobal) 

	Dim As IStream ptr pStream = NULL 

	if (CreateStreamOnHGlobal(hGlobal, TRUE, @pStream)  = S_OK) Then
	 
		Dim As HRESULT hr 
		hr = OleLoadPicture(pStream, nSize, FALSE, @IID_IPicture, cast(LPVOID Ptr,@m_pPicture))
		if  ( hr= S_OK) Then
			bResult = true 
	   End If

     	    pStream->lpvtbl->Release(pStream)

	End If

	return bResult 
End Function




Function CPicture.GetResource(lpName As LPCTSTR ,lpType As LPCTSTR ,pResource As Any Ptr , ByRef nBufSize As Integer) As BOOLEAN
  
	Dim As HRSRC		hResInfo 
	Dim As ..HANDLE		hRes 
	Dim As HMODULE		hInst	= NULL  
	Dim As LPSTR		lpRes	= NULL 
	Dim As Integer		nLen	= 0 
	Dim As boolean		bResult	= FALSE 

	' Find the resource
	hResInfo = FindResource(hInst, lpName, lpType) 

	if (hResInfo =  NULL)  Then
		return false 
   End If
	' Load the resource
	hRes = LoadResource(hInst, hResInfo) 

	if (hRes =  NULL)  Then
		return false 
   End If
	' Lock the resource
	lpRes = cast(ZString Ptr,LockResource(hRes)) 

	if (lpRes <> NULL) Then
	 
		if (pResource =  NULL) Then
		 
			nBufSize = SizeofResource(hInst, hResInfo) 
		 	bResult = true 
		 
		else
		 
			if (nBufSize >= SizeofResource(hInst, hResInfo)) Then
			 
				memcpy(pResource, lpRes, nBufSize) 
				bResult = true 
			End If
		End If

		'UnlockResource(hRes)  
	End If

	' Free the resource
	FreeResource(hRes) 

	return bResult 
End Function

		


Property CPicture.type_() As Long
    if (m_pPicture <> NULL) Then
	 		Dim As Short typ 
     	    m_pPicture->lpvtbl->get_type(m_pPicture,@typ)
  	 	Return  typ
    End If	 	
  End Property

  Property CPicture.Width() As Long
     if (m_pPicture <> NULL) Then
	 		Dim As Long hmWidth 
     	      m_pPicture->lpvtbl->get_Width(m_pPicture,@hmWidth)
			Return  CHimetricToPixel_X(hmWidth) 'MulDiv(hmHeight,GetDeviceCaps(pDC,LOGPIXELSY), HIMETRIC_PER_INCH) 
	End If
  End Property
  
  Property CPicture.Height() As Long
      if (m_pPicture <> NULL) Then
	 		Dim As Long hmHeight 
     	      m_pPicture->lpvtbl->get_Height(m_pPicture,@hmHeight)
   		   Return CHimetricToPixel_X(hmHeight) 'MulDiv(hmWidth,	GetDeviceCaps(pDC,LOGPIXELSX), HIMETRIC_PER_INCH) 
      End If
  End Property
  
 
  

  
  Property CPicture.Handle() As LPVOID
      If (m_pPicture <> NULL) Then
	 		Dim As OLE_HANDLE picHandle 
     	    m_pPicture->lpvtbl->get_Handle(m_pPicture,@picHandle)
			Return Cast(..HANDLE,picHandle)
		End If	
  End Property
  
	Property CPicture.Attributes() As ULong
	   If (m_pPicture <> NULL) Then
	      Dim As ULong Picture_Attributes
     	    m_pPicture->lpvtbl->get_Attributes(m_pPicture,@Picture_Attributes)
     	  Return Picture_Attributes          
      End If   
	End Property
	
	
 Sub CPicture.save(ByVal FileName As String)  
 if (m_pPicture <> NULL) Then
     Dim As WString*256 wfilename=FileName
     OleSavePictureFile(Cast(LPDISPATCH,Cast(LPUNKNOWN,m_pPicture)), @wfilename)
 EndIf
 End Sub
 
 
  Function CPicture.CHimetricToPixel_X(ByVal nWidth As Long) As Long
	Dim hDCScreen As HDC , DPIX  As Long
	hDCScreen = GetDC(0)
	If hDCScreen <> 0 Then
    	DPIX = GetDeviceCaps(hDCScreen, LOGPIXELSX)
    	ReleaseDC 0, hDCScreen
	End If
   Return (nWidth * DPIX) / HIMETRIC_PER_INCH
End Function

  Function CPicture.CHimetricToPixel_Y(ByVal nHeight As Long) As Long
	Dim hDCScreen As HDC,DPIY  As Long
	hDCScreen = GetDC(0)
	If hDCScreen <> 0 Then
    	DPIY = GetDeviceCaps(hDCScreen, LOGPIXELSY)
    	ReleaseDC 0, hDCScreen
	End If
  	Return (nHeight * DPIY) / HIMETRIC_PER_INCH
End Function

  'Je constate que dans les deux As ci-dessous Delete n'est pas permis. mais pourtant dans l'implementation de CPicture.FromIPicture
  'On a utilisé New dans ce cas New n'est pas suivi de delete?
  
  'En fait les objets sont-t-ils libérés normalement? 
 
 /'
dim pic1 as Cpicture
dim ByRef pic2 as Cpicture =*Cast(Cpicture Ptr,NULL)
pic1.loadfromfile("C:\Users\Administrateur\Desktop\126_glyphspro\24x24\accounts.bmp")
print pic1.Width, pic1.height

@pic2=@(CPicture.FromIPicture(pic1))
print pic2.Width, pic2.height

' pic1 will be destroyed automatically

' for pic2 .
sleep

 Delete @(pic2)         
 
 '/
 
 
 dim pic1 as Cpicture
Dim pic2 as Cpicture  
pic1.loadfromfile("C:\Users\Administrateur\Desktop\126_glyphspro\24x24\accounts.bmp")
print pic1.Width, pic1.height

pic2=CPicture.FromIPicture(pic1)
print pic2.Width, pic2.height

' pic1 will be destroyed automatically

' for pic2 .
sleep

' Delete @(pic2)         
 
 	
 

I see that in the two Aces below Delete is not allowed. but yet in the implementation of CPicture.
We used New in this case New is not followed by delete?

In fact, are the objects released normally?

[fxm]

Correct the compiler errors:

Code: Select all

 Constructor CPicture(ByRef opic As Const CPicture)
      If m_pPicture Then
         #Ifdef __FB_COM_NO_VTBL__
            m_pPicture->Release()
         #Else
            m_pPicture->lpvtbl->Release(m_pPicture)
         #EndIf   
     EndIf
       m_pPicture=opic.m_pPicture
       If m_pPicture then m_pPicture->AddRef
 End Constructor

C:\Users\.....\FBIde0.4.6r4_fbc1.08.0\FBIDETEMP.bas(74) error 18: Element not defined, AddRef in 'If m_pPicture then m_pPicture->AddRef'

Code: Select all

Function  CPicture.FromHandle(ByVal oHandle As LPVOID, ByVal PicType As Short) As BOOLEAN
        UnLoad()
        m_pPicture=PictureFromHandle(oHandle,PicType)
        Return TRUE
End Function

C:\Users\.....\FBIde0.4.6r4_fbc1.08.0\FBIDETEMP.bas(116) error 42: Variable not declared, PictureFromHandle in 'm_pPicture=PictureFromHandle(oHandle,PicType)'

Code: Select all

Function CPicture.LoadFromFile(sFileName As String ) As BOOLEAN
 
 'OleLoadPictureFile(byval varFileName as VARIANT, byval lplpdisp
 
   Dim As boolean bResult = false

   if (m_pPicture <> NULL) Then
      UnLoad()
   End If
   
   
   if (m_pPicture = NULL) Then
   
      Dim As Integer BSize
      Dim ff As Integer = FreeFile

       Open sFileName For Binary Access Read As #ff
         BSize=LOF(ff)
         Dim As Byte Ptr pBuff = newBYTE[LOF(ff)]

         Get #ff,,pBuff[0],BSize
      
      Close #ff   
      
      If LoadFromBuffer(pBuff,BSize) Then
               bResult = true
      End If
      
      Delete  pBuff
   End If
   
         
   return bResult
End Function

C:\Users\.....\FBIde0.4.6r4_fbc1.08.0\FBIDETEMP.bas(205) error 42: Variable not declared, newBYTE in 'Dim As Byte Ptr pBuff = newBYTE'


For the last error:
C:\Users\.....\FBIde0.4.6r4_fbc1.08.0\FBIDETEMP.bas(521) error 24: Invalid data types, found ''' in 'delete @pic2 ' Is it necessary.'
I rather would code:

Code: Select all

 dim pic1 as Cpicture
pic1.loadfromfile("image.bmp")
print pic1.Width, pic1.height

dim byref as Cpicture pic2=Cpicture.fromIpicture(pic1)
print pic2.Width, pic2.height

' pic1 will be destroyed automatically

' for pic2 .
 delete @pic2 ' Is necessary (pic2 must be previously declared as a reference)

[aloberoger]

the code has already been modified

you need a .bmp file and adjust the path

[fxm]

- Without using the cloning functions ('Clone()' and 'FromIPicture()'), there is already a big problem in your code when you do a copy-construction:
Dim pic2 as Cpicture = pic1
or an assignment:
Dim pic2 as Cpicture
pic2 = pic1
because you get 2 different pointers ('pic1.m_pPicture' and 'pic2.m_pPicture') but which have the same value (both point to the same entity).
So this same entity will be released two times on the destructor call (by using the two different pointers but with the same value), therefore a bug.

- Now, by using the cloning function ('Clone()' or 'FromIPicture()', with NEW returning a reference), you can workaround this bug because you can choose to deallocate the memory (allocated with NEW) without calling the destructor on the reference:
Dim byref pic2 as Cpicture =CPicture.FromIPicture(pic1)
.....
''Delete @pic2 'call the destructor then deallocate memory
Deallocate @pic2 'deallocate memory without calling the destructor

[aloberoger]

have you tested with a specific case? for me it's ok
With :
Destructor CPicture()
Print "Destructor " & @This
UnLoad()
End Destructor

Dim pic1 as Cpicture
pic1.loadfromfile("C:\Users\Administrateur\Desktop\126_glyphspro\24x24\accounts.bmp")
'Dim pic2 as Cpicture = pic1

Dim pic2 as Cpicture
pic2 = pic1
print pic1.Width, pic1.height
print pic2.Width, pic2.height

Sleep




We see that the Destructor is called 2 times so 1 time for pic1 and another for pic2

remark: uses vtbl so Addref allows to dissociate two pointers

my question is simple New and delete go together, but in this specific case new is used in CPicture.FromIPicture
why is there a bug when we want to use Delete?

[fxm]

- But if you also visualize the entity address released by 'UnLoad()':
Destructor CPicture()
Print "Destructor " & @This, "UnLoad " & This.m_pPicture
UnLoad()
End Destructor
you should see that this same entity is released two times because 'pic2' is a raw copy of 'pic1' (inducing copy of pointer which is often bad practice).

- On the other hand if 'pic2' is defined only as a reference to 'pic1' (and not a copy):
Dim byref pic2 as Cpicture = pic1
then the entity is released only one time.

[aloberoger]

yes we can vizualize things with :

pic1.destructor
pic2.destructor

Sleep


in the end how to do with freebasic
gdiplus offers for example a clone function

[aloberoger]

I believe that the first example creates a copy with a new object, you should know that it is the same image. but it is normal that as long as a copy exists the storage memory area is not deleted.

but the first pic1 object is deleted except the area of ​​m_picture.

What are the other languages ​​doing in this specific case?

[aloberoger]

I believe the Constructor (As ipicture Ptr) as well as Operator Let were missing: If m_pPicture then m_pPicture-> lpvtbl-> AddRef (m_pPicture)
but it seems to me that because of the reference even if Delete is not used the memory is erased?

now:
dim pic1 as Cpicture
Dim ByRef pic2 as Cpicture =*Cast(Cpicture Ptr,NULL)
pic1.loadfromfile("C:\Users\Administrateur\Desktop\126_glyphspro\24x24\accounts.bmp")

print pic1.Width, pic1.height

@pic2=@(CPicture.FromIPicture(Cast(IPICTURE Ptr,pic1)))

print pic2.Width, pic2.height

pic1.destructor
'pic2.destructor ' bon mais on a utilisé new donc il faut delete

Delete @pic2 ' mieux If pic2 Then Delete @pic2

[fxm]

by using the cloning function ('Clone()' or 'FromIPicture()', with NEW returning a reference), you can workaround this bug because you can choose to deallocate the memory (allocated with NEW) without calling the destructor on the reference:
Dim byref pic2 as Cpicture =CPicture.FromIPicture(pic1)
.....
''Delete @pic2 'call the destructor then deallocate memory
Deallocate @pic2 'deallocate memory without calling the destructor

otherwise (with 'Delete @pic2'), 'Release()' is called two times on the same pointer value.

[aloberoger]

I said with this in constructor and operator

Code: Select all

If m_pPicture then m_pPicture-> lpvtbl-> AddRef (m_pPicture)

we can use delete see my last post

but it seems to me that because of the reference even if Delete is not used the memory is erased?
what do you thing?

[fxm]

- With 'Delete @pic2', I get a runtime error message:
Aborting due to runtime error 12 ("segmentation violation" signal) in C:\Users\.....\FBIde0.4.6r4_fbc1.08.0\FBIDETEMP.bas::UNLOAD()

- With 'Deallocate @pic2' instead, no runtime error message.

- To easily visualize the runtime error message, put the main code inside a scope block as follows:

Code: Select all

scope 

dim pic1 as Cpicture
Dim ByRef pic2 as Cpicture =*Cast(Cpicture Ptr,NULL)
pic1.loadfromfile("C:\Users\Administrateur\Desktop\126_glyphspro\24x24\accounts.bmp")

print pic1.Width, pic1.height

@pic2=@(CPicture.FromIPicture(Cast(IPICTURE Ptr,pic1)))

print pic2.Width, pic2.height

Delete @pic2
'Deallocate @pic2

end scope

sleep

• (for my own test, I use 'fblogo.bmp')

[Josep Roca]

To clone an IPicture object you have to:

1.- As IPicture supports the IPersistStream interface, get a pointer to it with QueryInterface.

1.- Create an Stream in memory.

3.- Save the contents in the Stream using the Save method of the IPersistStream interface.

4. Create a new IPicture object with the contents of the Stream.