[VB6] How to use GPU from VB6 using opencl

[wqweto]

Here is a direct translation of this tutorial which uses opencl to populate a buffer with consecutive numbers.

Option Explicit

Private Const CL_FALSE                          As Long = 0
Private Const CL_TRUE                           As Long = 1
Private Const CL_DEVICE_TYPE_GPU                As Currency = 4 / 10000@
Private Const CL_MEM_WRITE_ONLY                 As Currency = 2 / 10000@
Private Const CL_MAP_READ                       As Currency = 1 / 10000@

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As Any, num_platforms As Any) As Long
Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As Long, ByVal device_type As Currency, ByVal num_entries As Long, devices As Any, num_devices As Any) As Long
Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As Long) As Long
Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As Any, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As Long
Private Declare Function clReleaseContext Lib "opencl" (ByVal context As Long) As Long
Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As Long, ByVal device As Long, ByVal properties As Currency, errcode_ret As Any) As Long
Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As Long) As Long
Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As Long, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As Long
Private Declare Function clBuildProgram Lib "opencl" (ByVal program As Long, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
Private Declare Function clCreateKernel Lib "opencl" (ByVal program As Long, ByVal kernel_name As String, errcode_ret As Any) As Long
Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As Long) As Long
Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As Long, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As Long, errcode_ret As Any) As Long
Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As Long) As Long
Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As Long, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
Private Declare Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As Long, ByVal kernel As Long, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
Private Declare Function clFinish Lib "opencl" (ByVal command_queue As Long) As Long
Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As Long, ByVal buffer As Long, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As Long, ByVal size As Long, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
Private Declare Function clReleaseEvent Lib "opencl" (ByVal event_ As Long) As Long

Private Const STR_SOURCE            As String = _
"kernel void memset( global uint *dst )" & vbCrLf & _
"{" & vbCrLf & _
"    dst[get_global_id(0)] = get_global_id(0);" & vbCrLf & _
"}"
Private Const NWITEMS               As Long = 512

Private Sub Form_Load()
    Dim lError          As Long
    Dim hPlatform       As Long
    Dim hDevice         As Long
    Dim hContext        As Long
    Dim hQueue          As Long
    Dim hProgram        As Long
    Dim baSource()      As Byte
    Dim hKernel         As Long
    Dim hBuffer         As Long
    Dim hEvent          As Long
    Dim lPtr            As Long
    Dim aResult(0 To NWITEMS - 1) As Long
    Dim lIdx            As Long
    
    On Error GoTo EH
    baSource = StrConv(STR_SOURCE & vbNullChar, vbFromUnicode)
    lError = clGetPlatformIDs(1, hPlatform, ByVal 0)
    pvCheckError lError, "clGetPlatformIDs"
    lError = clGetDeviceIDs(hPlatform, CL_DEVICE_TYPE_GPU, 1, hDevice, ByVal 0)
    pvCheckError lError, "clGetDeviceIDs"
    hContext = clCreateContext(0, 1, hDevice, 0, 0, lError)
    pvCheckError lError, "clCreateContext"
    hQueue = clCreateCommandQueue(hContext, hDevice, ByVal 0, lError)
    pvCheckError lError, "clCreateCommandQueue"
    hProgram = clCreateProgramWithSource(hContext, 1, VarPtr(baSource(0)), ByVal 0, lError)
    pvCheckError lError, "clCreateProgramWithSource"
    lError = clBuildProgram(hProgram, 1, hDevice, vbNullString, 0, 0)
    pvCheckError lError, "clBuildProgram"
    hKernel = clCreateKernel(hProgram, "memset", lError)
    pvCheckError lError, "clCreateKernel"
    hBuffer = clCreateBuffer(hContext, CL_MEM_WRITE_ONLY, NWITEMS * 4, 0, lError)
    pvCheckError lError, "clCreateBuffer"
    lError = clSetKernelArg(hKernel, 0, LenB(hBuffer), hBuffer)
    pvCheckError lError, "clSetKernelArg"
    lError = clEnqueueNDRangeKernel(hQueue, hKernel, 1, ByVal 0, NWITEMS, ByVal 0, 0, ByVal 0, hEvent)
    pvCheckError lError, "clEnqueueNDRangeKernel"
    lError = clFinish(hQueue)
    pvCheckError lError, "clFinish"
    lPtr = clEnqueueMapBuffer(hQueue, hBuffer, CL_TRUE, CL_MAP_READ, 0, NWITEMS * 4, 0, ByVal 0, ByVal 0, lError)
    pvCheckError lError, "clEnqueueMapBuffer"
    If lPtr <> 0 Then
        Call CopyMemory(aResult(0), ByVal lPtr, NWITEMS * 4)
        For lIdx = 0 To UBound(aResult)
            Debug.Assert aResult(lIdx) = lIdx
        Next
    End If
QH:
    Call clReleaseEvent(hEvent)
    Call clReleaseMemObject(hBuffer)
    Call clReleaseKernel(hKernel)
    Call clReleaseCommandQueue(hQueue)
    Call clReleaseContext(hContext)
    Call clReleaseDevice(hDevice)
    Exit Sub
EH:
    MsgBox "Critical error: " & Err.Description & " &H" & Hex$(Err.Number), vbCritical, Err.Source
    Resume QH
End Sub

Private Sub pvCheckError(ByVal lError As Long, sSource As String)
    If lError <> 0 Then
        Err.Raise vbObjectError, sSource, "Error " & lError
    End If
End Sub

cheers,
</wqw>

[georgekar]

I run it, no error return. So what next???

[wqweto]

I run it, no error return. So what next???

Next is to use opencl to calculate FFT on the GPU for instance :-))

cheers,
</wqw>

[georgekar]

Beautiful. Go on.

[Dan_W]

Hi. Was discussing with a friend whether it would be possible to access the GPU from VBA, and I recalled this post, but am having a some difficulty porting it to 64bit VBA. I've converted the API declarations based on what you've indicated to be pointers from your code, and from the OpenCL Specification (Version: 1.0, DocRev: 48) and have managed to get the APIs to run without error, but it crashes on the CopyMemory line and I was hoping that you might have some thoughts as to why.

I have used conditional compilation on the code below, and have tested it on 64bit VBA (crashes), and on TB 32bit and 64bit. The 32bit version works with TB without incident, but the 64bit version produces on the same Copymemory line:

0001 00:47:51.428 NATIVE EXCEPTION: ACCESS_VIOLATION /Form1.twin LINE 000107

Thank you all for your time.

Option Explicit

Private Const CL_FALSE                          As Long = 0
Private Const CL_TRUE                           As Long = 1
Private Const CL_DEVICE_TYPE_GPU                As Currency = 4 / 10000@
Private Const CL_MEM_WRITE_ONLY                 As Currency = 2 / 10000@
Private Const CL_MAP_READ                       As Currency = 1 / 10000@
#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
    Private Declare PtrSafe Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As Currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
    Private Declare PtrSafe Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
    Private Declare PtrSafe Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
    Private Declare PtrSafe Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As Currency, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare PtrSafe Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
    Private Declare PtrSafe Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
    Private Declare PtrSafe Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
    Private Declare PtrSafe Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
    Private Declare PtrSafe Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
    Private Declare PtrSafe Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare PtrSafe Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
    Private Declare PtrSafe Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
    Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
    Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
    Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
    Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As currency, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
    Private Declare Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
    Private Declare Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
    Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
    Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
    Private Declare Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
    Private Declare Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
    Private Declare Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
#End If
Private Const STR_SOURCE            As String = _
"kernel void memset( global uint *dst )" & vbCrLf & _
"{" & vbCrLf & _
"    dst[get_global_id(0)] = get_global_id(0);" & vbCrLf & _
"}"
Private Const NWITEMS               As Long = 512

Private Sub Form_Load()
    Dim lError          As Long
    Dim hPlatform       As LongPtr
    Dim hDevice         As LongPtr
    Dim hContext        As LongPtr
    Dim hQueue          As LongPtr
    Dim hProgram        As LongPtr
    Dim baSource()      As Byte
    Dim hKernel         As LongPtr
    Dim hBuffer         As LongPtr
    Dim hEvent          As LongPtr
    Dim lPtr            As LongPtr
    Dim aResult(0 To NWITEMS - 1) As Long
    Dim lIdx            As Long
    
    On Error GoTo EH
    baSource = StrConv(STR_SOURCE & vbNullChar, vbFromUnicode)
    lError = clGetPlatformIDs(1, hPlatform, ByVal 0)
    
    pvCheckError lError, "clGetPlatformIDs"
    lError = clGetDeviceIDs(hPlatform, CL_DEVICE_TYPE_GPU, 1, hDevice, ByVal 0)
    pvCheckError lError, "clGetDeviceIDs"
    hContext = clCreateContext(0, 1, hDevice, 0, 0, lError)
    pvCheckError lError, "clCreateContext"
    hQueue = clCreateCommandQueue(hContext, hDevice, ByVal 0, lError)
    pvCheckError lError, "clCreateCommandQueue"
    hProgram = clCreateProgramWithSource(hContext, 1, VarPtr(baSource(0)), ByVal 0, lError)
    pvCheckError lError, "clCreateProgramWithSource"
    lError = clBuildProgram(hProgram, 1, hDevice, vbNullString, 0, 0)
    pvCheckError lError, "clBuildProgram"
    hKernel = clCreateKernel(hProgram, "memset", lError)
    pvCheckError lError, "clCreateKernel"
    hBuffer = clCreateBuffer(hContext, CL_MEM_WRITE_ONLY, NWITEMS * 4, 0, lError)
    pvCheckError lError, "clCreateBuffer"
    lError = clSetKernelArg(hKernel, 0, LenB(hBuffer), hBuffer)
    pvCheckError lError, "clSetKernelArg"
    lError = clEnqueueNDRangeKernel(hQueue, hKernel, 1, ByVal 0, NWITEMS, ByVal 0, 0, ByVal 0, hEvent)
    pvCheckError lError, "clEnqueueNDRangeKernel"
    lError = clFinish(hQueue)
    pvCheckError lError, "clFinish"
    lPtr = clEnqueueMapBuffer(hQueue, hBuffer, CL_TRUE, CL_MAP_READ, 0, NWITEMS * 4, 0, ByVal 0, ByVal 0, lError)
    pvCheckError lError, "clEnqueuehQueueMapBuffer"
    If lPtr <> 0 Then
        Call CopyMemory(aResult(0), ByVal lPtr, NWITEMS * 4)
        For lIdx = 0 To UBound(aResult)
            Debug.Assert aResult(lIdx) = lIdx
        Next
    End If
QH:
    Call clReleaseEvent(hEvent)
    Call clReleaseMemObject(hBuffer)
    Call clReleaseKernel(hKernel)
    Call clReleaseCommandQueue(hQueue)
    Call clReleaseContext(hContext)
    Call clReleaseDevice(hDevice)
    Exit Sub
EH:
    MsgBox "Critical error: " & Err.Description & " &H" & Hex$(Err.Number), vbCritical, Err.Source
    Resume QH
End Sub

Private Sub pvCheckError(ByVal lError As Long, sSource As String)
    If lError <> 0 Then
        Err.Raise vbObjectError, sSource, "Error " & lError
    End If
End Sub

[fafalone]

lPtr is a pointer, so clEnqueueMapBuffer should return LongPtr. You're truncating the pointer with it as Long, so getting an access violation from reading at an incorrect address.

I don't get any errors after making that change (under tB 64bit, I did not test VBA64).

The documentation I found lists it as returning void*, so looks like just an oversight, easy to miss when there's so many Long->LongPtr changes.. all void* types must be LongPtr.

[Dan_W]

You're absolutely right - my apologies for missing that one. I've checked it in VBA 64bit and it's working as expected. Thank you both!

On the off-chance anyone needs it, here is the TB/VBA 32bit and 64bit compatible code:

Option Explicit

Private Const CL_FALSE                          As Long = 0
Private Const CL_TRUE                           As Long = 1
Private Const CL_DEVICE_TYPE_GPU                As Currency = 4 / 10000@
Private Const CL_MEM_WRITE_ONLY                 As Currency = 2 / 10000@
Private Const CL_MAP_READ                       As Currency = 1 / 10000@
#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
    Private Declare PtrSafe Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As Currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
    Private Declare PtrSafe Function clReleaseDevice Lib "opencl" (ByVal Device As LongPtr) As Long
    Private Declare PtrSafe Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
    Private Declare PtrSafe Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal Device As LongPtr, ByVal properties As Currency, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare PtrSafe Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
    Private Declare PtrSafe Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
    Private Declare PtrSafe Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As Currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
    Private Declare PtrSafe Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
    Private Declare PtrSafe Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
    Private Declare PtrSafe Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare PtrSafe Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As Currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As LongPtr
    Private Declare PtrSafe Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function clGetPlatformIDs Lib "opencl" (ByVal num_entries As Long, cl_platform_id As LongPtr, num_platforms As Any) As Long
    Private Declare Function clGetDeviceIDs Lib "opencl" (ByVal platform As LongPtr, ByVal device_type As currency, ByVal num_entries As Long, devices As LongPtr, num_devices As Any) As Long
    Private Declare Function clReleaseDevice Lib "opencl" (ByVal device As LongPtr) As Long
    Private Declare Function clCreateContext Lib "opencl" (ByVal properties As Long, ByVal num_devices As Long, devices As LongPtr, ByVal pfn_notify As Long, ByVal user_data As Long, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseContext Lib "opencl" (ByVal context As LongPtr) As Long
    Private Declare Function clCreateCommandQueue Lib "opencl" (ByVal context As LongPtr, ByVal device As LongPtr, ByVal properties As currency, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseCommandQueue Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare Function clCreateProgramWithSource Lib "opencl" (ByVal context As LongPtr, ByVal count As Long, strings As Any, lengths As Any, errcode_ret As Any) As LongPtr
    Private Declare Function clBuildProgram Lib "opencl" (ByVal program As LongPtr, ByVal num_devices As Long, device_list As Any, ByVal options As String, ByVal pfn_notify As Long, ByVal user_data As Long) As Long
    Private Declare Function clCreateKernel Lib "opencl" (ByVal program As LongPtr, ByVal kernel_name As String, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseKernel Lib "opencl" (ByVal kernel As LongPtr) As Long
    Private Declare Function clCreateBuffer Lib "opencl" (ByVal context As LongPtr, ByVal flags As currency, ByVal size As Long, ByVal host_ptr As LongPtr, errcode_ret As Any) As LongPtr
    Private Declare Function clReleaseMemObject Lib "opencl" (ByVal memobj As LongPtr) As Long
    Private Declare Function clSetKernelArg Lib "opencl" (ByVal kernel As LongPtr, ByVal arg_index As Long, ByVal arg_size As Long, arg_value As Any) As Long
    Private Declare Function clEnqueueNDRangeKernel Lib "opencl" (ByVal command_queue As LongPtr, ByVal kernel As LongPtr, ByVal work_dim As Long, global_work_offset As Any, global_work_size As Any, local_work_size As Any, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any) As Long
    Private Declare Function clFinish Lib "opencl" (ByVal command_queue As LongPtr) As Long
    Private Declare Function clEnqueueMapBuffer Lib "opencl" (ByVal command_queue As LongPtr, ByVal buffer As LongPtr, ByVal blocking_map As Long, ByVal map_flags As currency, ByVal offset As LongPtr, ByVal size As LongPtr, ByVal num_events_in_wait_list As Long, event_wait_list As Any, event_ As Any, errcode_ret As Any) As Long
    Private Declare Function clReleaseEvent Lib "opencl" (ByVal event_ As LongPtr) As Long
#End If
Private Const STR_SOURCE            As String = _
"kernel void memset( global uint *dst )" & vbCrLf & _
"{" & vbCrLf & _
"    dst[get_global_id(0)] = get_global_id(0);" & vbCrLf & _
"}"
Private Const NWITEMS               As Long = 512

Private Sub Form_Load()
    Dim lError          As Long
    Dim hPlatform       As LongPtr
    Dim hDevice         As LongPtr
    Dim hContext        As LongPtr
    Dim hQueue          As LongPtr
    Dim hProgram        As LongPtr
    Dim baSource()      As Byte
    Dim hKernel         As LongPtr
    Dim hBuffer         As LongPtr
    Dim hEvent          As LongPtr
    Dim lPtr            As LongPtr
    Dim aResult(0 To NWITEMS - 1) As Long
    Dim lIdx            As Long
    
    On Error GoTo EH
    baSource = StrConv(STR_SOURCE & vbNullChar, vbFromUnicode)
    lError = clGetPlatformIDs(1, hPlatform, ByVal 0)
    
    pvCheckError lError, "clGetPlatformIDs"
    lError = clGetDeviceIDs(hPlatform, CL_DEVICE_TYPE_GPU, 1, hDevice, ByVal 0)
    pvCheckError lError, "clGetDeviceIDs"
    hContext = clCreateContext(0, 1, hDevice, 0, 0, lError)
    pvCheckError lError, "clCreateContext"
    hQueue = clCreateCommandQueue(hContext, hDevice, ByVal 0, lError)
    pvCheckError lError, "clCreateCommandQueue"
    hProgram = clCreateProgramWithSource(hContext, 1, VarPtr(baSource(0)), ByVal 0, lError)
    pvCheckError lError, "clCreateProgramWithSource"
    lError = clBuildProgram(hProgram, 1, hDevice, vbNullString, 0, 0)
    pvCheckError lError, "clBuildProgram"
    hKernel = clCreateKernel(hProgram, "memset", lError)
    pvCheckError lError, "clCreateKernel"
    hBuffer = clCreateBuffer(hContext, CL_MEM_WRITE_ONLY, NWITEMS * 4, 0, lError)
    pvCheckError lError, "clCreateBuffer"
    lError = clSetKernelArg(hKernel, 0, LenB(hBuffer), hBuffer)
    pvCheckError lError, "clSetKernelArg"
    lError = clEnqueueNDRangeKernel(hQueue, hKernel, 1, ByVal 0, NWITEMS, ByVal 0, 0, ByVal 0, hEvent)
    pvCheckError lError, "clEnqueueNDRangeKernel"
    lError = clFinish(hQueue)
    pvCheckError lError, "clFinish"
    lPtr = clEnqueueMapBuffer(hQueue, hBuffer, CL_TRUE, CL_MAP_READ, 0, NWITEMS * 4, 0, ByVal 0, ByVal 0, lError)
    pvCheckError lError, "clEnqueuehQueueMapBuffer"
    If lPtr <> 0 Then
        Call CopyMemory(aResult(0), ByVal lPtr, NWITEMS * 4)
        For lIdx = 0 To UBound(aResult)
            Debug.Print lIdx
            Debug.Assert aResult(lIdx) = lIdx
        Next
    End If
QH:
    Call clReleaseEvent(hEvent)
    Call clReleaseMemObject(hBuffer)
    Call clReleaseKernel(hKernel)
    Call clReleaseCommandQueue(hQueue)
    Call clReleaseContext(hContext)
    Call clReleaseDevice(hDevice)
    Exit Sub
EH:
    MsgBox "Critical error: " & Err.Description & " &H" & Hex$(Err.Number), vbCritical, Err.Source
    Resume QH
End Sub

Private Sub pvCheckError(ByVal lError As Long, sSource As String)
    If lError <> 0 Then
        Err.Raise vbObjectError, sSource, "Error " & lError
    End If
End Sub

[taishan]

Next is to use opencl to calculate FFT on the GPU for instance :-))
cheers,
</wqw>

This is excellent. Is there a way we can specify VB to send routines to be processed on the GPU without OpenCL?
Like with DirectX or even VB primitives? Cairo?

EDIT: found the answer here