udt example and function?

[Frank Brübach]

hello. does anybody can check this code and fix or update script to pb 9.1 ? Would be very nice!

"The usage of ReallocString can be simplified using a wrapper function.."

Code Select Expand

#COMPILE EXE
#DIM ALL
#INCLUDE "WIN32API.INC"

FUNCTION B2A_ (BYVAL pbstr AS DWORD) AS STRING
  LOCAL bstrlen AS LONG
  IF pbstr = %NULL THEN EXIT FUNCTION
  bstrlen = SysStringByteLen(BYVAL pbstr)
  IF bstrlen THEN FUNCTION = ACODE$(PEEK$(pbstr, bstrlen))
END FUNCTION

FUNCTION BSTR_ (BYVAL s AS STRING) AS DWORD
  s = UCODE$(s)
  FUNCTION = SysAllocString(BYVAL STRPTR(s))
END FUNCTION

DECLARE SUB VariantInit LIB "OLEAUT32.DLL" ALIAS "VariantInit" (BYREF pvarg AS ANY)
DECLARE FUNCTION VariantClear LIB "OLEAUT32.DLL" ALIAS "VariantClear" (BYREF pvarg AS ANY) AS LONG

TYPE MyUDT
  p1 AS LONG
  p2 AS DWORD
  v  AS VARIANTAPI
END TYPE

FUNCTION PBMAIN () AS LONG

  LOCAL hr AS LONG
  LOCAL t AS MyUDT
  LOCAL p AS DWORD

  ' Initialize the variant structure
  VariantInit t.v
  t.v.vt = %VT_BSTR

  ' Allocate a string in the variant
  t.v.vd.bstrVal = BSTR_("My test string")
  ' Display the string
  MSGBOX B2A_(t.v.vd.bstrVal)

  ' Change the contents of the string
  p = BSTR_("My new string")
  hr = SysReallocString(t.v.vd.bstrVal, BYVAL p)
  SysFreeString p
  ' Display the changed string
  MSGBOX B2A_(t.v.vd.bstrVal)

  ' Clear the variant structure
  hr = VariantClear(t.v)
  IF hr = %S_OK THEN t.v.vd.bstrVal = %NULL

END FUNCTION

thanks in advance.

one more question:
it's allowed / useful to include a function in an udt ? no joke, I have seen such thing in freebasic example.

e.g.

Code Select Expand

TYPE MyUDT
  p1 AS LONG
  p2 AS DWORD
  v  AS VARIANTAPI
  xmen as myfunction() as Long '- this one ???
END TYPE

dim hulk as myUDT




best regards, freezing Frank

[José Roca]

does anybody can check this code and fix or update script to pb 9.1 ?

The only thing that looks wrong is SysFreeString p. If you free it this way, the variant will hold an invalid pointer. The string will be freed by VariantClear.

it's allowed / useful to include a function in an udt ?

Not with that syntax. You can get a pointer to the function with CODEPTR, store it in the UDT and later call it using CALL DWORD.

[Frank Brübach]

no, there must be more

this error message e.g. I got too: "variantapi is unknown type"

and there are some more errors included.

bye, frank

[José Roca]

 
Which include files are you using? As you have used #INCLUDE "win32api.inc" and cut and pasted some of my functions, I thought you were using the ones provided with the compiler. If you are using mine, then use:

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE "ole2utils.inc"

TYPE MyUDT
   p1 AS LONG
   p2 AS DWORD
   v  AS tagVARIANT
END TYPE

FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL t AS MyUDT

   ' Initialize the variant structure
   VariantInit t.v
   t.v.vt = %VT_BSTR

   ' Allocate a string in the variant
   t.v.bstrVal = BSTR_("My test string")
   ' Display the string
   MSGBOX B2A_(t.v.bstrVal)

   ' Change the contents of the string
   hr = SysReallocString(t.v.bstrVal, BYVAL BSTR_("My new string"))
   ' Display the changed string
   MSGBOX B2A_(t.v.bstrVal)

   ' Clear the variant structure
   hr = VariantClear(t.v)
   IF hr = %S_OK THEN t.v.bstrVal = %NULL

END FUNCTION


I use tagVARIANT instead of PB's VARIANTAPI because VARIANTAPI is incomplete and outdated, forcing you to use an unneeded .vd. for the union (e.g. t.v.vd.bstrVal) instead of the more straight t.v.bstrVal. This is because old versions of the compiler did not support anonymous unions.

[Frank Brübach]

hi all. hello josé.

it seems I have understood this example thank you for your script!
I have used an old pb udt example from this board indeed with win32api and oleout32.dll. not your include file. it's a better way for working. thanks! I will check other udt scripts at this board too.

my new example:

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE "ole2utils.inc"

TYPE MyUDT
  p1 AS LONG
  p2 AS DWORD
  a  AS INTEGER
  v  AS tagVARIANT
  z  AS DWORD
  r  AS tagVariant
  'findStart() as CODEPTR  '-- DECLARE SUB findStart CDECL ()
END TYPE

SUB findStart(BYVAL a AS LONG,BYVAL b1 AS DWORD, BYVAL po AS INTEGER )
   a = 100
   b1 = 3
   po = 2500
END SUB


SUB myMonsters(BYVAL b AS INTEGER)
   DIM a AS INTEGER
   a = 100
   b = 2000
   MSGBOX "here some words..:", a+b
END SUB


FUNCTION PBMAIN () AS LONG

  LOCAL hr AS LONG
  LOCAL t AS MyUDT
  LOCAL fb AS MyUDT

  LOCAL MySubPtr AS LONG
  LOCAL X AS STRING

  MySubPtr = CODEPTR(findstart) ' Address of findstart()

  x = "findstart() is located at address " + FORMAT$(MySubPtr)
  MSGBOX x

  ' Initialize the variant structure
  VariantInit t.v
  t.v.vt = %VT_BSTR

  VariantInit fb.v
  fb.v.vt = %VT_BSTR

  VariantInit fb.r
  fb.r.vt = %VT_BSTR

  ' Allocate a string in the variant
  t.v.bstrVal = BSTR_("My sunshine string " + STR$(t.v.bstrVal) )
  ' Display the string
  MSGBOX B2A_(t.v.bstrVal)

  ' Allocate a string in the variant
  fb.v.bstrVal = BSTR_("My beloved heart string")
  ' Display the string
  MSGBOX B2A_(fb.v.bstrVal)

  ' Allocate a string in the variant
  fb.r.bstrVal = BSTR_("My hard rock string")
  ' Display the string
  MSGBOX B2A_(fb.r.bstrVal)


  ' Change the contents of the string
  hr = SysReallocString(t.v.bstrVal, BYVAL BSTR_("My batman string"))
  ' Display the changed string
  MSGBOX B2A_(t.v.bstrVal)

  ' Clear the variant structure
  hr = VariantClear(t.v)
  IF hr = %S_OK THEN t.v.bstrVal = %NULL

END FUNCTION

myself:

it's allowed / useful to include a function in an udt ?

...
you:

Not with that syntax. You can get a pointer to the function with CODEPTR, store it in the UDT and later call it using CALL DWORD.

can you show my an example how to store it into my udt-example and call it by using with Call DWORD ? Never seen it before if that's possible   Should I store it as sub or directly as function ?

Code Select Expand

TYPE MyUDT
  p1 AS LONG
  p2 AS DWORD
  a  AS INTEGER
  v  AS tagVARIANT
  z  AS DWORD
  r  AS tagVariant
  'findStart() as CODEPTR  '-- DECLARE SUB findStart CDECL ()
END TYPE



best regards, frank

[José Roca]

can you show my an example how to store it into my udt-example and call it by using with Call DWORD ?

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE "ole2utils.inc"

TYPE MyUDT
   p1 AS LONG
   p2 AS DWORD
   a  AS INTEGER
   v  AS tagVARIANT
   z  AS DWORD
   r  AS tagVariant
   MySubPtr AS DWORD
   MyFuncPtr AS DWORD
END TYPE

SUB MySub(BYVAL a AS LONG)

   MSGBOX "MySub called with CALL DWORD"

END SUB

FUNCTION MyFunc(BYVAL x AS LONG) AS LONG

   FUNCTION = x * 2

END FUNCTION

FUNCTION PBMAIN

   DIM t AS MyUDT
   DIM r AS LONG

   ' // Store the adresses of the procedures in the UDT
   t.MySubPtr = CODEPTR(MySub)
   t.MyFuncPtr = CODEPTR(MyFunc)
   
   ' // Call the sub
   CALL DWORD t.MySubPtr USING MySub(1)

   ' // Call the function
   CALL DWORD t.MyFuncPtr USING MyFunc(2) TO r
   MSGBOX "Result of the function = " & FORMAT$(r)

END FUNCTION


[Frank Brübach]

thanks!

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE "ole2utils.inc"

TYPE MyUDT
   p1 AS LONG
   p2 AS DWORD
   a  AS INTEGER
   v  AS tagVARIANT
   z  AS DWORD
   r  AS tagVariant
   p  AS tagVariant
   MySubPtr AS DWORD
   myFibonacciPtr AS DWORD
   startBlockPTR AS DWORD
END TYPE

SUB MySub(BYVAL a AS LONG)
   a = 2009*365 + MSGBOX ("hello dear october! " + DATE$)
   MSGBOX "MySub called with CALL DWORD:" + STR$(a), %MB_OK, " good night UDT friends ! "
END SUB

FUNCTION myFibonacci( BYVAL n AS INTEGER ) AS INTEGER
   n = ( 1/SQR(5) ) * ( ( (1+SQR(5))/2)^n-( (1-SQR(5))/2)^n )
   FUNCTION = n
END FUNCTION

FUNCTION startBlock(BYVAL k AS LONG) AS LONG
   k = 180*3.14159
   FUNCTION = k+12*SIN(gettickcount*128/100)*255
   MSGBOX "nobody will save this blue planet at the end: " + STR$(k),%MB_ICONINFORMATION, "udt nightcrawler :) !"
END FUNCTION


FUNCTION PBMAIN

   DIM t AS MyUDT
   DIM r AS LONG
   DIM v AS MyUDT
   DIM p AS LONG
   
   ' // Store the adresses of the procedures in the UDT
   t.MySubPtr = CODEPTR(MySub)
   t.myFibonacciPtr = CODEPTR(myFibonacci)
   v.startBlockPTR = CODEPTR(startBlock)
   ' // Call the sub
   CALL DWORD t.MySubPtr USING MySub(3)
   MSGBOX "go early to bed! " & FORMAT$(p)
     
   ' // Call the function
   CALL DWORD t.MyFibonacciPtr USING MyFibonacci(2) TO r
   MSGBOX "Result of the fibonacci function = " & FORMAT$(r)

' // Call the function
   CALL DWORD v.startBlockPtr USING startblock(4) TO p
   MSGBOX "next result of exciting function = " & FORMAT$(p)

END FUNCTION


[Frank Brübach]

hello and good afternoon

I thought I have done everything right here, but a very little thing is missing or I forget a serious part of pb code. the mistake belongs to line 17 with "LionsOut += MyLionMatrix(Counter,1)..."

I want to have five rows with á five number (1-5) per row until number 25 (5x5). somebody can help me?

my example:

Code Select Expand


#COMPILE EXE
#DIM ALL

FUNCTION PBMAIN () AS LONG

DIM MyLionMatrix(5, 5) AS LONG
DIM MyArray(25) AS LONG AT VARPTR(MyLionMatrix(1,1))
MSGBOX "hey lionMatrix!"

DIM Counter AS LONG
FOR Counter = 1 TO UBOUND(MyArray)
 MyArray(Counter) = Counter
NEXT

DIM LionsOut AS STRING
FOR Counter = 1 TO UBOUND(MyLionMatrix(5))
 LionsOut += MyLionMatrix(Counter,1) & $TAB & MyLionMatrix(Counter,2) & $TAB & MyLionMatrix(Counter,3) & $TAB & MyLionMatrix(Counter,4) & $TAB & MyLionMatrix(Counter,5) & $CRLF
NEXT
MSGBOX "all ok with five rows á 1-5 until number 25 ?", LionsOut
   
END FUNCTION


because this example belongs to the udt example for a further working example I place it here. I will try to solve the problem this afternoon

nice day to all here, frank

[José Roca]

 
In Basic, when you only use a number to dimension an array, it doesn't specify the number of elements, but the upper bound of the array. Therefore, with DIM MyLionMatrix(5, 5) AS LONG you are dimensioning an array of 36 elements, i.e. it is equivalent to DIM MyLionMatrix(0 TO 5, 0 TO 5) AS LONG. Either use DIM MyLionMatrix(4, 4) AS LONG, and later FOR Counter = 0 TO UBOUND(MyArray) - 1, or use DIM MyLionMatrix(1 TO 5, 1 TO 5) AS LONG if you want a lower bound of 1.

[Frank Brübach]

it's a pity. no success

Either use DIM MyLionMatrix(4, 4) AS LONG, and later FOR Counter = 0 TO UBOUND(MyArray) - 1

yes, I can follow your explanations.

same place, same error. original I wanted to make a "string" output with (here!) 4x4 rows (does it mean: 16 elements multiply with 4 bytes each so 64 bytes) showing dialogue box with numbers from 1 to 16.
- I have changed for example dimension into "DIM LionsOut AS  LONG" (formerly STRING!), I come until script end but without any wished result. no chance to see the matrix 4x4 (in my last post I have tried a 5x5 array). strange. I send the error message script with Line 18.

Code Select Expand

#COMPILE EXE
#DIM ALL

FUNCTION PBMAIN () AS LONG

DIM MyLionMatrix(4, 4) AS LONG
DIM s AS STRING
DIM MyArray(16) AS LONG AT VARPTR(MyLionMatrix(1,1)) '
MSGBOX "hey lionMatrix!"

DIM Counter AS LONG
FOR Counter = 0 TO UBOUND(MyArray) -1
 MyArray(Counter) = Counter
NEXT

DIM LionsOut AS STRING ' LONG
FOR Counter = 0 TO UBOUND(MyLionMatrix(4))
   LionsOut += MyLionMatrix(Counter,1) '+ $TAB & MyLionMatrix(Counter,2) + $TAB & MyLionMatrix(Counter,3) + $TAB & MyLionMatrix(Counter,4) '& $CRLF
   MSGBOX "all ok with five rows á 1-5 until 25 ?", LionsOut + %MB_ICONINFORMATION, "matrix ok test! "
NEXT

END FUNCTION


the correct way will be to use DIM LionsOut AS STRING and print 4x4 matrix with 16 numbers you can see. nothing happened here. I have tried several ways, you can imagine

best regards again, Frank

[José Roca]

 
Numbers don't convert to string automatically: you have to use STR$ or FORMAT$.

What I have said about the dimensions of an array also applies to DIM MyArray(16) AS LONG AT VARPTR(MyLionMatrix(1,1)), that should be DIM MyArray(24) AS LONG AT VARPTR(MyLionMatrix(0,0)) if you use a zero-based array.

I have modified the program, using one-based arrays to avoid confusions:

Code Select Expand


#COMPILE EXE
#DIM ALL

FUNCTION PBMAIN () AS LONG

DIM MyLionMatrix(1 TO 5, 1 TO 5) AS LONG
DIM s AS STRING
DIM MyArray(1 TO 25) AS LONG AT VARPTR(MyLionMatrix(1,1)) '
MSGBOX "hey lionMatrix!"

DIM Counter AS LONG
FOR Counter = 1 TO UBOUND(MyArray)
  MyArray(Counter) = Counter
NEXT

DIM LionsOut AS STRING ' LONG
FOR Counter = 1 TO 5
    LionsOut += FORMAT$(MyLionMatrix(Counter,1)) & $TAB & FORMAT$(MyLionMatrix(Counter,2)) & $TAB & FORMAT$(MyLionMatrix(Counter,3)) & $TAB & FORMAT$(MyLionMatrix(Counter,4)) & $CRLF
    MSGBOX LionsOut, %MB_ICONINFORMATION, "matrix ok test! "
NEXT

END FUNCTION


[Frank Brübach]

hi jose, thank you for this example. this and a lot of other little examples shows how to work with powerbasic. I am used to start programming closer one year ago with thinbasic and there are some fine differences in syntax and command handling between tb and pb, but I am glad to see there are no big difference in general. very good.

Code Select Expand


#COMPILE EXE
#DIM ALL

FUNCTION PBMAIN () AS LONG

DIM MyLionMatrix(1 TO 8, 1 TO 8) AS LONG
DIM s AS STRING
DIM MyArray(1 TO 64) AS LONG AT VARPTR(MyLionMatrix(1,1)) '
MSGBOX "hey lionMatrix!"

DIM Counter AS LONG
FOR Counter = 1 TO UBOUND(MyArray)
 MyArray(Counter) = Counter
NEXT

DIM LionsOut AS STRING
FOR Counter = 1 TO 8
   LionsOut += FORMAT$(MyLionMatrix(Counter,1)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,2)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,3)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,4)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,5)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,6)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,7)) _
   & $TAB & FORMAT$(MyLionMatrix(Counter,8)) _
   & $CRLF
   MSGBOX LionsOut, %MB_ICONINFORMATION, "matrix ok test! "
NEXT

END FUNCTION

new for me was :

DIM MyArray(24) AS LONG AT VARPTR(MyLionMatrix(0,0))

DIM MyLionMatrix(1 TO 5, 1 TO 5) AS LONG ' 1 to 5, 1 to 5

str$ and format$ I know already from speed tests and some other examples

thanks! I have saved this example in my head. *laugh*

servus, frank

[José Roca]

 
DIM MyLionMatrix(1 TO 8, 0 TO 8) AS LONG must be DIM MyLionMatrix(1 TO 8, 1 TO 8) AS LONG

With the first declaration you aren't getting a 64-element array, but a 72-element array: 1 TO 8 = 8 elements, 0 TO 8 = 9 elements, 8 x 9 = 72 elements.

[Frank Brübach]

yes, of course. I have tried to use in another example

DIM MyLionMatrix(0 TO 8, 0 TO AS LONG

and

"FOR Counter = 0 TO UBOUND(MyArray)"

to look at the results. I have simply copied to fast and typed wrong numbers

thanks. frank
ps: test for your browser: try to type in here with quote:

DIM MyLionMatrix(0 TO 8, 0 TO

'- last 8 is cool ! and doesn't appear here
this may be a BUG ?

[José Roca]

 
8) is interpreted as an UUB code and translated as such. If you want it to appear correctly, click "Additional options" (below the editing box) and check the option "Don't use smileys", as I have done.