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.."
#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.
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
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.
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
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:
#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.
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:
#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:
Quoteit's allowed / useful to include a function in an udt ?
...
you:
QuoteNot 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 ?
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
Quote
can you show my an example how to store it into my udt-example and call it by using with Call DWORD ?
#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
:) thanks!
#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
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:
#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
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.
it's a pity. no success :(
QuoteEither 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.
#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
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:
#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
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.
#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 :
QuoteDIM MyArray(24) AS LONG AT VARPTR(MyLionMatrix(0,0))
QuoteDIM 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
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.
yes, of course. I have tried to use in another example
QuoteDIM 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:
QuoteDIM MyLionMatrix(0 TO 8, 0 TO 8)
'- last 8 is cool ! and doesn't appear here ;)
this may be a BUG ?
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.