VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Frm9014 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ORLED 9014"
   ClientHeight    =   5940
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3870
   ForeColor       =   &H00000000&
   Icon            =   "Orled9014.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5940
   ScaleWidth      =   3870
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer NotificationTimer 
      Enabled         =   0   'False
      Interval        =   80
      Left            =   3120
      Top             =   3600
   End
   Begin VB.Timer DemoTimer 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   2640
      Top             =   3600
   End
   Begin VB.CommandButton BtnDemo 
      Caption         =   "Demo"
      Height          =   375
      Left            =   240
      TabIndex        =   17
      Top             =   5280
      Width           =   615
   End
   Begin VB.CommandButton BtnQuad 
      Caption         =   "W"
      Height          =   495
      Index           =   3
      Left            =   960
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   2160
      Width           =   495
   End
   Begin VB.CommandButton BtnQuad 
      Caption         =   "S"
      Height          =   495
      Index           =   2
      Left            =   1680
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   2880
      Width           =   495
   End
   Begin VB.CommandButton BtnQuad 
      Caption         =   "E"
      Height          =   495
      Index           =   1
      Left            =   2400
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   2160
      Width           =   495
   End
   Begin VB.CommandButton BtnBrighter 
      Caption         =   ">"
      Height          =   375
      Left            =   3000
      TabIndex        =   3
      Top             =   4200
      Width           =   495
   End
   Begin VB.CommandButton BtnDimmer 
      Caption         =   "<"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   4200
      Width           =   495
   End
   Begin VB.CommandButton BtnQuad 
      Caption         =   "N"
      Height          =   495
      Index           =   0
      Left            =   1680
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1440
      Width           =   495
   End
   Begin VB.CommandButton BtnPower 
      Caption         =   "Pwr"
      Height          =   495
      Left            =   2760
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   600
      Width           =   495
   End
   Begin MSCommLib.MSComm Comport 
      Left            =   240
      Top             =   3480
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   0   'False
      InputLen        =   1
      RThreshold      =   1
      BaudRate        =   1200
   End
   Begin VB.Label LblMessageInfo 
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H00000000&
      Height          =   270
      Left            =   1080
      TabIndex        =   12
      Top             =   5400
      Width           =   2655
   End
   Begin VB.Label Label1 
      Caption         =   "Status:"
      Height          =   255
      Left            =   1080
      TabIndex        =   16
      Top             =   5160
      Width           =   1455
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   7
      Left            =   2640
      TabIndex        =   11
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   6
      Left            =   2400
      TabIndex        =   10
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   5
      Left            =   2160
      TabIndex        =   9
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   4
      Left            =   1920
      TabIndex        =   8
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   3
      Left            =   1680
      TabIndex        =   7
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   2
      Left            =   1440
      TabIndex        =   6
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   1
      Left            =   1200
      TabIndex        =   5
      Top             =   4200
      Width           =   255
   End
   Begin VB.Label LblIntensity 
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Index           =   0
      Left            =   960
      TabIndex        =   4
      Top             =   4200
      Width           =   255
   End
   Begin VB.Shape Shape1 
      BorderWidth     =   2
      Height          =   2655
      Left            =   600
      Shape           =   3  'Circle
      Top             =   1080
      Width           =   2655
   End
   Begin VB.Shape Shape2 
      BorderWidth     =   2
      Height          =   4815
      Left            =   120
      Top             =   120
      Width           =   3615
   End
End
Attribute VB_Name = "Frm9014"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
' ORLED 9014 ringlight controller remote control demo

Option Explicit

' Status colors.
Private Const ON_COLOR = vbGreen
Private Const VIRTUAL_ON_COLOR = &HCCEECC
Private Const OFF_COLOR = &H8000000F

'Private Const LED_VIRTUAL_ON_COLOR = &H558855
'Private Const DARK_COLOR = vbBlack

Private Const LED_VIRTUAL_ON_COLOR = &HCCEECC
Private Const DARK_COLOR = &H8000000F

' Ringlight command opcodes.
Private Const RLCMD_QUERY = 1
Private Const RLCMD_CONTROL = 2
Private Const RLCMD_ASYNC = 3

Private RinglightState As Integer       ' Current ringlight control state.
Private DemoInitalState As Integer      ' Control state when Demo button was clicked.
Private QuadMask As Variant             ' Quadrant bit masks.


'************************************************************
'                      FORM LOAD/UNLOAD
'************************************************************

Private Sub Form_Load()
    Dim dlg As SelComDialog
    
    SelComDialog.Show vbModal, Me
                    
    QuadMask = Array(8, &H10, &H20, &H40)
    
    Comport.CommPort = SelComDialog.CommPort
    Comport.PortOpen = True
    Call RinglightCommand(RLCMD_QUERY, &HFF)  ' Fetch and display current ringlight state.
    Call RinglightCommand(RLCMD_ASYNC, 1)     ' Switch to ASYNC mode so we will be notified of keypress and fault events.
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Comport.PortOpen = False
End Sub

'************************************************************
'                   COMMAND AND CONTROL
'************************************************************

Private Sub SendChar(ByVal c As Integer)
    ' Transmit one byte to ringlight controller.
    Dim buf As Variant
    buf = Chr$(c)
    Comport.Output = buf
End Sub

Private Sub RinglightCommand(ByVal cmd As Integer, ByVal dat As Integer)
    ' Ensure command message doesn't contain 0x00.
    If dat = 0 Then
        cmd = cmd Or &H80
        dat = &HFF
    End If
    ' Transmit command message to ringlight controller.
    SendChar cmd
    SendChar dat
    SendChar 0
End Sub

Private Sub BtnPower_Click()
    Call RinglightCommand(RLCMD_CONTROL, RinglightState Xor &H80)
End Sub
Private Sub BtnQuad_Click(Index As Integer)
    Call RinglightCommand(RLCMD_CONTROL, RinglightState Xor QuadMask(Index))
End Sub
Private Sub BtnDimmer_Click()
    If ((RinglightState And 7) > 0) Then Call RinglightCommand(RLCMD_CONTROL, RinglightState - 1)
End Sub
Private Sub BtnBrighter_Click()
    If ((RinglightState And 7) < 7) Then Call RinglightCommand(RLCMD_CONTROL, RinglightState + 1)
End Sub

'************************************************************
'                     AUTOMATION DEMO
'************************************************************

Private Sub BtnDemo_Click()
    DemoInitalState = RinglightState
    DemoTimer.Enabled = True
End Sub

Private Sub DemoTimer_Timer()
    Static state As Variant
    Static i As Integer
    ' List of sequential ringlight control states.
    state = Array( _
        &HC0, &HA0, &H90, &H88, _
        &HC0, &HA0, &H90, &H88, _
        &HC0, &HA0, &H90, &H88, _
        &HC0, &HA0, &H90, &H88, _
        &H88, &H98, &HB8, &HF8, _
        &HF8, &HF9, &HFA, &HFB, &HFC, &HFD, &HFE, &HFF, _
        &HFF, &HFE, &HFD, &HFC, &HFB, &HFA, &HF9, &HF8, _
        &HF8, &HB8, &H98, &H88, _
        &H88, &H89, &H8A, &H8B, &H8C, &H8D, &H8E, &H8F, _
        &H8F, &H8E, &H8D, &H8C, &H8B, &H8A, &H89, &H88, &H88 _
        )
    ' Activate next control state.
    Call RinglightCommand(RLCMD_CONTROL, state(i))
    ' Set up next state or terminate demo if sequence completed.
    If (i = UBound(state)) Then
        i = 0
        DemoTimer.Enabled = False
        DemoTimer.Interval = 200
        Call RinglightCommand(RLCMD_CONTROL, DemoInitalState) ' Restore pre-demo state
    Else
        i = i + 1
    End If
End Sub

'************************************************************
'          STATUS DISPLAY AND NOTIFICATION HANDLER
'************************************************************

Private Sub Report(txt As String)
    LblMessageInfo.Caption = txt
    LblMessageInfo.BackColor = vbWhite
    NotificationTimer.Enabled = False
    NotificationTimer.Enabled = True
End Sub



Private Sub NotificationTimer_Timer()
    NotificationTimer.Enabled = False
    LblMessageInfo.BackColor = &H8000000F
End Sub

Private Sub RinglightNotification(ByVal info As Integer, ByVal dat As Integer)
    ' Process a received notification message.
    Dim i As Integer
    Dim intensity As Integer
    Dim PowerColor As Long
    Dim iPowerColor As Long
    ' Decode and report the message type.
    Select Case info And &H1F
        Case 1: Report "BRIGHT KEY PRESSED"
        Case 2: Report "DIM KEY PRESSED"
        Case 3: Report "POWER KEY PRESSED"
        Case 4: Report "NORTH KEY PRESSED"
        Case 5: Report "EAST KEY PRESSED"
        Case 6: Report "SOUTH KEY PRESSED"
        Case 7: Report "WEST KEY PRESSED"
        Case 8: Report "OK"
        Case 9: Report "ERROR"
        Case 10:  ' Fault status change -- decode fault flags
            Select Case info And &H60
                Case 0: Report "NO FAULTS"
                Case &H20: Report "KEYBOARD FAULT"
                Case &H40: Report "CABLE FAULT"
                Case &H60: Report "CABLE + KEYBOARD FAULTS"
            End Select
        Case Else: Report "???"
    End Select
    ' Save current ringlight control state.
    RinglightState = dat
    intensity = (RinglightState And 7) + 1
    ' Change indicator colors based on control state.
    PowerColor = IIf(RinglightState And &H80, ON_COLOR, VIRTUAL_ON_COLOR)
    iPowerColor = IIf(RinglightState And &H80, ON_COLOR, LED_VIRTUAL_ON_COLOR)
    BtnPower.BackColor = IIf(RinglightState And &H80, ON_COLOR, OFF_COLOR)
    For i = 0 To 3
        BtnQuad(i).BackColor = IIf(dat And QuadMask(i), PowerColor, OFF_COLOR)
    Next i
    For i = 0 To 7
        LblIntensity(i).BackColor = IIf(intensity > i, iPowerColor, DARK_COLOR)
    Next i
End Sub

Private Sub Comport_OnComm()
    ' Serial receive event handler.
    Dim n As Integer
    Static buf(0 To 2) As Integer
    Static nchars As Integer
    ' If a byte was received from the ringlight controller ...
    If Comport.CommEvent = comEvReceive Then
        n = Asc(Comport.Input)    ' Fetch received byte.
        If (n <> 0) Then          ' If not an END message delimiter
            If (nchars < 2) Then buf(nchars) = n
            nchars = nchars + 1
        ElseIf (nchars = 2) Then  ' If END received and message has valid size
            If ((buf(0) And &H80) <> 0) Then    ' If Z bit set in INFO byte,
                buf(0) = buf(0) And &H7F        '   Reset Z bit so only opcode remains.
                buf(1) = 0                      '   Replace DATA value with 0x00.
            End If
            nchars = 0     ' Reset to receive next command.
            Call RinglightNotification(buf(0), buf(1)) ' Process received message
        Else  ' If END received and message size not valid
            nchars = 0     ' Unexpected END byte -- reset to receive next command.
        End If
    End If
End Sub
