home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch14 / gradient / gradient.ctl < prev    next >
Encoding:
Text File  |  1997-02-20  |  8.3 KB  |  235 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Gradient 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    ControlContainer=   -1  'True
  9.    PropertyPages   =   "Gradient.ctx":0000
  10.    ScaleHeight     =   240
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   320
  13.    ToolboxBitmap   =   "Gradient.ctx":0020
  14. End
  15. Attribute VB_Name = "Gradient"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = True
  18. Attribute VB_PredeclaredId = False
  19. Attribute VB_Exposed = True
  20. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  21. Option Explicit
  22. Enum Directions
  23. Horizontal
  24. Vertical
  25. End Enum
  26.  
  27. 'Default Property Values:
  28. Const m_def_StartColor = &H404040
  29. Const m_def_EndColor = &HC0C0C0
  30. Const m_def_GradientDirection = Directions.Horizontal
  31. 'Property Variables:
  32. Dim m_StartColor As OLE_COLOR
  33. Dim m_EndColor As OLE_COLOR
  34. Dim m_GradientDirection As Directions
  35.  
  36. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  37. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  38. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  39. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  40. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  41. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  42. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  43. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  44.  
  45. ' SUPPORT FUNCTIONS
  46. Function GetRed(colorVal As Long) As Integer
  47.      GetRed = colorVal Mod 256
  48. End Function
  49.  
  50. Function GetGreen(colorVal As Long) As Integer
  51.     GetGreen = ((colorVal And &HFF00FF00) / 256&)
  52. End Function
  53.  
  54. Function GetBlue(colorVal As Long) As Integer
  55.     GetBlue = (colorVal And &HFF0000) / (256& * 256&)
  56. End Function
  57.  
  58. Public Property Get StartColor() As OLE_COLOR
  59.     StartColor = m_StartColor
  60. End Property
  61.  
  62. Public Property Let StartColor(ByVal New_StartColor As OLE_COLOR)
  63.     m_StartColor = New_StartColor
  64.     PropertyChanged "StartColor"
  65.     UserControl_Paint
  66. End Property
  67.  
  68. Public Property Get EndColor() As OLE_COLOR
  69.     EndColor = m_EndColor
  70. End Property
  71.  
  72. Public Property Let EndColor(ByVal New_EndColor As OLE_COLOR)
  73.     m_EndColor = New_EndColor
  74.     PropertyChanged "EndColor"
  75.     UserControl_Paint
  76. End Property
  77.  
  78. Public Property Get GradientDirection() As Directions
  79.     GradientDirection = m_GradientDirection
  80. End Property
  81.  
  82. Public Property Let GradientDirection(ByVal New_GradientDirection As Directions)
  83.     m_GradientDirection = New_GradientDirection
  84.     PropertyChanged "GradientDirection"
  85.     UserControl_Paint
  86. End Property
  87.  
  88.  
  89. 'Initialize Properties for User Control
  90. Private Sub UserControl_InitProperties()
  91.     m_StartColor = m_def_StartColor
  92.     m_EndColor = m_def_EndColor
  93.     m_GradientDirection = m_def_GradientDirection
  94. End Sub
  95.  
  96.  
  97. Private Sub UserControl_Paint()
  98. Dim newColor As Long
  99. Dim ipixel, PSize As Integer
  100. Dim redInc, greenInc, blueInc As Single
  101. Dim color1 As Long, color2 As Long
  102. Dim startRed, startGreen, startBlue As Integer
  103. Dim endRed, endGreen, endBlue As Integer
  104.  
  105.     color1 = m_StartColor
  106.     color2 = m_EndColor
  107.     
  108.     startRed = GetRed(color1)
  109.     endRed = GetRed(color2)
  110.     startGreen = GetGreen(color1)
  111.     endGreen = GetGreen(color2)
  112.     startBlue = GetBlue(color1)
  113.     endBlue = GetBlue(color2)
  114.         
  115.     If m_GradientDirection = 0 Then
  116.         PSize = UserControl.ScaleWidth
  117.     Else
  118.         PSize = UserControl.ScaleHeight
  119.     End If
  120.     
  121.     redInc = (endRed - startRed) / PSize
  122.     greenInc = (endGreen - startGreen) / PSize
  123.     blueInc = (endBlue - startBlue) / PSize
  124.     
  125.     If m_GradientDirection = 0 Then
  126.         For ipixel = 0 To PSize
  127.             newColor = RGB(startRed + redInc * ipixel, startGreen + greenInc * ipixel, startBlue + blueInc * ipixel)
  128.             UserControl.Line (ipixel, 0)-(ipixel, UserControl.Height), newColor
  129.         Next
  130.     Else
  131.         For ipixel = 0 To PSize
  132.             newColor = RGB(startRed + redInc * ipixel, startGreen + greenInc * ipixel, startBlue + blueInc * ipixel)
  133.             UserControl.Line (0, ipixel)-(UserControl.Width, ipixel), newColor
  134.         Next
  135.     End If
  136.     If Not Ambient.UserMode Then
  137.         UserControl.CurrentX = 0
  138.         UserControl.CurrentY = 0
  139.         UserControl.Print "Design Mode"
  140.     End If
  141. End Sub
  142.  
  143. 'Load property values from storage
  144. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  145.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  146.     UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
  147.     m_StartColor = PropBag.ReadProperty("StartColor", m_def_StartColor)
  148.     m_EndColor = PropBag.ReadProperty("EndColor", m_def_EndColor)
  149.     m_GradientDirection = PropBag.ReadProperty("GradientDirection", m_def_GradientDirection)
  150.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  151.     UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
  152. End Sub
  153.  
  154. 'Write property values to storage
  155. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  156.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  157.     Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 1)
  158.     Call PropBag.WriteProperty("StartColor", m_StartColor, m_def_StartColor)
  159.     Call PropBag.WriteProperty("EndColor", m_EndColor, m_def_EndColor)
  160.     Call PropBag.WriteProperty("GradientDirection", m_GradientDirection, m_def_GradientDirection)
  161.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  162.     Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 1)
  163. End Sub
  164.  
  165. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  166. 'MappingInfo=UserControl,UserControl,-1,Enabled
  167. Public Property Get Enabled() As Boolean
  168. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  169.     Enabled = UserControl.Enabled
  170. End Property
  171.  
  172. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  173.     UserControl.Enabled() = New_Enabled
  174.     PropertyChanged "Enabled"
  175. End Property
  176.  
  177. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  178. 'MappingInfo=UserControl,UserControl,-1,BorderStyle
  179. Public Property Get BorderStyle() As Integer
  180. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  181.     BorderStyle = UserControl.BorderStyle
  182. End Property
  183.  
  184. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  185.     UserControl.BorderStyle() = New_BorderStyle
  186.     PropertyChanged "BorderStyle"
  187. End Property
  188.  
  189. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  190. 'MappingInfo=UserControl,UserControl,-1,Refresh
  191. Public Sub Refresh()
  192. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  193.     UserControl.Refresh
  194. End Sub
  195.  
  196. Private Sub UserControl_Click()
  197.     RaiseEvent Click
  198. End Sub
  199.  
  200. Private Sub UserControl_DblClick()
  201.     RaiseEvent DblClick
  202. End Sub
  203.  
  204. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  205.     RaiseEvent KeyDown(KeyCode, Shift)
  206. End Sub
  207.  
  208. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  209.     RaiseEvent KeyPress(KeyAscii)
  210. End Sub
  211.  
  212. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  213.     RaiseEvent KeyUp(KeyCode, Shift)
  214. End Sub
  215.  
  216. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  217.     RaiseEvent MouseDown(Button, Shift, X, Y)
  218. End Sub
  219.  
  220. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  221.     RaiseEvent MouseMove(Button, Shift, X, Y)
  222. End Sub
  223.  
  224. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  225.     RaiseEvent MouseUp(Button, Shift, X, Y)
  226. End Sub
  227.  
  228. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  229. 'MappingInfo=UserControl,UserControl,-1,Appearance
  230. Public Property Get Appearance() As Integer
  231. Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
  232.     Appearance = UserControl.Appearance
  233. End Property
  234.  
  235.