Re: Classes with dynamic properties

: Also I want that some
: other code might add any kinds of properties it needs for any kind of
: entity like a point or some shape (consisting of points). The
: properties shall be displayable in the current view if the user wishes
: to see them.

...I'm not sure if HashMap is the best for this purpose...

Does the HashMap() write data to a file? How does the app recall new
properties added dynamically during prior run?

The VB code below use a lightweight db to dynamically create/modify/
delete/query persons with different attributes. During the 1st run, it
creates john and mary, each with gender attributes. During the 2nd
run, it creates bob with gender and age attributes. It also adds age
attribute to existing john. During 3rd run, it adds the attribute body-
build-type to john, mary and bob. During the 4th run, it creates sue
with all attributes using low-level functions. It also modifies john's
age and deletes one of mary's build attribute values. At the end of
each run, it prints the persons, attributes and their values stored in
db.

Private Sub Form_Load()
Const kDbSzDef_g = 256000
Dim errCode&

Db_init
errCode& = Db_FileSpec_set_r("Db1.dbd")
If (False = Db_File_exists_b) Then
'* This code is executed during 1st run *********************

'Create db file
errCode = Db_File_create_r(kDbSzDef_g)

'Open db file
errCode = Db_File_open_r()

'Create gender
Xp_process_r ("(new 'gender)")

'Create a person named john and set his gender to male
Xp_process_r ("(new 'john 'person)")
Xp_process_r ("(set+ john gender 'male)")

'Create a person named mary and set her gender to female
Xp_process_r ("(new 'mary 'person)")
Xp_process_r ("(set+ mary gender 'female)")
Else
'Open db file
errCode = Db_File_open_r()

'If bob is missing in db
Dim pBob&: pBob& = AStr_getDefN("bob")
If (0 = pBob) Then
'* This is code is executed during 2nd run **************

'Create age,
Xp_process_r ("(new 'age)")

'Create a person named bob
'Set his gender to male and age to 35
Xp_process_r ("(new 'bob 'person)")
Xp_process_r ("(set+ bob gender 'male)")
Xp_process_r ("(set+ bob age '35)")

'Set john's age to 30
Xp_process_r ("(set+ john age '30)")

'Get all person that are male
'Following prints john and bob
Dim pQry&
pQry& = Xp_compile("(and (get person instance *) (get *
gender male))")
Dim pPersonX&: pPersonX& = Xp_execute(pQry&)
Do While (pPersonX&)
Const strSz = 255
Dim sName$: sName$ = Space(strSz)
Call N_Name_get(pPersonX&, sName$, strSz, False, False,
False, 0, 0)
sName$ = Truncate$(sName$)
Debug.Print sName

pPersonX& = Xp_execute(pQry&)
Loop
Else
Dim pBuild&: pBuild& = AStr_getDefN&("build")
If (0 = pBuild) Then
'* This is code is executed during 3nd run ***************

'Create body build
Xp_process_r ("(new 'build)")

'Set bob's build to tall
Xp_process_r ("(set+ bob build 'tall)")

'Set mary's build to thin and petite
Xp_process_r ("(set+ mary build 'thin)")
Xp_process_r ("(set+ mary build 'petite)")
Else
Dim pSue&: pSue& = AStr_getDefN("sue")
If (0 = pSue) Then
'* This is code is executed during 4th run *************
'It uses low-level methods

'Create a person named sue
pSue& = N_create(0, 0)
Dim pPerson&: pPerson& = AStr_getDefN("person")
Dim pInst_g&: pInst_g& = AStr_getDefN("instance")
Call N_SVO_set(pPerson&, pInst_g&, pSue&)
Dim pStrSue&: pStrSue& = AStr_getStr("sue", True)
Dim pName_g&: pName_g& = AStr_getDefN("name")
Call N_SVO_set(pSue&, pName_g&, pStrSue&)

'Set sue's gender to female
Dim pGender&: pGender& = AStr_getDefN("gender")
Dim pFemale&: pFemale& = AStr_getDefN("female")
Call N_SVO_set(pSue&, pGender&, pFemale&)

'Set sue's age to 21
Dim pAge&: pAge& = AStr_getDefN("age")
Dim pStr21&: pStr21& = AStr_getStr("21", True)
Dim pAge21&: pAge21& = N_ClsInst_get(pAge&, pStr21&,
True)
Call N_SVO_set(pSue&, pAge&, pAge21&)

'Set sue's build to fat and short
Call N_EA_setV_wStr(pSue&, pBuild&, "fat", False)
Call N_EA_setV_wStr(pSue&, pBuild&, "short", False)

'Change john's age from 30 to 40
Dim pJohn&: pJohn& = AStr_getDefN("john")
Dim pStr30&: pStr30& = AStr_getStr("30", True)
Dim pAge30&: pAge30& = N_ClsInst_get(pAge&, pStr30&,
True)
Dim pStr40&: pStr40& = AStr_getStr("40", True)
Dim pAge40&: pAge40& = N_ClsInst_get(pAge&, pStr40&,
True)
Call N_SV_changeO(pJohn&, pAge&, pAge30&, pAge40&)

'Delete mary's build is thin
Dim pMary&: pMary& = AStr_getDefN("mary")
Dim pThin&: pThin& = AStr_getDefN("thin")
Dim pSVO&: pSVO& = N_SVO_get(pMary&, pBuild&, pThin&,
1)
N_delete (pSVO&)
End If
End If
End If
End If


'* This is code is executed during all runs *
'Print each person's attributes and values

'During 1st run, prints:
' john gender male
' mary gender female

'During 2nd run, prints:
' john gender male
' john age 30
' mary gender female
' bob gender male
' bob age 35

'During 3rd run, prints:
' john gender male
' john age 30
' mary gender female
' mary build thin
' mary build petite
' bob gender male
' bob age 35
' bob build tall

'During 4th run, prints:
' john gender male
' john age 40
' mary gender female
' mary build petite
' bob gender male
' bob age 35
' bob build tall
' sue gender female
' sue age 21
' sue build fat
' sue build short

pName_g& = AStr_getDefN("name")
pQry& = Xp_compile("(get person instance *)")
Dim pPtX&: pPtX& = Xp_execute(pQry&)
Do While (pPtX&)
Dim pA&(256)
Dim p&: p& = VarPtr(pA(0))
Dim eS&: eS& = Xp_Node(pPtX, p&)
Dim eSVO&: eSVO& = Xp_S_getSVO(eS, p&)
pSVO& = Xp_execute(eSVO&)
Do While (pSVO&)
Dim pSub&: pSub& = N_SVO_getElem(pSVO&, 0)
Dim pVb&: pVb& = N_SVO_getElem(pSVO&, 1)
Dim pObj&: pObj& = N_SVO_getElem(pSVO&, 2)
If (pVb& <> pName_g&) Then
'Print "person attribute value"
Dim sEntity$: sEntity$ = Space$(strSz)
Call N_Name_get(pSub, sEntity$, strSz, False, False,
False, 0, 0)
sEntity$ = Truncate$(sEntity$)

Dim sProp$: sProp$ = Space$(strSz)
Call N_Name_get(pVb&, sProp$, strSz, False, False, False,
0, 0)
sProp$ = Truncate$(sProp$)

Dim sVal$: sVal$ = Space$(strSz)
Call N_Name_get(pObj&, sVal$, strSz, False, False, False,
0, 0)
sVal$ = Truncate$(sVal$)

Debug.Print sEntity$, sProp, sVal
End If

pSVO = Xp_execute(eSVO)

Loop

pPtX& = Xp_execute(pQry&)
Loop


Db_File_save
Db_File_close_r (0)

End Sub

For more details, see www.dbfordummies.com/Dev/VB/InstallTestDLL.asp

.

Relevant Pages