home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 December / WIN95_DEC_1996_2.ISO / htmlmisc / vb5ccein.exe / RCDATA / CABINET / Marquee.ctl < prev    next >
Text File  |  1996-10-24  |  12KB  |  408 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AXMarquee 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H8000000D&
  6.    ClientHeight    =   2736
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4608
  10.    PropertyPages   =   "Marquee.ctx":0000
  11.    ScaleHeight     =   228
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   384
  14.    ToolboxBitmap   =   "Marquee.ctx":0011
  15.    Begin VB.PictureBox picBlankCol 
  16.       Appearance      =   0  'Flat
  17.       AutoSize        =   -1  'True
  18.       BackColor       =   &H80000005&
  19.       BorderStyle     =   0  'None
  20.       ForeColor       =   &H80000008&
  21.       Height          =   552
  22.       Left            =   420
  23.       Picture         =   "Marquee.ctx":010B
  24.       ScaleHeight     =   46
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   5
  27.       TabIndex        =   2
  28.       Top             =   672
  29.       Visible         =   0   'False
  30.       Width           =   60
  31.    End
  32.    Begin VB.PictureBox picCaps 
  33.       Appearance      =   0  'Flat
  34.       AutoSize        =   -1  'True
  35.       BackColor       =   &H80000005&
  36.       BorderStyle     =   0  'None
  37.       ForeColor       =   &H80000008&
  38.       Height          =   432
  39.       Left            =   -2148
  40.       Picture         =   "Marquee.ctx":06BD
  41.       ScaleHeight     =   28.8
  42.       ScaleMode       =   0  'User
  43.       ScaleWidth      =   711.68
  44.       TabIndex        =   1
  45.       Top             =   2130
  46.       Width           =   10680
  47.    End
  48.    Begin VB.PictureBox picMsg 
  49.       Appearance      =   0  'Flat
  50.       AutoRedraw      =   -1  'True
  51.       BackColor       =   &H80000005&
  52.       BorderStyle     =   0  'None
  53.       ForeColor       =   &H80000008&
  54.       Height          =   540
  55.       Left            =   0
  56.       ScaleHeight     =   45
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   98
  59.       TabIndex        =   0
  60.       Top             =   1485
  61.       Width           =   1170
  62.    End
  63.    Begin VB.Timer tAni 
  64.       Enabled         =   0   'False
  65.       Interval        =   50
  66.       Left            =   204
  67.       Top             =   156
  68.    End
  69. End
  70. Attribute VB_Name = "AXMarquee"
  71. Attribute VB_GlobalNameSpace = False
  72. Attribute VB_Creatable = True
  73. Attribute VB_PredeclaredId = False
  74. Attribute VB_Exposed = True
  75. Attribute VB_Description = "ActiveX Marquee Control"
  76. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  77. Option Explicit
  78.  
  79. Enum ScrollModeValue
  80.   R_to_L = 0
  81.   L_to_R = 1
  82. End Enum
  83.  
  84. 'Vars for tracking BMP size and position
  85. Private lBMPWidth   As Long     'Total width of the Message Bitmap to be drawn on the background
  86. Private bRestart    As Boolean
  87. Private lCtlWidth   As Long     'Corrected bitmap width for drawing - rounded up to multiple of 5
  88.  
  89. 'Y position of where the Message Bitmap will be drawn on the background
  90. Const SRC_Y = 0
  91.  
  92. 'Height of the control - don't allow it to change
  93. Const CTL_HEIGHT = 683    'Twips
  94.  
  95. 'Default Property Values:
  96. Const m_def_ScrollMode = R_to_L
  97. Const m_def_Text = "ActiveX Marquee"
  98. Const m_def_Scrolling = False
  99.  
  100. 'Property Variables:
  101. Dim m_ScrollMode As ScrollModeValue   'Tracks which direction the control scrolls from.
  102. Dim m_Text As String                  'Holds the message text to be displayed.
  103. Dim m_Scrolling As Boolean               'Tracks whether Scrolling is enabled or disabled.
  104.  
  105. Private Sub tAni_Timer()
  106.   Static lX           As Long   'Absolute X postion to track message bitmap
  107.   Static lX2          As Long   'X position on the control to draw the message
  108.   Static lSrcOffset   As Long   'Offset into the Message bitmap
  109.   Static lSrcWidth    As Long   'Width from the offset in the Message bitmap to draw
  110.  
  111.   If bRestart Then
  112.     'Determine which side to scroll from
  113.     If m_ScrollMode = R_to_L Then
  114.       'Scroll Right to Left
  115.       lX = lCtlWidth - BULB_WIDTH
  116.       lSrcOffset = 0
  117.       lSrcWidth = BULB_WIDTH
  118.     Else
  119.       'Assume scroll Left to Right
  120.       lX = BULB_WIDTH
  121.       lSrcOffset = BULB_WIDTH
  122.       lSrcWidth = BULB_WIDTH
  123.     End If
  124.  
  125.     bRestart = False
  126.   End If  'If bRestart
  127.   
  128.   If m_ScrollMode = R_to_L Then
  129.     If lX > 0 Then
  130.       lX2 = lX
  131.       If lCtlWidth - lX <= lBMPWidth Then
  132.         lSrcWidth = lCtlWidth - lX
  133.       Else
  134.         lSrcWidth = lBMPWidth
  135.       End If
  136.     Else ' assume lx <= 0
  137.       lX2 = 0
  138.       lSrcOffset = Abs(lX)
  139.       lSrcWidth = lBMPWidth - lSrcOffset
  140.     End If
  141.   Else  'Assume m_ScrollMode = L_to_R
  142.     If lX < lCtlWidth Then
  143.       If lX <= lBMPWidth Then
  144.         lX2 = 0
  145.         lSrcWidth = lX
  146.         lSrcOffset = lBMPWidth - lX
  147.       Else
  148.         lX2 = lX2 + BULB_WIDTH
  149.         lSrcWidth = lBMPWidth
  150.         lSrcOffset = 0
  151.       End If
  152.     Else  'assume lx >= lctlwidth
  153.       If lX > lBMPWidth Then
  154.         lX2 = lX2 + BULB_WIDTH
  155.         lSrcWidth = lBMPWidth
  156.       Else
  157.         lSrcOffset = lBMPWidth - lX
  158.         lSrcWidth = lCtlWidth
  159.       End If
  160.     End If
  161.   End If
  162.   
  163.   UserControl.PaintPicture picMsg.Picture, lX2, SRC_Y, , , _
  164.                            lSrcOffset, , lSrcWidth, , _
  165.                            vbSrcCopy
  166.   
  167.   If m_ScrollMode = R_to_L Then
  168.     If lSrcOffset + BULB_WIDTH = lBMPWidth Then
  169.       bRestart = True
  170.     Else
  171.       lX = lX - BULB_WIDTH
  172.     End If
  173.   Else  'Assume m_ScrollMode = L_to_R
  174.     If lX2 + BULB_WIDTH = lCtlWidth Then
  175.       bRestart = True
  176.     Else
  177.       lX = lX + BULB_WIDTH
  178.     End If
  179.   End If
  180.   
  181. End Sub
  182.  
  183. Private Sub UserControl_Initialize()
  184.   InitBMPStruct
  185. End Sub
  186.  
  187. 'Initialize Properties for User Control
  188. Private Sub UserControl_InitProperties()
  189.   m_ScrollMode = m_def_ScrollMode
  190.   m_Text = m_def_Text
  191.   m_Scrolling = m_def_Scrolling
  192. End Sub
  193.  
  194. 'Load property values from storage
  195. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  196.   ScrollMode = PropBag.ReadProperty("ScrollMode", m_def_ScrollMode)
  197.   Text = PropBag.ReadProperty("Text", m_def_Text)
  198.   Scrolling = PropBag.ReadProperty("Scrolling", m_def_Scrolling)
  199. End Sub
  200.  
  201. 'Write property values to storage
  202. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  203.   Call PropBag.WriteProperty("ScrollMode", m_ScrollMode, m_def_ScrollMode)
  204.   Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
  205.   
  206.   Call PropBag.WriteProperty("Scrolling", m_Scrolling, m_def_Scrolling)
  207. End Sub
  208.  
  209. Private Sub UserControl_Resize()
  210.   
  211.   'Don't allow the control to change height
  212.   UserControl.Height = CTL_HEIGHT
  213.   
  214.   'Determine the closest LED to begin drawing from
  215.   lCtlWidth = UserControl.ScaleWidth - UserControl.ScaleWidth Mod 5
  216.   
  217.   'Repaint the unlit LED grid
  218.   DrawBackground
  219.   
  220. End Sub
  221.  
  222. Public Property Get Text() As String
  223. Attribute Text.VB_Description = "Text string to display on the marquee"
  224. Attribute Text.VB_ProcData.VB_Invoke_Property = ";Text"
  225.   Text = m_Text
  226. End Property
  227.  
  228. Public Property Let Text(ByVal New_Text As String)
  229.   m_Text = New_Text
  230.   PropertyChanged "Text"
  231.   
  232.   'Force a reset of the Timer painting code since the direction changed.
  233.   If m_Scrolling Then
  234.     tAni.Enabled = False
  235.     bRestart = True
  236.     DrawBackground
  237.     BuildTheBmp (m_Text)
  238.     tAni.Enabled = True
  239.   Else
  240.     tAni.Enabled = False
  241.     bRestart = False
  242.   End If
  243.  
  244. End Property
  245.  
  246. Public Property Get Scrolling() As Boolean
  247. Attribute Scrolling.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  248. Attribute Scrolling.VB_ProcData.VB_Invoke_Property = ";Behavior"
  249.   Scrolling = m_Scrolling
  250. End Property
  251.  
  252. Public Property Let Scrolling(ByVal bScrolling As Boolean)
  253.   
  254.   m_Scrolling = bScrolling
  255.   
  256.   PropertyChanged "Scrolling"
  257.   
  258.   If m_Scrolling Then
  259.     DrawBackground
  260.     BuildTheBmp (m_Text)
  261.     tAni.Enabled = True
  262.   Else
  263.     tAni.Enabled = False
  264.     bRestart = False
  265.   End If
  266.   
  267. End Property
  268.  
  269. Public Property Get ScrollMode() As ScrollModeValue
  270.   ScrollMode = m_ScrollMode
  271. End Property
  272.  
  273. Public Property Let ScrollMode(ByVal New_ScrollMode As ScrollModeValue)
  274.   m_ScrollMode = New_ScrollMode
  275.   PropertyChanged "ScrollMode"
  276.   
  277.   'Force a reset of the Timer painting code since the direction changed.
  278.   If m_Scrolling Then
  279.     tAni.Enabled = False
  280.     bRestart = True
  281.     DrawBackground
  282.     BuildTheBmp (m_Text)
  283.     tAni.Enabled = True
  284.   Else
  285.     tAni.Enabled = False
  286.     bRestart = False
  287.   End If
  288.  
  289. End Property
  290.  
  291. Private Sub DrawBackground()
  292.   Dim lColX As Long
  293.   
  294.   With UserControl
  295.         
  296.     'Turn this on so that what is drawn becomes part of the UserControl's picture.
  297.     .AutoRedraw = True
  298.     
  299.     For lColX = 0 To .ScaleWidth Step 5  'Unlit columns are 5 pixels wide
  300.     
  301.       .PaintPicture picBlankCol.Picture, lColX, 0, _
  302.                     aCharSpace.Width, , _
  303.                     aCharSpace.Left, 0, _
  304.                     aCharSpace.Width
  305.     
  306.     Next lColX
  307.     
  308.     'Turn off so painting performance is faster
  309.     .AutoRedraw = False
  310.     
  311.   End With 'UserControl
  312.   
  313. End Sub
  314.  
  315. Private Function BuildTheBmp(sText As String) As Long
  316.   Dim lChar     As Long     'Character in the string that we are working on.
  317.   Dim lOffset   As Long     'Tracks the offset into the destination bitmap.
  318.   Dim lCharVal  As Long     'Value of the character at the current offset.
  319.   Dim lCounter  As Long     'Temp counter
  320.   Dim lMsgLength As Long    'Length of the message string
  321.   
  322.   'No support for lower case yet...  Convert all msgs to uppercase.
  323.   sText = UCase$(sText)
  324.   lMsgLength = Len(sText)
  325.   
  326.   With picMsg
  327.   
  328.     'Set to true so the drawing will become part of the picture property.
  329.     .AutoRedraw = True
  330.     
  331.     'Calculating the width of the picture first by accessing the array values in memory is
  332.     'much faster than setting the .Width property each time through the loops below.
  333.     For lChar = 1 To lMsgLength
  334.       lCharVal = Asc(Mid$(sText, lChar, 1))
  335.       If lCharVal = 32 Then 'A space
  336.         For lCounter = 1 To 4
  337.           lOffset = lOffset + aCharSpace.Width
  338.         Next lCounter
  339.       
  340.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  341.         lOffset = lOffset + aChars(lCharVal).Width  'Make the Picture wide enough to handle the bitmap
  342.       End If
  343.       
  344.     Next lChar
  345.     
  346.     'Set the picture control to the total width of the message to be created.
  347.     .Width = lOffset + aCharSpace.Width
  348.     
  349.     lOffset = 0
  350.     
  351.     For lChar = 1 To lMsgLength
  352.       
  353.       'Get the ASCII value of the character - This is the index into the bmp array.
  354.       lCharVal = Asc(Mid$(sText, lChar, 1))
  355.       
  356.       If lCharVal = 32 Then 'A space
  357.       
  358.         For lCounter = 1 To 4
  359.           .PaintPicture picCaps.Picture, lOffset, 0, _
  360.                         aCharSpace.Width, , _
  361.                         aCharSpace.Left, 0, _
  362.                         aCharSpace.Width
  363.           
  364.           lOffset = lOffset + aCharSpace.Width
  365.  
  366.         Next lCounter
  367.               
  368.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  369.             
  370.         'Paint the region conaining the desired character onto the Msg picturebox at
  371.         'at offset lOffset.
  372.         .PaintPicture picCaps.Picture, lOffset, 0, _
  373.                       aChars(lCharVal).Width, , _
  374.                       aChars(lCharVal).Left, 0, _
  375.                       aChars(lCharVal).Width
  376.                       
  377.         'Increment lOffset by the width of the last Bmp painted on the Msg picturebox.
  378.         lOffset = lOffset + aChars(lCharVal).Width
  379.       
  380.       Else
  381.         Debug.Print "Unsupported character entered - " & Mid$(sText, lChar, 1) & "ASCII = " & Asc(Mid$(sText, lChar, 1))
  382.       
  383.       End If
  384.       
  385.     Next lChar
  386.     
  387.     'Add a blank row of LEDs to the end of the message
  388.     .PaintPicture picCaps.Picture, lOffset, 0, _
  389.                   aCharSpace.Width, , _
  390.                   aCharSpace.Left, 0, _
  391.                   aCharSpace.Width
  392.                   
  393.     lOffset = lOffset + aCharSpace.Width
  394.     
  395.     'Now that we're done drawing turn this off for better paint performance.
  396.     .AutoRedraw = False
  397.     
  398.     .Picture = picMsg.Image
  399.     
  400.   End With  'picMsg
  401.   
  402.     lBMPWidth = lOffset
  403.   
  404.   BuildTheBmp = 0
  405.   
  406.   bRestart = True
  407. End Function
  408.