# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  [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.

----------

