Je ne dois pas avoir les yeux en face des trous. Je n'ai pas trouvé l'exemple ObjectManagement du SDK.
■ Voila un source qui permet de créer un objet et de l'initialiser avec un string. Une seconde fonction permet d'extraire le string de cet objet.
- CreateObject(Object, String.s) Création de l'objet.
- GetObjectString(Object) Retourne le string de l'objet.
Ce code génère effectivement des erreurs
POLINK si je l’exécute sans le débogueur.
Code : Tout sélectionner
Import ""
Object_GetOrAllocateID (Objects, Object.l) As "_PB_Object_GetOrAllocateID@8"
Object_GetObject (Objects, Object.l) As "_PB_Object_GetObject@8"
Object_IsObject (Objects, Object.l) As "_PB_Object_IsObject@8"
Object_EnumerateAll (Objects, ObjectEnumerateAllCallback, *VoidData) As "_PB_Object_EnumerateAll@12"
Object_EnumerateStart (Objects) As "_PB_Object_EnumerateStart@4"
Object_EnumerateNext (Objects, *object.Long) As "_PB_Object_EnumerateNext@8"
Object_EnumerateAbort (Objects) As "_PB_Object_EnumerateAbort@4"
Object_FreeID (Objects, Object.l) As "_PB_Object_FreeID@8"
Object_Init (StructureSize.l, IncrementStep.l, ObjectFreeFunction) As "_PB_Object_Init@12"
Object_GetThreadMemory (MemoryID.l) As "_PB_Object_GetThreadMemory@4"
Object_InitThreadMemory(Size.l, InitFunction, EndFunction) As "_PB_Object_InitThreadMemory@12"
EndImport
Structure sObject
Object.l
string.s
EndStructure
Procedure FreeObject(Object.l)
Shared gObject.l
If Object<>#PB_Any And Object_IsObject(gObject, Object)
Protected *object.sObject = Object_GetObject(gObject, Object)
If *object
Debug "PB_Object " + Str(Object) + " détruit"
Object_FreeID(gObject, Object)
ProcedureReturn #True
EndIf
EndIf
EndProcedure
Procedure CreateObject(Object, String.s)
Shared gObject.l
Protected *object.sObject
If Object And string
If Not gObject
gObject = Object_Init(SizeOf(sObject), 1, @FreeObject())
EndIf
*object = Object_GetOrAllocateID(gObject, Object)
If *object
*object\Object = Object
*object\string = string
ProcedureReturn *object
EndIf
EndIf
EndProcedure
Procedure.s GetObjectString(Object)
Shared gObject.l
Protected *object.sObject = Object_GetObject(gObject, Object)
If *object
ProcedureReturn *object\string
EndIf
EndProcedure
CreateObject(1, "Premier test")
Debug GetObjectString(1)
Result = CreateObject(#PB_Any, "Deuxiéme test")
Debug GetObjectString(Result)
;Destruction des objets
FreeObject(1)
FreeObject(Result)
Par contre il fonctionne parfaitement avec le débogueur.
■ J'ai vu sur le forum que ce problème pouvait être contourner de cette manière.
C'est étrange mais ça fonctionne. Peut être que Fred pourra en dire un peu plus.
J'ai donc modifié la procédure FreeObject(Object.l) de cette manière.
Code : Tout sélectionner
Procedure FreeObject(Object.l)
Shared gObject.l
If Object<>#PB_Any And Object_IsObject(gObject, Object)
Protected *object.sObject = Object_GetObject(gObject, Object)
If *object
Debug "PB_Object " + Str(Object) + " destroyed"
Object_FreeID(gObject, Object)
ProcedureReturn #True
EndIf
EndIf
;Solution de contournement
If IsWindow(#PB_Any)
EndIf
EndProcedure
Avec ou sans débogueur, le code fonctionne.