Passing Two-dimensional to API declare

Targets Windows
1

hi all
Sorry bad English
How can pass an Xojo array to API declare Function

Dim Data( 0 , 0 ) As Byte
Call StretchDIBits( hDC , 0 , 0 , X, X, X, 0 , X, X, Data( 0 , 0 ) , X, X , X )

no work like as i want !!!

i convert Byte to MemoryBlock

like this
Dim xData As New MemoryBlock( 1 )
xData .Byte( 0 ) = Data( 0 , 0 )

also do not work like as i want !!!

Are there solutions to this problem ?

thank you

2

You’ll need to copy the entire array contents to a memoryblock and make sure that it is laid out the way the declare expects it. In C-like languages, an array is just a block of memory. Not so in Xojo, so you have to convert it and present it the way the other language expects it to be.

3

thank you for reply tim

how i can copy this to memoryblock

this code

Dim Data( 0 , 0 ) As Byte
For posY = 0 To 40
For posX = 0 To 40
Data( Index , posY ) = ( ( iColor \ &H10000 ) And &HFF ) * alpha
Data( Index , posY ) = ( ( iColor \ &H100 ) And &HFF ) * alpha
Data( Index , posY ) = ( iColor And &HFF ) * alpha
Data( Index , posY ) = 255 * alpha
Next posX
Next posY
Call StretchDIBits( hDC , 0 , 0 , X, X, X, 0 , X, X, Data( 0 , 0 ) , X, X , X )

are you mean

Dim DataAs New MemoryBlock( 4 )
Data.Byte( 0 ) = ( ( iColor \ &H10000 ) And &HFF ) * alpha
Data.Byte( 1 ) = ( ( iColor \ &H100 ) And &HFF ) * alpha
Data.Byte( 2 ) = ( iColor And &HFF ) * alpha
Data.Byte( 3 ) = 255 * alpha

4

depends on how the declare expects those items to be laid out
x then y or y then x

but you make a memoryblock that is large enough to hold all rows & columns of data

   dim rows as integer = Ubound(data,0)
   dim columns as integer = Ubound(data,1)
   dim mb as new memoryblock( rows * columns)

then poke all the values in

    for row as integer = 0 to Ubound(data,0)
          for column as integer = Ubound(data,1)
                  mb.int8value(row*Ubound(data,1) + column) = data(row, column)
          next
    next

or something like this (I wrote this all in the editor in the forum so it may not work but you get the idea)

5

thank you Norman for reply

i get this error
OutOfBoundsExcption !!!
to this line
for row as integer = 0 to Ubound(data,0)

i want convert this line to MemoryBlock

Dim Data( 0 , 0 ) As Byte
For posY = 0 To 40
For posX = 0 To 40
Data( Index , posY ) = ( ( iColor \ &H10000 ) And &HFF ) * alpha
Data( Index , posY ) = ( ( iColor \ &H100 ) And &HFF ) * alpha
Data( Index , posY ) = ( iColor And &HFF ) * alpha
Data( Index , posY ) = 255 * alpha
Next posX
Next posY
Call StretchDIBits( hDC , 0 , 0 , X, X, X, 0 , X, X, Data( 0 , 0 ) , X, X , X )

Thanks for any help .

6

note … I did say “or something like this (I wrote this all in the editor in the forum so it may not work but you get the idea)”

FWIW your array isn’t big enough
This hold 1 row with 1 column - Dim Data( 0 , 0 ) As Byte
see http://documentation.xojo.com/index.php/Dim where it talks about arrays

7

this line
dim rows as integer = Ubound(data,0)
and
dim columns as integer = Ubound(data,1)
give me
OutOfBoundsExcption … error

must converting to

dim rows as integer = Ubound(data, - 1 )

Thanks for any help.

8

using -1 wont give you the result you need
rather than guessing read the docs here http://documentation.xojo.com/index.php/Ubound

[code]
dim data(10,10) as integer

dim rows as integer = Ubound(data,1)
dim columns as integer = Ubound(data,2)
dim mb as new memoryblock( rows * columns)

dim maxrows as integer = Ubound(data,1)
dim maxcols as integer = Ubound(data,2)
for row as integer = 0 to maxrows
for column as integer = 0 to maxcols
mb.int8value(row*Ubound(data,1) + column) = data(row, column)
next
next

[code]

9

thank you Norman so much
I’m sick of this code .

this full code

Dim bmpData( 255 , 255 ) As Byte
ReDim bmpData( BlurRadius * 4 - 1 , BlurRadius - 1 )
Dim Index As Integer
For posY As Integer = 0 To BlurRadius - 1
For posX As Integer = 0 To BlurRadius - 1
Dim alpha As Double = ( posX / BlurRadius * posX / BlurRadius + posY / BlurRadius * posY / BlurRadius ) ^ ( 1 / 2 )
If alpha > 1 Then
alpha = 1
ElseIf alpha < 0 Then
alpha = 0
End If
alpha = GetBezier( alpha , sngContrast ) * sngOpaque
bmpData( Index , posY ) = ( ( iColor \ &H10000 ) And &HFF ) * alpha
Index = Index + 1
bmpData( Index , posY ) = ( ( iColor \ &H100 ) And &HFF ) * alpha
Index = Index + 1
bmpData( Index , posY ) = ( iColor And &HFF ) * alpha
Index = Index + 1
bmpData( Index , posY ) = 255 * alpha
Index = Index + 1
Next posX
Index = 0
Next posY
//
dim rows as integer = Ubound( bmpData , 1 )
dim columns as integer = Ubound( bmpData , 2)
dim pBits as new memoryblock( rows * columns)
MsgBox Str( pBits.Size ) ’ 6201
//
for row as integer = 0 to Ubound( bmpData , 1 )
for column as integer = 0 to Ubound( bmpData , 2 )
pBits.Byte( row * Ubound( bmpData , 1 ) + column ) = bmpData( row , column ) // here i get ( OutOfBoundsExcption )
next
next

I’m rellay sorry …

10

have you tried running your code in the debugger ?
You can step through it and see where the error occurs and spend time analyzing WHY it occurs

Dim bmpData( 255 , 255 ) As Byte
ReDim bmpData( BlurRadius * 4 - 1 , BlurRadius - 1 )
//
dim rows as integer = Ubound( bmpData , 1 )+1
dim columns as integer = Ubound( bmpData , 2)+1
dim pBits as new memoryblock( rows * columns)
MsgBox Str( pBits.Size ) ’ 6201
//
for row as integer = 0 to rows-1
for column as integer = 0 to columns-1
dim offset as integer = (row * columns) + column
pBits.Byte( offset ) = bmpData( row , column )
next
next

11

thank you Norman

you code is work but i need some steps
and i do not know where the problem !!!

I’ll try even disband this problem

Thanks again for helping me

12

step through the code using the debugger
you can then watch exactly whats is going on etc and see where the problem is

the last code I posted doesn’t get an out of bounds and seems to be correct for the values I tried

13

Are you running on 32 or 64 bit? Keep in mind integer size changes by that, and either you should create a bigger memory block for bigger integers or take care only the int32 values are added to the memoryblock.
If your API method expects a C-type memory block, you should define its size + 1 (x4 or x 8, depending on the platform). A C-type memory block’s last value must be a ptr to Nil. A Xojo memoryblock is automatically nulled, that’s why extending its size is enough.

14

hi Ulrich

i use 32 bit win 8.1

i weant pass bmpData( 0, 0) to api Function in ( lpBits As Any ) …
in vb6
Private Declare Function StretchDIBits Lib “gdi32” (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, _
ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, _
ByVal wUsage As Long, ByVal dwRop As Long) As Long
in xojo
Soft Declare Function StretchDIBits Lib “gdi32” ( hDC As Integer, X As Integer, Y As Integer , _
dx As Integer, dy As Integer, SrcX As Integer, SrcY As Integer, _
wSrcWidth As Integer, wSrcHeight As Integer, lpBits As Ptr , lpBitsInfo As Ptr, _
wUsage As Integer, dwRop As Integer ) As Integer

what is you mean
memory block’s last value must be a ptr to Nil
i use for … next

Dim X As Integer = UBound( bmpData , 1 ) + 1
Dim Y As Integer = UBound( bmpData , 2 ) + 1
Dim mb As New MemoryBlock( X * Y )
For posX As Integer = 0 To X - 1
For posY As Integer = 0 To Y - 1
Dim Offset As Integer = ( posX * posY ) + posX
mb.Byte( Offset ) = bmpData( posX , posY )
Next posY
Next posX

15

Your code (as much as you posted) looks correct. How do you define the bitmapinfo variable?

I don’t think that is correct. For strings, yes. For a block of memory whose dimensions you are passing, no.

16

hi tim
thank you for help me
i do not have prblem with bitmapinfo
i think working fine
Dim bmpInfo As New MemoryBlock( 40 )
bmpInfo.Long( 0 ) = bmpInfo.Size
bmpInfo.Long( 4 ) = Width
bmpInfo.Long( 8 ) = Height
bmpInfo.Short( 12 ) = 1
bmpInfo.Short( 14 ) = 32
'bmpInfo.Long( 16 ) = 0
'bmpInfo.Long( 20 ) = 0
'bmpInfo.Long( 24 ) = 0
'bmpInfo.Long( 28 ) = 0
'bmpInfo.Long( 32 ) = 0
'bmpInfo.Long( 36 ) = 0

i’m sorry my english is bad

17

Can you describe the problem you are experiencing a little better, then? What is it doing or not doing? Do you get an error? A crash? No result?

18

i get result but do not as i want
I will send to you a complete mathod tim

Sub MakeShadowForm(hwnd As Integer, hShadow As Integer, BlurRadius As Integer, iColor As Integer, Contrast As Integer, Opaque As Integer)
'#pragma DisableBackgroundTasks
'#pragma NilObjectChecking
'#pragma StackOverflowChecking
’
Soft Declare Function GetWindowRect Lib “user32” ( hwnd As Integer, lpRect As Ptr ) As Integer
Soft Declare Function GetDC Lib “user32” ( hwnd As Integer ) As Integer
Soft Declare Function CreateCompatibleDC Lib “gdi32” ( hDC As Integer ) As Integer
Soft Declare Function ReleaseDC Lib “user32” ( hwnd As Integer, hDC As Integer ) As Integer
Soft Declare Function CreateDIBSection Lib “gdi32” ( hDC As Integer, pBitmapInfo As Ptr , un As Integer, lplpVoid As Integer, handle As Integer, dw As Integer ) As Integer
Soft Declare Function StretchDIBits Lib “gdi32” ( hDC As Integer, X As Integer, Y As Integer , dx As Integer, dy As Integer, SrcX As Integer, SrcY As Integer, wSrcWidth As Integer, wSrcHeight As Integer, lpBits As Ptr , lpBitsInfo As Ptr, wUsage As Integer, dwRop As Integer ) As Integer

Soft Declare Function SetWindowPos Lib “user32” ( hwnd As Integer, hWndInsertAfter As Integer, X As Integer, Y As Integer, Cx As Integer, Cy As Integer, wFlags As Integer ) As Integer
Soft Declare Function UpdateLayeredWindow Lib “user32.dll” ( hwnd As Integer, hdcDst As Integer, pptDst As Integer , psize As Ptr , hdcSrc As Integer, pptSrc As Ptr , crKey As Integer, pblend As Integer, dwFlags As Integer ) As Integer
Soft Declare Function SelectObject Lib “gdi32” ( hDC As Integer, hObject As Integer ) As Integer
Soft Declare Function DeleteObject Lib “gdi32” ( hObject As Integer ) As Integer
Soft Declare Function DeleteDC Lib “gdi32” ( hDC As Integer ) As Integer
Soft Declare Function SetWindowLong Lib “user32” Alias “SetWindowLongA” ( hwnd As Integer, nIndex As Integer, dwNewLong As Integer ) As Integer
’
Const SWP_NOACTIVATE = &H10
Const DIB_RGB_COLORS = 0
Const ULW_ALPHA = &H2
Const AB_32Bpp255 = 33488896
Const vbSrcCopy = &HCC0020
’
Dim bmpData( 1 , - 1 ) As Byte
ReDim bmpData( BlurRadius * 4 - 1 , BlurRadius - 1 )
Dim sngContrast As Single = Contrast / 100
Dim sngOpaque As Single = Opaque / 100
Dim Index As Integer
For posY As Integer = 0 To BlurRadius - 1
For posX As Integer = 0 To BlurRadius - 1
Dim alpha As Single = ( posX / BlurRadius * posX / BlurRadius + posY / BlurRadius * posY / BlurRadius ) ^ ( 1 / 2 )
If alpha > 1 Then
alpha = 1
ElseIf alpha < 0 Then
alpha = 0
End If
alpha = GetBezier( alpha , sngContrast ) * sngOpaque
bmpData( Index , posY ) = ( ( iColor \ &H10000 ) And &HFF ) * alpha
Index = Index + 1
bmpData( Index , posY ) = ( ( iColor \ &H100 ) And &HFF ) * alpha
Index = Index + 1
bmpData( Index, posY ) = ( iColor And &HFF ) * alpha
Index = Index + 1
bmpData (Index, posY ) = 255 * alpha
Index = Index + 1
Next posX
Index = 0
Next posY
’
Dim X As Integer = UBound( bmpData , 1 ) + 1
Dim Y As Integer = UBound( bmpData , 2 ) + 1
Dim mb As New MemoryBlock( X * Y )
’
For posX As Integer = 0 To X - 1
For posY As Integer = 0 To Y - 1
Dim Offset As Integer = ( posX * posY ) + posX
mb.Byte( Offset ) = bmpData( posX , posY )
mb.Ptr( 0 ) = Nil
Next posY
Next posX
’
Dim Re As New MemoryBlock( 16 )
Call GetWindowRect( hwnd , Re )
Dim Width As Integer = Re.Long( 8 ) - Re.Long( 0 ) + BlurRadius * 2
Dim Height As Integer = Re.Long( 12 ) - Re.Long( 4 ) + BlurRadius * 2
//
Dim bmpInfo As New MemoryBlock( 40 )
bmpInfo.Long( 0 ) = bmpInfo.Size
bmpInfo.Long( 4 ) = Width
bmpInfo.Long( 8 ) = Height
bmpInfo.Short( 12 ) = 1
bmpInfo.Short( 14 ) = 32
'bmpInfo.Long( 16 ) = 0
'bmpInfo.Long( 20 ) = 0
'bmpInfo.Long( 24 ) = 0
'bmpInfo.Long( 28 ) = 0
'bmpInfo.Long( 32 ) = 0
'bmpInfo.Long( 36 ) = 0
’
Dim tmpDC As Integer = GetDC( hwnd )
Dim hDC As Integer = CreateCompatibleDC( tmpDC )
Call ReleaseDC( hwnd , tmpDC )
Dim dib As Integer = CreateDIBSection( hDC , bmpInfo , DIB_RGB_COLORS , 0 , 0 , 0 )
Dim oBmp As Integer = SelectObject( hDC , dib )
//
bmpInfo.Long( 0 ) = bmpInfo.Size
bmpInfo.Long( 4 ) = BlurRadius
bmpInfo.Long( 8 ) = BlurRadius
bmpInfo.Short( 12 ) = 1
bmpInfo.Short( 14 ) = 32
'bmpInfo.Long( 16 ) = 0
'bmpInfo.Long( 20 ) = 0
'bmpInfo.Long( 24 ) = 0
'bmpInfo.Long( 28 ) = 0
'bmpInfo.Long( 32 ) = 0
'bmpInfo.Long( 36 ) = 0

// Draw corners
Call StretchDIBits( hDC, 0 , 0 , BlurRadius , BlurRadius , BlurRadius , 0 , - BlurRadius , BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , 0 , Height - BlurRadius , BlurRadius , BlurRadius , BlurRadius , BlurRadius , - BlurRadius , - BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , Width - BlurRadius , 0 , BlurRadius , BlurRadius , 0 , 0 , BlurRadius , BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , Width - BlurRadius , Height - BlurRadius , BlurRadius , BlurRadius , 0 , BlurRadius , BlurRadius , - BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
// Draw sides
Call StretchDIBits( hDC , BlurRadius - 1 , 0 , Width - BlurRadius * 2 + 1 , BlurRadius , 0 , 0 , 1 , BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , BlurRadius - 1 , Height - BlurRadius , Width - BlurRadius * 2 + 1 , BlurRadius , 0 , BlurRadius , 1 , - BlurRadius , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , 0 , BlurRadius , BlurRadius , Height - BlurRadius * 2 + 1 , BlurRadius , 0 , - BlurRadius , 1 , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
Call StretchDIBits( hDC , Width - BlurRadius , BlurRadius , BlurRadius , Height - BlurRadius * 2 + 1 , 0 , 0 , BlurRadius , 1 , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
'Center
Call StretchDIBits( hDC , BlurRadius - 1 , BlurRadius - 1 , Width - BlurRadius * 2 + 1 , Height - BlurRadius * 2 + 1 , 0 , 0 , 1 , 1 , mb , bmpInfo , DIB_RGB_COLORS , vbSrcCopy )
// Move window
Call SetWindowPos( hShadow , hwnd , Re.Long( 0 ) - BlurRadius , Re.Long( 4 ) - BlurRadius , Width , Height , SWP_NOACTIVATE )
//
Dim Sz As New MemoryBlock( 8 )
Sz.Long( 0 ) = Width
Sz.Long( 4 ) = Height
Dim Pt As New MemoryBlock( 8 )
’
Call UpdateLayeredWindow( hShadow , hDC , 0 , Sz , hDC , Pt , 0 , AB_32Bpp255 , ULW_ALPHA )
'MsgBox "hShadow = " + Str( hShadow ) + " - " + "hDC = " + Str( hDC ) + " - " + "Width = " + Str( Sz.Long( 0 ) ) + " - " + "Height = " + Str( Sz.Long( 4 ) ) + " - " + "Pt = " + Str( Pt.Size )
// Store parameters
Call SetWindowLong( hShadow , 0 , BlurRadius )
Call SetWindowLong( hShadow , 4 , iColor )
Call SetWindowLong( hShadow , 8 , Contrast )
Call SetWindowLong( hShadow , 12 , Opaque )
// Free resources
Call SelectObject( hDC , oBmp )
Call DeleteDC( hDC )
Call DeleteObject( dib )
End Sub

I do not know exactly where the problem !!!
thank you for help me :slight_smile:

19

Why mb.Ptr( 0 ) = Nil? Try removing that.

20

i removed mb.Ptr( 0 )
No change !!!