home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / firecrax / firecrax.ctl next >
Encoding:
Text File  |  1999-07-19  |  6.1 KB  |  233 lines
  1. VERSION 5.00
  2. Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
  3. Begin VB.UserControl FireCraxor 
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   1  'Fixed Single
  6.    CanGetFocus     =   0   'False
  7.    ClientHeight    =   525
  8.    ClientLeft      =   0
  9.    ClientTop       =   0
  10.    ClientWidth     =   525
  11.    InvisibleAtRuntime=   -1  'True
  12.    Picture         =   "FireCraxor.ctx":0000
  13.    ScaleHeight     =   525
  14.    ScaleWidth      =   525
  15.    Begin MSCommLib.MSComm MSComm1 
  16.       Left            =   1200
  17.       Top             =   720
  18.       _ExtentX        =   1005
  19.       _ExtentY        =   1005
  20.       _Version        =   327680
  21.    End
  22. End
  23. Attribute VB_Name = "FireCraxor"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = True
  26. Attribute VB_PredeclaredId = False
  27. Attribute VB_Exposed = True
  28. Private Header As String
  29. Private Footer As String
  30. Private m_CommPort As Integer
  31. Private Initialized As Boolean
  32. Private Commandbuffer As String
  33.  
  34. Public Sub SendCommand(HouseID As String, AppId As Integer, Command As String)
  35. 'What this does:
  36. ' It loads the header, command, and footer into CommandBuffer
  37. ' It then calls DoAllOfCommandBuffer, which sends the data, bit by bit,
  38. 'to the FireCracker on the comm port specified
  39.  
  40. Commandbuffer = Header & GetHouseCode(HouseID) & GetCommand(AppId, Command) & Footer
  41.  
  42. DoAllOfCommandBuffer
  43.  
  44. End Sub
  45.  
  46.  
  47.  
  48. Private Sub UserControl_Initialize()
  49. 'What this does:
  50. ' It sets the Header and the Footer to the default values used with the
  51. 'FireCracker control
  52.  
  53. Header = "1101010110101010"
  54. Footer = "10101101"
  55.  
  56. Initialized = False
  57.  
  58. End Sub
  59.  
  60. Private Sub DoAllOfCommandBuffer()
  61. 'What this does:
  62. ' If this has never been called before (initialized = false) then set the
  63. 'Comm port and open it.
  64.  
  65. On Error GoTo NoWerk
  66.  
  67. If Not Initialized Then
  68.     MSComm1.CommPort = m_CommPort
  69.     MSComm1.PortOpen = True
  70.     MSComm1.RTSEnable = True
  71.     MSComm1.DTREnable = False
  72.     Initialized = True
  73. End If
  74.  
  75.  
  76. 'What this does:
  77. '  Read the first bit in the commandbuffer, if it's 1 set RTS to low and
  78. ' DTR to high. If it's 0 set RTS to high and DTR to low. Chomp the first
  79. ' bit off of the commandbuffer. Set both DTR and RTS to high so that the
  80. ' firecracker connection doesn't die
  81. '  This is the way that you communicate with the FireCracker plug. To send
  82. ' a 1, RTS = High, DTR = Low, and vice versa for a 0. You send one bit
  83. ' this way, set both RTS and DTR to high, and then repeat for every bit
  84. ' you want to send.
  85.  
  86. '  Keep going until an error (ie: you've run out of bits in the commandbuffer)
  87. ' occurs.
  88.  
  89. Do
  90.     On Error GoTo Exit0
  91.     
  92.     If Val(Left(Commandbuffer, 1)) = 0 Then
  93.         MSComm1.RTSEnable = False
  94.         MSComm1.DTREnable = True
  95.     Else
  96.         MSComm1.RTSEnable = True
  97.         MSComm1.DTREnable = False
  98.     End If
  99.     Commandbuffer = Right(Commandbuffer, Len(Commandbuffer) - 1)
  100.     
  101.     MSComm1.RTSEnable = True
  102.     MSComm1.DTREnable = True
  103.     DoEvents
  104. Loop
  105.  
  106. MSComm1.PortOpen = False
  107. NoWerk:
  108.     MsgBox "There was an error in the FireCraxor control communicating with the FireCracker serial port control."
  109.     Exit Sub
  110. Exit0:
  111. End Sub
  112.  
  113. Private Function GetHouseCode(Letter As String) As String
  114. ' All of this data was gleaned off of
  115. 'http://www.x10.com/manuals/cm17a_proto.txt
  116.  
  117. Select Case Letter
  118.     Case "A":
  119.         GetHouseCode = "0110"
  120.     Case "B":
  121.         GetHouseCode = "0111"
  122.     Case "C":
  123.         GetHouseCode = "0100"
  124.     Case "D":
  125.         GetHouseCode = "0101"
  126.     Case "E":
  127.         GetHouseCode = "1000"
  128.     Case "F":
  129.         GetHouseCode = "1001"
  130.     Case "G":
  131.         GetHouseCode = "1010"
  132.     Case "H":
  133.         GetHouseCode = "1011"
  134.     Case "I":
  135.         GetHouseCode = "1110"
  136.     Case "J":
  137.         GetHouseCode = "1111"
  138.     Case "K":
  139.         GetHouseCode = "1100"
  140.     Case "L":
  141.         GetHouseCode = "1101"
  142.     Case "M":
  143.         GetHouseCode = "0000"
  144.     Case "N":
  145.         GetHouseCode = "0001"
  146.     Case "O":
  147.         GetHouseCode = "0010"
  148.     Case "P":
  149.         GetHouseCode = "0011"
  150. End Select
  151.  
  152. End Function
  153.  
  154. Private Function GetCommand(AppId As Integer, Command As String) As String
  155. ' All of this data was gleaned off of
  156. 'http://www.x10.com/manuals/cm17a_proto.txt
  157.  
  158. If AppId < 9 Then
  159.     GetCommand = "0000"
  160. Else
  161.     GetCommand = "0100"
  162.     AppId = AppId - 8
  163. End If
  164. Select Case AppId & Command
  165.     Case "1ON":
  166.         GetCommand = GetCommand & "00000000"
  167.     Case "1OFF":
  168.         GetCommand = GetCommand & "00100000"
  169.     Case "2ON":
  170.         GetCommand = GetCommand & "00010000"
  171.     Case "2OFF":
  172.         GetCommand = GetCommand & "00110000"
  173.     Case "3ON":
  174.         GetCommand = GetCommand & "00001000"
  175.     Case "3OFF":
  176.         GetCommand = GetCommand & "00101000"
  177.     Case "4ON":
  178.         GetCommand = GetCommand & "00011000"
  179.     Case "4OFF":
  180.         GetCommand = GetCommand & "00111000"
  181.     Case "5ON":
  182.         GetCommand = GetCommand & "01000000"
  183.     Case "5OFF":
  184.         GetCommand = GetCommand & "01100000"
  185.     Case "6ON":
  186.         GetCommand = GetCommand & "01010000"
  187.     Case "6OFF":
  188.         GetCommand = GetCommand & "01110000"
  189.     Case "7ON":
  190.         GetCommand = GetCommand & "01001000"
  191.     Case "7OFF":
  192.         GetCommand = GetCommand & "01101000"
  193.     Case "8ON":
  194.         GetCommand = GetCommand & "01011000"
  195.     Case "8OFF":
  196.         GetCommand = GetCommand & "01111000"
  197. End Select
  198.  
  199. If Command = "BRT" Then
  200.     GetCommand = GetCommand & "10001000"
  201. ElseIf Command = "DIM" Then
  202.     GetCommand = GetCommand & "10011000"
  203. End If
  204.  
  205. End Function
  206.  
  207. 'Nothing but your average run of the mill UserControl variables, get/let
  208. ' crap down here.
  209.  
  210. Public Property Get CommPort() As Integer
  211. CommPort = m_CommPort
  212. End Property
  213.  
  214. Public Property Let CommPort(ByVal New_CommPort As Integer)
  215. m_CommPort = New_CommPort
  216.  
  217. End Property
  218.  
  219. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  220. m_CommPort = PropBag.ReadProperty("CommPort", 1)
  221. End Sub
  222.  
  223. Private Sub UserControl_Resize()
  224. UserControl.Height = 520
  225. UserControl.Width = 520
  226.  
  227. End Sub
  228.  
  229. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  230. PropBag.WriteProperty "CommPort", m_CommPort
  231.  
  232. End Sub
  233.