Theo's Forum

General Category => General Discussion => Topic started by: Frank Brübach on October 12, 2009, 03:47:15 PM

Title: udt example and function?
Post by: Frank Brübach on October 12, 2009, 03:47:15 PM

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]

#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]

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

Title: Re: udt example and function?
Post by: José Roca on October 12, 2009, 04:12:42 PM

Quote

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.

Quote

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.

Title: Re: udt example and function?
Post by: Frank Brübach on October 12, 2009, 04:45:26 PM

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

Title: Re: udt example and function?
Post by: José Roca on October 12, 2009, 04:58:45 PM

 
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]

#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.

Title: Re: udt example and function?
Post by: Frank Brübach on October 12, 2009, 10:55:40 PM

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]

#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:

Quote

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

...
you:

Quote

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]

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

Title: Re: udt example and function?
Post by: José Roca on October 12, 2009, 11:52:28 PM

Quote

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

Code: [Select]

#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


Title: Re: udt example and function?
Post by: Frank Brübach on October 13, 2009, 12:53:51 AM

:) thanks!

Code: [Select]

#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


Title: Re: udt example and function? + array question
Post by: Frank Brübach on October 13, 2009, 03:26:50 PM

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]

#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

Title: Re: udt example and function?
Post by: José Roca on October 13, 2009, 03:54:09 PM

 
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.

Title: Re: udt example and function?
Post by: Frank Brübach on October 13, 2009, 04:42:24 PM

it's a pity. no success :(

Quote

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]

#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

Title: Re: udt example and function?
Post by: José Roca on October 13, 2009, 05:32:39 PM

 
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]

#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


Title: Re: udt example and function?
Post by: Frank Brübach on October 13, 2009, 07:07:38 PM

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]

#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 :

Quote

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

Quote

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

Title: Re: udt example and function?
Post by: José Roca on October 13, 2009, 07:24:33 PM

 
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.

Title: Re: udt example and function?
Post by: Frank Brübach on October 13, 2009, 07:32:41 PM

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

Quote

DIM MyLionMatrix(0 TO 8, 0 TO 8) AS LONG

and

Quote

"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:

Quote

DIM MyLionMatrix(0 TO 8, 0 TO 8)

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

Title: Re: udt example and function?
Post by: José Roca on October 13, 2009, 08:14:39 PM

 
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.