home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD36202262000.psc / DevFade.ctl next >
Encoding:
Text File  |  2000-02-26  |  7.9 KB  |  262 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Fade 
  3.    AutoRedraw      =   -1  'True
  4.    BackStyle       =   0  'Transparent
  5.    ClientHeight    =   1860
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   2745
  9.    ScaleHeight     =   1860
  10.    ScaleWidth      =   2745
  11.    ToolboxBitmap   =   "DevFade.ctx":0000
  12.    Begin VB.PictureBox Pic1 
  13.       AutoRedraw      =   -1  'True
  14.       BorderStyle     =   0  'None
  15.       ClipControls    =   0   'False
  16.       BeginProperty Font 
  17.          Name            =   "Arial"
  18.          Size            =   9.75
  19.          Charset         =   0
  20.          Weight          =   400
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       HasDC           =   0   'False
  26.       Height          =   1455
  27.       Left            =   0
  28.       ScaleHeight     =   1455
  29.       ScaleWidth      =   2295
  30.       TabIndex        =   0
  31.       Top             =   0
  32.       Width           =   2295
  33.    End
  34. End
  35. Attribute VB_Name = "Fade"
  36. Attribute VB_GlobalNameSpace = False
  37. Attribute VB_Creatable = True
  38. Attribute VB_PredeclaredId = False
  39. Attribute VB_Exposed = True
  40. '   Dev Fade OCX By Dev
  41.  
  42. '   http://www.brechin.clara.net/
  43.  
  44. Private m_bEnabled As Boolean
  45. Dim txt As String, col1 As Long, col2 As Long
  46.  
  47. Event DblClick()
  48. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  49. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  50. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  51. Event Click()
  52. Event Resize()
  53.  
  54.  
  55. Public Sub FadeTxT(ByVal canvas As Object, ByVal start_x As Single, ByVal start_y As Single, ByVal txt As String)
  56. Attribute FadeTxT.VB_MemberFlags = "40"
  57. Dim r As Single, g As Single, b As Single
  58. Dim blue1, red1, green1
  59. Dim blue2, red2, green2
  60. Dim txt_len As Integer
  61. Dim i As Integer
  62.  
  63. blue1 = Int(col1 / 65536)
  64. green1 = Int((col1 - (blue1 * 65536)) / 256)
  65. red1 = col1 - (blue1 * 65536) - (green1 * 256)
  66.  
  67. blue2 = Int(col2 / 65536)
  68. green2 = Int((col2 - (blue2 * 65536)) / 256)
  69. red2 = col2 - (blue2 * 65536) - (green2 * 256)
  70.  
  71.     txt_len = Len(txt)
  72.     dr = (red2 - red1) / (txt_len - 1)
  73.     dg = (green2 - green1) / (txt_len - 1)
  74.     db = (blue2 - blue1) / (txt_len - 1)
  75.     r = red1
  76.     g = green1
  77.     b = blue1
  78.     canvas.CurrentX = start_x
  79.     canvas.CurrentY = start_y
  80.     For i = 1 To txt_len
  81.         canvas.ForeColor = RGB(r, g, b)
  82.         canvas.Print Mid$(txt, i, 1);
  83.         r = r + dr
  84.         g = g + dg
  85.         b = b + db
  86.     Next i
  87. End Sub
  88.  
  89. Public Sub Refresh()
  90.     Pic1.Cls
  91.     FadeTxT UserControl.Pic1, 20, 20, txt
  92.     Pic1.Refresh
  93. End Sub
  94.  
  95. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  96.    m_bRunTime = (UserControl.Ambient.UserMode)
  97.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  98.  
  99.     UserControl.Pic1.BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
  100.     col1 = PropBag.ReadProperty("Color1", vbRed)
  101.     col2 = PropBag.ReadProperty("Color2", vbBlack)
  102.         
  103.     UserControl.Pic1.FontBold = PropBag.ReadProperty("FontBold", 0)
  104.     UserControl.Pic1.FontItalic = PropBag.ReadProperty("FontItalic", 0)
  105.     Set UserControl.Pic1.Font = PropBag.ReadProperty("Font", "Arial")
  106.  
  107.     UserControl.Pic1.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  108.     txt = PropBag.ReadProperty("Caption", "Dev Fade")
  109.     Pic1.FontUnderline = PropBag.ReadProperty("FontUnderline", 0)
  110. End Sub
  111.  
  112. Private Sub UserControl_Resize()
  113. Pic1.Width = UserControl.Width
  114. Pic1.Height = UserControl.Height
  115. Pic1.Cls
  116. FadeTxT UserControl.Pic1, 20, 20, txt
  117. End Sub
  118.  
  119. Private Sub UserControl_Show()
  120. FadeTxT UserControl.Pic1, 20, 20, txt
  121. End Sub
  122.  
  123. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  124.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  125.  
  126.     Call PropBag.WriteProperty("Color1", col1, vbRed)
  127.     Call PropBag.WriteProperty("Color2", col2, vbBlack)
  128.     Call PropBag.WriteProperty("BackColor", UserControl.Pic1.BackColor, vbButtonFace)
  129.     
  130.     Call PropBag.WriteProperty("FontBold", UserControl.Pic1.FontBold, 0)
  131.     Call PropBag.WriteProperty("FontItalic", UserControl.Pic1.FontItalic, 0)
  132.     Call PropBag.WriteProperty("FontUnderline", Pic1.FontUnderline, 0)
  133.     Call PropBag.WriteProperty("Font", UserControl.Pic1.Font, "Arial")
  134.     
  135.     Call PropBag.WriteProperty("BorderStyle", UserControl.Pic1.BorderStyle, 0)
  136.  
  137.     Call PropBag.WriteProperty("Caption", txt, "Dev Fade")
  138. End Sub
  139.  
  140. Public Property Get Enabled() As Boolean
  141. Attribute Enabled.VB_Description = "Returns/sets a value that determines whever the control can respond to user-generated events such as clicking."
  142.     Enabled = UserControl.Enabled
  143. End Property
  144.  
  145. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  146.     UserControl.Enabled() = New_Enabled
  147.     Pic1.Enabled() = New_Enabled
  148.     PropertyChanged "Enabled"
  149. End Property
  150. '
  151.  
  152. 'Initialize Properties for User Control
  153. Private Sub UserControl_InitProperties()
  154.     txt = "Dev Fade"
  155.     col1 = vbBlack
  156.     col2 = vbRed
  157. End Sub
  158.  
  159.  
  160. Public Property Get Color1() As OLE_COLOR
  161. Attribute Color1.VB_Description = "Returns/set the first text color in the fade."
  162.   Color1 = col1
  163. End Property
  164.  
  165. Public Property Let Color1(ByVal c As OLE_COLOR)
  166.   col1 = c
  167.   Call Refresh
  168. End Property
  169.  
  170. Public Property Get Color2() As OLE_COLOR
  171. Attribute Color2.VB_Description = "Returns/set the second text color in the fade."
  172.   Color2 = col2
  173. End Property
  174.  
  175. Public Property Let Color2(ByVal c As OLE_COLOR)
  176.     col2 = c
  177.     Call Refresh
  178. End Property
  179.  
  180. Public Sub AboutBox()
  181. Attribute AboutBox.VB_UserMemId = -552
  182.     FrmAbout.Show vbModal
  183. End Sub
  184.  
  185. Public Property Get Font() As Font
  186. Attribute Font.VB_Description = "Returns a Font object."
  187. Attribute Font.VB_UserMemId = -512
  188.     Set Font = UserControl.Pic1.Font
  189. End Property
  190.  
  191. Public Property Set Font(ByVal New_Font As Font)
  192.     Set UserControl.Pic1.Font = New_Font
  193.     PropertyChanged "Font"
  194.     
  195.     Pic1.Cls
  196.     FadeTxT UserControl.Pic1, 20, 20, txt
  197. End Property
  198.  
  199. Public Property Get BackColor() As OLE_COLOR
  200. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in the control."
  201.     BackColor = Pic1.BackColor
  202. End Property
  203.  
  204. Public Property Let BackColor(c As OLE_COLOR)
  205. Pic1.BackColor = c
  206. FadeTxT UserControl.Pic1, 20, 20, txt
  207. End Property
  208.  
  209. Public Property Get FontBold() As Boolean
  210. Attribute FontBold.VB_Description = "Returns/sets bold font styles."
  211.     FontBold = Pic1.FontBold
  212.     Call Refresh
  213. End Property
  214.  
  215. Public Property Get FontItalic() As Boolean
  216. Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
  217.     FontItalic = Pic1.FontItalic
  218.     Call Refresh
  219. End Property
  220.  
  221. Public Property Get Caption() As Variant
  222. Attribute Caption.VB_Description = "Returns/Sets text displayed in the control."
  223. Attribute Caption.VB_UserMemId = 0
  224.     Caption = txt
  225. End Property
  226.  
  227. Public Property Let Caption(ByVal vNewValue As Variant)
  228.   If Len(vNewValue) > 1 Then
  229.     txt = vNewValue
  230.     UserControl.Pic1.Cls
  231.     FadeTxT UserControl.Pic1, 20, 20, txt
  232.   Else
  233.   MsgBox "Caption must contain 2 or more characters.", vbCritical, "Error"
  234.   End If
  235. End Property
  236.  
  237. Private Sub Pic1_DblClick()
  238.     RaiseEvent DblClick
  239. End Sub
  240.  
  241. Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  242.     RaiseEvent MouseDown(Button, Shift, X, Y)
  243. End Sub
  244.  
  245. Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  246.     RaiseEvent MouseMove(Button, Shift, X, Y)
  247. End Sub
  248.  
  249. Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  250.     RaiseEvent MouseUp(Button, Shift, X, Y)
  251. End Sub
  252.  
  253. Private Sub Pic1_Click()
  254.     RaiseEvent Click
  255. End Sub
  256.  
  257. Public Property Get FontUnderline() As Boolean
  258. Attribute FontUnderline.VB_Description = "Returns/sets underline font styles."
  259.     FontUnderline = Pic1.FontUnderline
  260.     Call Refresh
  261. End Property
  262.