Byref in return function

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
aloberoger
Posts: 495
Joined: Jan 13, 2009 19:23

Byref in return function

Postby aloberoger » Aug 10, 2020 9:14

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
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 10, 2020 16:09

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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 10, 2020 22:28

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?
Last edited by aloberoger on Aug 11, 2020 7:04, edited 2 times in total.
fxm
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 11, 2020 5:02

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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 11, 2020 7:06

the code has already been modified

you need a .bmp file and adjust the path
fxm
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 11, 2020 9:05

- 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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 11, 2020 12:29

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
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 11, 2020 13:35

- 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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 11, 2020 14:23

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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 11, 2020 14:30

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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 11, 2020 15:07

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
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 11, 2020 15:43

fxm wrote: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
Posts: 495
Joined: Jan 13, 2009 19:23

Re: Byref in return function

Postby aloberoger » Aug 12, 2020 18:13

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
Posts: 9983
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Byref in return function

Postby fxm » Aug 12, 2020 18:35

- 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
Posts: 501
Joined: Sep 27, 2016 18:20
Location: Valencia, Spain

Re: Byref in return function

Postby Josep Roca » Aug 12, 2020 19:08

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.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 4 guests