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