Attribute VB_Name = "opendmx"
' VB6 Driver for the Enttec.com "Open Dmx USB" interface

' version: 1.0 (28 August 2004, 2:43am AEST)
' author: hippy (rowanmac@optusnet.com.au)
' Startcode correction by: Jonny Wester 30 August 2004 (jonny.wester@cpoint-lighting.co.za)
' msg_passing added 16/9 2004 by J.W.

' Requires: ftd2xx.dll


' opendmx.init  -  connect with the interface
' opendmx.done  -  disconnect
' opendmx.set_dmxstartcode(dmxstartcode as byte) - Set the DMX start code
' opendmx.send  -  send the dmx buffer
' opendmx.set_dmx(array[1..512] as byte)  -  fill the dmx buffer

' if it wont connect, disconnect and reconnect the usb lead



' the ftd2xx.dll interface
Private Declare Function FT_Open Lib "FTD2XX.DLL" (ByVal intDeviceNumber As Integer, ByRef lngHandle As Long) As Long
Private Declare Function FT_Close Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_SetDivisor Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal div As Long) As Long
Private Declare Function FT_Read Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesReturned As Long) As Long
Private Declare Function FT_Write Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesWritten As Long) As Long
Private Declare Function FT_SetBaudRate Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngBaudRate As Long) As Long
Private Declare Function FT_SetDataCharacteristics Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal byWordLength As Byte, ByVal byStopBits As Byte, ByVal byParity As Byte) As Long
Private Declare Function FT_SetFlowControl Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal intFlowControl As Integer, ByVal byXonChar As Byte, ByVal byXoffChar As Byte) As Long
Private Declare Function FT_ResetDevice Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_SetDtr Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_ClrDtr Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_SetRts Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_ClrRts Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_GetModemStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngModemStatus As Long) As Long
Private Declare Function FT_Purge Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngMask As Long) As Long
Private Declare Function FT_GetStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngRxBytes As Long, ByRef lngTxBytes As Long, ByRef lngEventsDWord As Long) As Long
Private Declare Function FT_GetQueueStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngRxBytes As Long) As Long
Private Declare Function FT_GetEventStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngEventsDWord As Long) As Long
Private Declare Function FT_SetChars Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal byEventChar As Byte, ByVal byEventCharEnabled As Byte, ByVal byErrorChar As Byte, ByVal byErrorCharEnabled As Byte) As Long
Private Declare Function FT_SetTimeouts Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngReadTimeout As Long, ByVal lngWriteTimeout As Long) As Long
Private Declare Function FT_SetBreakOn Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_SetBreakOff Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Private Declare Function FT_ResetPort Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
' Return codes
Const FT_OK = 0
Const FT_INVALID_HANDLE = 1
Const FT_DEVICE_NOT_FOUND = 2
Const FT_DEVICE_NOT_OPENED = 3
Const FT_IO_ERROR = 4
Const FT_INSUFFICIENT_RESOURCES = 5


' Word Lengths
Const FT_BITS_8 = 8
Const FT_BITS_7 = 7

' Stop Bits
Const FT_STOP_BITS_1 = 0
Const FT_STOP_BITS_1_5 = 1
Const FT_STOP_BITS_2 = 2

' Parity
Const FT_PARITY_NONE = 0
Const FT_PARITY_ODD = 1
Const FT_PARITY_EVEN = 2
Const FT_PARITY_MARK = 3
Const FT_PARITY_SPACE = 4

' Flow Control
Const FT_FLOW_NONE = &H0
Const FT_FLOW_RTS_CTS = &H100
Const FT_FLOW_DTR_DSR = &H200
Const FT_FLOW_XON_XOFF = &H400

' Purge rx and tx buffers
Const FT_PURGE_RX = 1
Const FT_PURGE_TX = 2

Dim lngHandle As Long ' device handle

Dim strWriteBuffer As String * 512 ' the buffer to send
Dim strWriteStartCode As String ' the start code to send
Dim lngBytesWritten As Long ' how much has been sent

Dim strReadBuffer As String * 512 ' not yet
Dim lngBytesRead As Long ' not yet

'Dim startcode As String * 1   ' dmx startcode
Dim msg_passing_status As Boolean   'Error codes if true, Message boxes if false
Dim msg_status As Byte              'Error code
Dim connected As Boolean      ' is device connected
Public Sub Reset_Device()
' reset the device
msg_status = 0
If FT_ResetDevice(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed To Reset Device!"
        Hoofdblad.Status.Text = "Failed To Reset USB Device! "
        Playdesk.Status.Text = "Failed To Reset USB Device!"
    Else
       msg_status = 2
    End If
End If
HandlerNumber = lngHandle
End Sub

Public Sub Close_Device()
msg_status = 0
If FT_Close(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Close Failed"
        Hoofdblad.Status.Text = "Failed To Close USB Device! "
        Playdesk.Status.Text = "Failed To Close USB Device!"
    Else
       msg_status = 9
    End If
End If
HandlerNumber = lngHandle
End Sub
' Open the device
Public Sub init()
connected = False
msg_status = 0
If FT_Open(0, lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
       MsgBox "Open Failed!"
       Hoofdblad.Status.Text = "Open USB Device Failed! "
        Playdesk.Status.Text = "Open USB Device Failed!"
    Else
       msg_status = 1
    End If
    done
    HandlerNumber = lngHandle
    Exit Sub
End If

' reset the device
If FT_ResetDevice(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed To Reset Device!"
        Hoofdblad.Status.Text = "Open USB Device Reset Failed! "
        Playdesk.Status.Text = "Open USB Device Reset Failed!"
    Else
       msg_status = 2
    End If
    
    done
    HandlerNumber = lngHandle
    Exit Sub
End If

' set the baud rate
If FT_SetDivisor(lngHandle, 12) Then
    If msg_passing_status = False Then
        MsgBox "Failed To Set Baud Rate!"
        Hoofdblad.Status.Text = "Open USB Device Baudrate Failed! "
        Playdesk.Status.Text = "Open USB Device Baudrate Failed!"
    Else
       msg_status = 3
    End If
        
    done
    HandlerNumber = lngHandle
    Exit Sub
End If

' shape the line
If FT_SetDataCharacteristics(lngHandle, FT_BITS_8, FT_STOP_BITS_2, FT_PARITY_NONE) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed To Set Data Characteristics!"
    Else
       msg_status = 4
    End If
        
    done
    HandlerNumber = lngHandle
    Exit Sub
End If

' no flow control
If FT_SetFlowControl(lngHandle, FT_FLOW_NONE, 0, 0) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed to set flow control!"
    Else
       msg_status = 5
    End If
        
    done
    HandlerNumber = lngHandle
    Exit Sub
End If
        
        
' set send dmx
If FT_ClrRts(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed to set RS485 to send!"
    Else
       msg_status = 6
    End If
        
   done
   HandlerNumber = lngHandle
   Exit Sub
End If
     
       
' Clear TX RX buffers
If FT_Purge(lngHandle, FT_PURGE_TX) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed to purge TX buffer!"
    Else
       msg_status = 7
    End If
        
   done
   HandlerNumber = lngHandle
   Exit Sub
End If

If FT_Purge(lngHandle, FT_PURGE_RX) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Failed to purge RX buffer!"
    Else
       msg_status = 8
    End If
        
   done
   HandlerNumber = lngHandle
   Exit Sub
End If

strWriteBuffer = vbNullString
lngBytesWritten = 0

startcode = "0"
connected = True
If msg_passing_status = False Then
    MsgBox "Open DMX USB Driver Version 1.0 - by Rowan Maclachlan"
End If
HandlerNumber = lngHandle
End Sub ' init
' close the device
Public Sub done()
' if not connected then exit

If connected <> True Then
 Exit Sub
End If
If FT_Close(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Close Failed"
    Else
       msg_status = 9
    End If
End If
connected = False
HandlerNumber = lngHandle
End Sub 'done
' recieve dmx data from app into buffer
Public Sub set_dmx(dmxarray() As Byte)
' convert byte array to string
 strWriteBuffer = StrConv(dmxarray, vbUnicode)
End Sub
' startcode same as dmxarray, just one byte
Public Sub set_dmxstartcode(dmxstart As Byte)
' convert byte array to string
 strWriteStartCode = StrConv(dmxstart, vbUnicode)
End Sub
' send a frame to the interface
Public Sub send()
    
' if not connected then exit
If connected <> True Then
 Exit Sub
End If
    
' break
FT_SetBreakOn (lngHandle)
FT_SetBreakOff (lngHandle)
msg_status = 0
If FT_Write(lngHandle, strWriteStartCode, Len(strWriteStartCode), lngBytesWritten) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Write Start Code Failed!"
    Else
       msg_status = 10
    End If
    HandlerNumber = lngHandle
End If
 

' write dmx data
If FT_Write(lngHandle, strWriteBuffer, Len(strWriteBuffer), lngBytesWritten) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Write DMX Failed!"
    Else
       msg_status = 11
    End If
    HandlerNumber = lngHandle
End If

End Sub
Public Function Reset_Port()
msg_status = 0
If FT_ResetPort(lngHandle) <> FT_OK Then
    If msg_passing_status = False Then
        MsgBox "Reset USB Port Failed!"
    Else
       msg_status = 12
    End If
    HandlerNumber = lngHandle
End If
End Function
' select msgbox or error code passing
Public Function msg_passing(msg As Integer) As Integer
    
If msg = 1 Then
    msg_passing_status = True
Else
    msg_passing_status = False
End If
MessagePassing = msg_status
msg_passing = msg_status
End Function





