home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / VU_Project2164721092009.psc / BarsH.ctl < prev    next >
Text File  |  2009-10-05  |  8KB  |  300 lines
  1. VERSION 5.00
  2. Begin VB.UserControl BarsH 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   6780
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   6780
  8.    ScaleHeight     =   452
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   452
  11.    ToolboxBitmap   =   "BarsH.ctx":0000
  12.    Begin VB.PictureBox pBarsL 
  13.       Appearance      =   0  'Flat
  14.       AutoRedraw      =   -1  'True
  15.       AutoSize        =   -1  'True
  16.       BackColor       =   &H80000005&
  17.       BorderStyle     =   0  'None
  18.       FillStyle       =   0  'Solid
  19.       ForeColor       =   &H80000008&
  20.       Height          =   6900
  21.       Left            =   4320
  22.       Picture         =   "BarsH.ctx":0312
  23.       ScaleHeight     =   460
  24.       ScaleMode       =   3  'Pixel
  25.       ScaleWidth      =   352
  26.       TabIndex        =   2
  27.       Top             =   2040
  28.       Visible         =   0   'False
  29.       Width           =   5280
  30.    End
  31.    Begin VB.PictureBox pBarsM 
  32.       Appearance      =   0  'Flat
  33.       AutoRedraw      =   -1  'True
  34.       AutoSize        =   -1  'True
  35.       BackColor       =   &H80000005&
  36.       BorderStyle     =   0  'None
  37.       FillStyle       =   0  'Solid
  38.       ForeColor       =   &H80000008&
  39.       Height          =   3450
  40.       Left            =   1560
  41.       Picture         =   "BarsH.ctx":76CD4
  42.       ScaleHeight     =   230
  43.       ScaleMode       =   3  'Pixel
  44.       ScaleWidth      =   176
  45.       TabIndex        =   1
  46.       Top             =   2040
  47.       Visible         =   0   'False
  48.       Width           =   2640
  49.    End
  50.    Begin VB.PictureBox pBarsS 
  51.       Appearance      =   0  'Flat
  52.       AutoRedraw      =   -1  'True
  53.       AutoSize        =   -1  'True
  54.       BackColor       =   &H80000005&
  55.       BorderStyle     =   0  'None
  56.       FillStyle       =   0  'Solid
  57.       ForeColor       =   &H80000008&
  58.       Height          =   1740
  59.       Left            =   120
  60.       Picture         =   "BarsH.ctx":94776
  61.       ScaleHeight     =   116
  62.       ScaleMode       =   3  'Pixel
  63.       ScaleWidth      =   89
  64.       TabIndex        =   0
  65.       Top             =   3720
  66.       Visible         =   0   'False
  67.       Width           =   1335
  68.    End
  69. End
  70. Attribute VB_Name = "BarsH"
  71. Attribute VB_GlobalNameSpace = False
  72. Attribute VB_Creatable = True
  73. Attribute VB_PredeclaredId = False
  74. Attribute VB_Exposed = False
  75. Option Explicit
  76.  
  77. Public Enum eBHSize
  78.  SmallBH
  79.  MediumBH
  80.  LargeBH
  81. End Enum
  82. Public Enum eBHChannel
  83.  LeftChanBH
  84.  RightChanBH
  85. End Enum
  86. Private WithEvents oRec As WaveInRecorder
  87. Attribute oRec.VB_VarHelpID = -1
  88. Private mSize As eBHSize
  89. Private mChan As eBHChannel
  90. Private intSamples() As Integer
  91. Public Sub StartVU()
  92.  If Not oRec.IsRecording Then
  93.   oRec.StartRecord 44100, 2
  94.  End If
  95. End Sub
  96. Public Sub StopVU()
  97.  Graphics 0
  98.  oRec.StopRecord
  99. End Sub
  100. Public Sub Preview() 'just threw this in for the demo
  101.  Graphics 0.5
  102. End Sub
  103. 'The class's only event
  104. Private Sub oRec_GotData(intBuffer() As Integer, lngLen As Long)
  105.  Dim lngMaxL As Long, lngMaxR As Long
  106.  intSamples = intBuffer
  107.  'left is the even numbers, right is odd
  108.  lngMaxL = GetArrayMaxAbs(intSamples, 0, 2)
  109.  lngMaxR = GetArrayMaxAbs(intSamples, 1, 2)
  110.  If mChan = LeftChanBH Then
  111.   Graphics lngMaxL / 32768#
  112.  Else
  113.   Graphics lngMaxR / 36738#
  114.  End If
  115. End Sub
  116.  
  117. '================Worker functions=============
  118. Private Function GetArrayMaxAbs(intArray() As Integer, _
  119.     Optional ByVal offStart As Long = 0, _
  120.     Optional ByVal steps As Long = 1) As Long
  121.  Dim lngTemp As Long
  122.  Dim lngMax  As Long
  123.  Dim i       As Long
  124.  For i = offStart To UBound(intArray) Step steps
  125.   lngTemp = Abs(CLng(intArray(i)))
  126.   If lngTemp > lngMax Then
  127.    lngMax = lngTemp
  128.   End If
  129.  Next
  130.  If lngMax = 0 Then lngMax = 1
  131.  GetArrayMaxAbs = lngMax
  132. End Function
  133.  
  134. Public Property Get Channel() As eBHChannel
  135.  Channel = mChan
  136. End Property
  137. Public Property Let Channel(ByVal NewChan As eBHChannel)
  138.  mChan = NewChan
  139. End Property
  140. Public Property Get VUSize() As eBHSize
  141.  VUSize = mSize
  142. End Property
  143. Public Property Let VUSize(ByVal NewSiz As eBHSize)
  144.  mSize = NewSiz
  145.  UserControl_ReSize
  146.  DoColors
  147. End Property
  148. Private Sub Graphics(ByVal Lev As Single)
  149.  Select Case mSize
  150.   Case SmallBH
  151.    BitBlt hdc, 0, 0, 89, 6, _
  152.      pBarsS.hdc, 0, 5 * CLng(22 * Lev), vbSrcCopy
  153.   Case MediumBH
  154.    BitBlt hdc, 0, 0, 176, 12, _
  155.      pBarsM.hdc, 0, 10 * CLng(22 * Lev), vbSrcCopy
  156.   Case LargeBH
  157.    BitBlt hdc, 0, 0, 352, 24, _
  158.      pBarsL.hdc, 0, 20 * CLng(22 * Lev), vbSrcCopy
  159.  End Select
  160.  Refresh
  161. End Sub
  162.  
  163. Private Sub UserControl_Initialize()
  164.  Set oRec = New WaveInRecorder
  165.  ReDim intSamples(FFT_SAMPLES - 1) As Integer
  166. End Sub
  167.  
  168. Private Sub UserControl_ReSize()
  169.  Static Busy As Boolean
  170.  Dim NW As Long, NH As Long
  171.  Select Case mSize
  172.   Case SmallBH
  173.    NW = 1335: NH = 90
  174.   Case MediumBH
  175.    NW = 2640: NH = 150
  176.   Case LargeBH
  177.    NW = 5280: NH = 300
  178.  End Select
  179.  If Not Busy Then
  180.   Busy = True 'prevent recursive resizing
  181.   UserControl.Width = NW
  182.   UserControl.Height = NH
  183.   Busy = False
  184.  End If
  185.  If Ambient.UserMode Then
  186.   Graphics 0
  187.  Else
  188.   Graphics 0.5
  189.  End If
  190. End Sub
  191. Private Sub UserControl_Terminate()
  192.  oRec.StopRecord
  193.  Set oRec = Nothing
  194. End Sub
  195. Private Sub UserControl_InitProperties()
  196.  mSize = SmallBH
  197.  mChan = LeftChanBH
  198.  UserControl.ForeColor = vbGreen
  199.  UserControl.BackColor = vbBlack
  200. End Sub
  201. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  202.  With PropBag
  203.   mChan = .ReadProperty("Channel", 0)
  204.   mSize = .ReadProperty("VUSize", 0)
  205.   UserControl.BackColor = .ReadProperty("BackColor", vbBlack)
  206.   UserControl.ForeColor = .ReadProperty("ForeColor", vbGreen)
  207.  End With
  208.  DoColors
  209. End Sub
  210.  
  211. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  212.  With PropBag
  213.   .WriteProperty "Channel", mChan, 0
  214.   .WriteProperty "VUSize", mSize, 0
  215.   .WriteProperty "BackColor", UserControl.BackColor, vbBlack
  216.   .WriteProperty "ForeColor", UserControl.ForeColor, vbGreen
  217.  End With
  218. End Sub
  219. 'Completely redraws the bar pics
  220. ' with the desired back/forecolor
  221. Private Sub DrawHS() 'small
  222.  Dim x As Long, y As Long, i As Long, XCnt As Long
  223.  pBarsS.Line (0, 0)-(89, 116), BackColor, BF
  224.  XCnt = 1
  225.  For y = 6 To 111 Step 5
  226.   x = 1
  227.   For i = 1 To XCnt
  228.    pBarsS.Line (x, y)-(x + 2, y + 3), ForeColor, BF
  229.    x = x + 4
  230.   Next
  231.   XCnt = XCnt + 1
  232.  Next
  233. End Sub
  234.  
  235. Private Sub DrawHM() 'medium
  236.  Dim x As Long, y As Long, i As Long, XCnt As Long
  237.  pBarsM.Line (0, 0)-(176, 230), BackColor, BF
  238.  XCnt = 1
  239.  For y = 11 To 221 Step 10
  240.   x = 1
  241.   For i = 1 To XCnt
  242.    pBarsM.Line (x, y)-(x + 5, y + 7), ForeColor, BF
  243.    x = x + 8
  244.   Next
  245.   XCnt = XCnt + 1
  246.  Next
  247. End Sub
  248. Private Sub DrawHL() 'large
  249.  Dim x As Long, y As Long, i As Long, XCnt As Long
  250.  pBarsL.Line (0, 0)-(352, 460), BackColor, BF
  251.  XCnt = 1
  252.  For y = 22 To 458 Step 20
  253.   x = 2
  254.   For i = 1 To XCnt
  255.    pBarsL.Line (x, y)-(x + 11, y + 15), ForeColor, BF
  256.    x = x + 16
  257.   Next
  258.   XCnt = XCnt + 1
  259.  Next
  260. End Sub
  261. Private Sub DoColors()
  262.  Select Case mSize
  263.   Case SmallBH
  264.    DrawHS
  265.   Case MediumBH
  266.    DrawHM
  267.   Case LargeBH
  268.    DrawHL
  269.  End Select
  270.  If Not UserControl.Ambient Then
  271.   Graphics 0.5
  272.  End If
  273. End Sub
  274. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  275. 'MappingInfo=UserControl,UserControl,-1,BackColor
  276. Public Property Get BackColor() As OLE_COLOR
  277. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  278.  BackColor = UserControl.BackColor
  279. End Property
  280.  
  281. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  282.  UserControl.BackColor() = New_BackColor
  283.  PropertyChanged "BackColor"
  284.  DoColors
  285. End Property
  286.  
  287. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  288. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  289. Public Property Get ForeColor() As OLE_COLOR
  290. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  291.  ForeColor = UserControl.ForeColor
  292. End Property
  293.  
  294. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  295.  UserControl.ForeColor() = New_ForeColor
  296.  PropertyChanged "ForeColor"
  297.  DoColors
  298. End Property
  299.  
  300.