home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 March / VPR9703A.ISO / MS_DEV / VBCCE / SAMPLES / AXMrquis / AXMrquis.EXE / RCDATA / CABINET / Marquis.ctl < prev    next >
Text File  |  1996-10-22  |  12KB  |  396 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AXMarquis 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H8000000D&
  6.    ClientHeight    =   2730
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4605
  10.    PropertyPages   =   "Marquis.ctx":0000
  11.    ScaleHeight     =   182
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   307
  14.    ToolboxBitmap   =   "Marquis.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          =   690
  22.       Left            =   420
  23.       Picture         =   "Marquis.ctx":010B
  24.       ScaleHeight     =   46
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   5
  27.       TabIndex        =   2
  28.       Top             =   672
  29.       Visible         =   0   'False
  30.       Width           =   75
  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          =   540
  39.       Left            =   -2148
  40.       Picture         =   "Marquis.ctx":06BD
  41.       ScaleHeight     =   36
  42.       ScaleMode       =   0  'User
  43.       ScaleWidth      =   890
  44.       TabIndex        =   1
  45.       Top             =   2130
  46.       Width           =   13350
  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     =   36
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   78
  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 = "AXMarquis"
  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 Marquis 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 = 0
  97. Const m_def_Text = "ActiveX Marquis"
  98. Const m_def_Enabled = False
  99.  
  100. 'Property Variables:
  101. Dim m_ScrollMode As ScrollModeValue
  102. Dim m_Text As String
  103. Dim m_Enabled As Boolean
  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_Enabled = m_def_Enabled
  192. End Sub
  193.  
  194. 'Load property values from storage
  195. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  196.   m_ScrollMode = PropBag.ReadProperty("ScrollMode", m_def_ScrollMode)
  197.   m_Text = PropBag.ReadProperty("Text", m_def_Text)
  198.   'UserControl.Enabled = PropBag.ReadProperty("Enabled", False)
  199.   m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  200. End Sub
  201.  
  202. Private Sub UserControl_Resize()
  203.   
  204.   'Don't allow the control to change height
  205.   UserControl.Height = CTL_HEIGHT
  206.   
  207.   'Determine the closest LED to begin drawing from
  208.   lCtlWidth = UserControl.ScaleWidth - UserControl.ScaleWidth Mod 5
  209.   
  210.   'Repaint the unlit LED grid
  211.   DrawBackground
  212.   
  213. End Sub
  214.  
  215. 'Write property values to storage
  216. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  217.   Call PropBag.WriteProperty("ScrollMode", m_ScrollMode, m_def_ScrollMode)
  218.   Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
  219.   'Call PropBag.WriteProperty("Enabled", UserControl.Enabled, False)
  220.   Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  221. End Sub
  222.  
  223. Public Property Get Text() As String
  224. Attribute Text.VB_Description = "Text string to display on the marquis"
  225. Attribute Text.VB_ProcData.VB_Invoke_Property = ";Text"
  226.   Text = m_Text
  227. End Property
  228.  
  229. Public Property Let Text(ByVal New_Text As String)
  230.   m_Text = New_Text
  231.   PropertyChanged "Text"
  232. End Property
  233.  
  234. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  235. 'MappingInfo=UserControl,UserControl,-1,Enabled
  236. Public Property Get Enabled() As Boolean
  237. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  238. Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
  239.   Enabled = m_Enabled
  240. End Property
  241.  
  242. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  243.   
  244.   UserControl.Enabled = New_Enabled
  245.   m_Enabled = New_Enabled
  246.   
  247.   PropertyChanged "Enabled"
  248.   
  249.   If UserControl.Enabled Then
  250.     DrawBackground
  251.     BuildTheBmp (m_Text)
  252.   Else
  253.     tAni.Enabled = False
  254.     bRestart = False
  255.   End If
  256.   
  257. End Property
  258.  
  259. Public Property Get ScrollMode() As ScrollModeValue
  260.   ScrollMode = m_ScrollMode
  261. End Property
  262.  
  263. Public Property Let ScrollMode(ByVal New_ScrollMode As ScrollModeValue)
  264.   m_ScrollMode = New_ScrollMode
  265.   PropertyChanged "ScrollMode"
  266.   
  267.   'Force a reset of the Timer painting code since the direction changed.
  268.   If m_Enabled Then
  269.     bRestart = True
  270.   End If
  271.   
  272. End Property
  273.  
  274. Private Sub DrawBackground()
  275.   Dim lColX As Long
  276.   
  277.   With UserControl
  278.         
  279.     'Turn this on so that what is drawn becomes part of the UserControl's picture.
  280.     .AutoRedraw = True
  281.     
  282.     For lColX = 0 To .ScaleWidth Step 5  'Unlit columns are 5 pixels wide
  283.     
  284.       .PaintPicture picBlankCol.Picture, lColX, 0, _
  285.                     aCharSpace.Width, , _
  286.                     aCharSpace.Left, 0, _
  287.                     aCharSpace.Width
  288.     
  289.     Next lColX
  290.     
  291.     'Turn off so painting performance is faster
  292.     .AutoRedraw = False
  293.     
  294.   End With 'UserControl
  295.   
  296. End Sub
  297.  
  298. Private Function BuildTheBmp(sText As String) As Long
  299.   Dim lChar     As Long     'Character in the string that we are working on.
  300.   Dim lOffset   As Long     'Tracks the offset into the destination bitmap.
  301.   Dim lCharVal  As Long     'Value of the character at the current offset.
  302.   Dim lCounter  As Long     'Temp counter
  303.   Dim lMsgLength As Long    'Length of the message string
  304.   
  305.   'No support for lower case yet...  Convert all msgs to uppercase.
  306.   sText = UCase$(sText)
  307.   lMsgLength = Len(sText)
  308.   
  309.   With picMsg
  310.   
  311.     'Set to true so the drawing will become part of the picture property.
  312.     .AutoRedraw = True
  313.     
  314.     'Calculating the width of the picture first by accessing the array values in memory is
  315.     'much faster than setting the .Width property each time through the loops below.
  316.     For lChar = 1 To lMsgLength
  317.       lCharVal = Asc(Mid$(sText, lChar, 1))
  318.       If lCharVal = 32 Then 'A space
  319.         For lCounter = 1 To 4
  320.           lOffset = lOffset + aCharSpace.Width
  321.         Next lCounter
  322.       
  323.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  324.         lOffset = lOffset + aChars(lCharVal).Width  'Make the Picture wide enough to handle the bitmap
  325.       End If
  326.       
  327.     Next lChar
  328.     
  329.     'Set the picture control to the total width of the message to be created.
  330.     .Width = lOffset + aCharSpace.Width
  331.     
  332.     lOffset = 0
  333.     
  334.     For lChar = 1 To lMsgLength
  335.       
  336.       'Get the ASCII value of the character - This is the index into the bmp array.
  337.       lCharVal = Asc(Mid$(sText, lChar, 1))
  338.       
  339.       If lCharVal = 32 Then 'A space
  340.       
  341.         For lCounter = 1 To 4
  342. '          .Width = lOffset + aCharSpace.Width  'Make the Picture wide enough to handle the bitmap
  343.           .PaintPicture picCaps.Picture, lOffset, 0, _
  344.                         aCharSpace.Width, , _
  345.                         aCharSpace.Left, 0, _
  346.                         aCharSpace.Width
  347.           
  348.           lOffset = lOffset + aCharSpace.Width
  349.  
  350.         Next lCounter
  351.               
  352.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  353.     
  354. '        .Width = lOffset + aChars(lCharVal).Width  'Make the Picture wide enough to handle the bitmap
  355.         
  356.         'Paint the region conaining the desired character onto the Msg picturebox at
  357.         'at offset lOffset.
  358.         .PaintPicture picCaps.Picture, lOffset, 0, _
  359.                       aChars(lCharVal).Width, , _
  360.                       aChars(lCharVal).Left, 0, _
  361.                       aChars(lCharVal).Width
  362.                       
  363.         'Increment lOffset by the width of the last Bmp painted on the Msg picturebox.
  364.         lOffset = lOffset + aChars(lCharVal).Width
  365.       
  366.       Else
  367.         Debug.Print "Unsupported character entered - " & Mid$(sText, lChar, 1)
  368.       
  369.       End If
  370.       
  371.     Next lChar
  372.     
  373. '    .Width = lOffset + aCharSpace.Width  'Make the Picture wide enough to handle the bitmap
  374.     'Add a blank row of LEDs to the end of the message
  375.     .PaintPicture picCaps.Picture, lOffset, 0, _
  376.                   aCharSpace.Width, , _
  377.                   aCharSpace.Left, 0, _
  378.                   aCharSpace.Width
  379.                   
  380.     lOffset = lOffset + aCharSpace.Width
  381.     
  382.     'Now that we're done drawing turn this off for better paint performance.
  383.     .AutoRedraw = False
  384.     
  385.     .Picture = picMsg.Image
  386.     
  387.   End With  'picMsg
  388.   
  389.     lBMPWidth = lOffset
  390.   
  391.   BuildTheBmp = 0
  392.   
  393.   bRestart = True
  394.   tAni.Enabled = True
  395. End Function
  396.