home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch21 / rates / ratectrl.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-05-20  |  9.4 KB  |  221 lines
  1. VERSION 5.00
  2. Begin VB.UserControl RateControl 
  3.    ClientHeight    =   3600
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   4800
  7.    ScaleHeight     =   3600
  8.    ScaleWidth      =   4800
  9.    Begin VB.ListBox CurrencyList 
  10.       Height          =   2790
  11.       Left            =   15
  12.       TabIndex        =   0
  13.       Top             =   15
  14.       Width           =   2415
  15.    End
  16. Attribute VB_Name = "RateControl"
  17. Attribute VB_GlobalNameSpace = False
  18. Attribute VB_Creatable = True
  19. Attribute VB_PredeclaredId = False
  20. Attribute VB_Exposed = True
  21. Dim AllRates As New Collection
  22. Dim m_LastUpdate As Date
  23. 'Event Declarations:
  24. Event Click() 'MappingInfo=CurrencyList,CurrencyList,-1,Click
  25. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  26. Event DblClick() 'MappingInfo=CurrencyList,CurrencyList,-1,DblClick
  27. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  28. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=CurrencyList,CurrencyList,-1,KeyDown
  29. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  30. Event KeyPress(KeyAscii As Integer) 'MappingInfo=CurrencyList,CurrencyList,-1,KeyPress
  31. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  32. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=CurrencyList,CurrencyList,-1,KeyUp
  33. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  34. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=CurrencyList,CurrencyList,-1,MouseDown
  35. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  36. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=CurrencyList,CurrencyList,-1,MouseMove
  37. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  38. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=CurrencyList,CurrencyList,-1,MouseUp
  39. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  40. Public Event RatesRead()
  41. Public Event DLoadError(ErrNumber As Long, ErrDescription As String)
  42. Private Sub UserControl_Resize()
  43.     CurrencyList.Enabled = False
  44.     CurrencyList.Width = UserControl.Width
  45.     CurrencyList.Height = UserControl.Height
  46.     CurrencyList.Enabled = True
  47. End Sub
  48. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  49. 'MappingInfo=CurrencyList,CurrencyList,-1,BackColor
  50. Public Property Get BackColor() As OLE_COLOR
  51. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  52.     BackColor = CurrencyList.BackColor
  53. End Property
  54. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  55.     CurrencyList.BackColor() = New_BackColor
  56.     PropertyChanged "BackColor"
  57. End Property
  58. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  59. 'MappingInfo=CurrencyList,CurrencyList,-1,ForeColor
  60. Public Property Get ForeColor() As OLE_COLOR
  61. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  62.     ForeColor = CurrencyList.ForeColor
  63. End Property
  64. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  65.     CurrencyList.ForeColor() = New_ForeColor
  66.     PropertyChanged "ForeColor"
  67. End Property
  68. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  69. 'MappingInfo=UserControl,UserControl,-1,Enabled
  70. Public Property Get Enabled() As Boolean
  71. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  72.     Enabled = UserControl.Enabled
  73. End Property
  74. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  75.     UserControl.Enabled() = New_Enabled
  76.     PropertyChanged "Enabled"
  77. End Property
  78. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  79. 'MappingInfo=CurrencyList,CurrencyList,-1,Font
  80. Public Property Get Font() As Font
  81. Attribute Font.VB_Description = "Returns a Font object."
  82. Attribute Font.VB_UserMemId = -512
  83.     Set Font = CurrencyList.Font
  84. End Property
  85. Public Property Set Font(ByVal New_Font As Font)
  86.     Set CurrencyList.Font = New_Font
  87.     PropertyChanged "Font"
  88. End Property
  89. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  90. 'MappingInfo=CurrencyList,CurrencyList,-1,Refresh
  91. Public Sub Refresh()
  92. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  93.     CurrencyList.Refresh
  94. End Sub
  95. Private Sub CurrencyList_Click()
  96.     RaiseEvent Click
  97. End Sub
  98. Private Sub CurrencyList_DblClick()
  99.     RaiseEvent DblClick
  100. End Sub
  101. Private Sub CurrencyList_KeyDown(KeyCode As Integer, Shift As Integer)
  102.     RaiseEvent KeyDown(KeyCode, Shift)
  103. End Sub
  104. Private Sub CurrencyList_KeyPress(KeyAscii As Integer)
  105.     RaiseEvent KeyPress(KeyAscii)
  106. End Sub
  107. Private Sub CurrencyList_KeyUp(KeyCode As Integer, Shift As Integer)
  108.     RaiseEvent KeyUp(KeyCode, Shift)
  109. End Sub
  110. Private Sub CurrencyList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  111.     RaiseEvent MouseDown(Button, Shift, X, Y)
  112. End Sub
  113. Private Sub CurrencyList_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  114.     RaiseEvent MouseMove(Button, Shift, X, Y)
  115. End Sub
  116. Private Sub CurrencyList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  117.     RaiseEvent MouseUp(Button, Shift, X, Y)
  118. End Sub
  119. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  120. 'MemberInfo=3,1,2,0
  121. Public Property Get LastUpdate() As Date
  122. Attribute LastUpdate.VB_MemberFlags = "400"
  123.     LastUpdate = m_LastUpdate
  124. End Property
  125. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  126. 'MemberInfo=8,1,2,0
  127. Public Property Get Count() As Long
  128. Attribute Count.VB_MemberFlags = "400"
  129.     Count = AllRates.Count
  130. End Property
  131. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  132. 'MemberInfo=13
  133. Public Function GetCurrencyName(index As Long) As String
  134.     If index < 1 Or index > AllRates.Count Then
  135.         GetCurrencyName = ""
  136.     Else
  137.         cName = CurrencyList.List(index - 1)
  138.         sPos = InStr(cName, Chr(9))
  139.         If sPos = 0 Then
  140.             GetCurrencyName = ""
  141.         Else
  142.             GetCurrencyName = Left(cName, sPos - 1)
  143.         End If
  144.     End If
  145. End Function
  146. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  147. 'MemberInfo=2
  148. Public Function GetCurrencyRate(currencyName As String) As Currency
  149.     On Error GoTo UnknownRate
  150.     GetCurrencyRate = AllRates.Item(currencyName)
  151.     Exit Function
  152. UnknownRate:
  153.     getcurrency = -1
  154. End Function
  155. 'Initialize Properties for User Control
  156. Private Sub UserControl_InitProperties()
  157.     m_LastUpdate = m_def_LastUpdate
  158.     m_Count = m_def_Count
  159. End Sub
  160. 'Load property values from storage
  161. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  162.     CurrencyList.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  163.     CurrencyList.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
  164.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  165.     Set CurrencyList.Font = PropBag.ReadProperty("Font", Ambient.Font)
  166.     m_LastUpdate = PropBag.ReadProperty("LastUpdate", m_def_LastUpdate)
  167.     m_Count = PropBag.ReadProperty("Count", m_def_Count)
  168. End Sub
  169. 'Write property values to storage
  170. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  171.     Call PropBag.WriteProperty("BackColor", CurrencyList.BackColor, &H8000000F)
  172.     Call PropBag.WriteProperty("ForeColor", CurrencyList.ForeColor, &H80000008)
  173.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  174.     Call PropBag.WriteProperty("Font", CurrencyList.Font, Ambient.Font)
  175.     Call PropBag.WriteProperty("LastUpdate", m_LastUpdate, m_def_LastUpdate)
  176.     Call PropBag.WriteProperty("Count", m_Count, m_def_Count)
  177. End Sub
  178. Public Function DownloadRates(RatesURL As String)
  179. On Error GoTo DLoadError
  180.     AsyncRead RatesURL, vbAsyncTypeFile, "Rates"
  181.     Exit Function
  182. DLoadError:
  183.     RaiseEvent DLoadError(1024, "Could not download currency rates.")
  184. End Function
  185. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  186. Dim FileName As String
  187. On Error GoTo DLoadError
  188.     If AsyncProp.PropertyName = "Rates" Then
  189.         FileName = AsyncProp.Value
  190.         ReadRates FileName
  191.     End If
  192.     Exit Sub
  193. DLoadError:
  194.     RaiseEvent DLoadError(1025, "Error in Downloading rates ")
  195. End Sub
  196. Private Sub ReadRates(FileName As String)
  197. Dim FNum As Integer
  198. Dim currencyName As String, currencyValue As Currency
  199. Dim DTLine As String
  200. Dim i As Long
  201.     FNum = FreeFile
  202.     CurrencyList.Clear
  203.     For i = AllRates.Count To 1 Step -1
  204.         AllRates.Remove i
  205.     Next
  206. On Error GoTo ReadError
  207.     Open FileName For Input As FNum
  208.     Input #FNum, DTLine
  209.     m_LastUpdate = DTLine
  210.     While Not EOF(FNum)
  211.         Input #FNum, currencyName, currencyValue
  212.         CurrencyList.AddItem currencyName & Chr(9) & Format(currencyValue, "#.000")
  213.         AllRates.Add Str(currencyValue), currencyName
  214.     Wend
  215.     Close #FNum
  216.     RaiseEvent RatesRead
  217.     Exit Sub
  218. ReadError:
  219.     RaiseEvent DLoadError(1025, "Unkown data format")
  220. End Sub
  221.