Jeux de lumière a Led piloter par la carte son (entrée analogique) et fait clignoter 3 leds RVB (une de 3*3w chez moi)
par le port LPT du Pc
Source / Exemple :
'========================================
' Form demo pour le module WaveInBIO.bas
'**********
'
'Par Proger
'c'est hélas l'interface, et particulièrement les graphiques, qui sont lent...
Dim led As Integer
Dim zmin As Double
Dim zmax As Double
Dim xck As Long
Dim Loff As Long
Option Explicit
'pour donner une priorité haute au process
'(ca garanti que l'enregistrement continue meme si l'ordinateur est subitement occupé)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const NORMAL_PRIORITY_CLASS = &H20
Private frmProcess As Long
'l'affichage dynamique ou affichage calme (réduit la consommation CPU)
'certaines infos sont illisibles si elles sont mises à jour trop souvent.
Private Const REFRESH_UPDATE = 2
Private RefreshCount As Long
'pour le VU-metre "adouci"
Private KLG As Double
Private KIG As Double
Private RIG As Double
Private ItM As Double
'pour le FFT, analyse spectrale et spectrogramme
Private pBuf As IPictureDisp
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private ColoTable(0 To 520) As Long
Private tFFTw As Long
Private tFFTh As Long
'pour la gestion des parcelles de fichiers
Private BaseName As String 'nom de base du fichier, partie variable avec des ####
Private CurrName As String
Private DebTime As Date 'marqueur temps, utilisé pour savoir depuis combien de temps ca enregistre
Private TimePerP As Long 'secondes par fragments (défaut = 600, voir Form_Load)
Private NameIndex As Long 'compteur de fichiers
Private NameChOf As Long 'offset de la zone variable ####
Private NameChLn As Long 'longueur de la zone variable
Private NNM As Boolean 'petit flag pour le timer : mise à jour du nom de fichier
Private TimeRec As Long 'totaliseur du nombre de secondes d'enregistrement
Private TimeRecF As Long 'petit flag pour le timer : quand mettre à jour
Private Sub Form_Load()
Open App.Path + "\sortie.txt" For Output As #1
Dim Cson() As String
Dim i As Long
'préparation interface carte son
Combo1.Clear
For i = 1 To GetInDev(Cson())
Combo1.AddItem Cson(i)
Next i
Combo1.Text = Cson(1)
'préparation interface echantillonnage
Combo2.AddItem 8000
Combo2.AddItem 11025
Combo2.AddItem 16000
Combo2.AddItem 22050
Combo2.AddItem 32000
Combo2.AddItem 44100
Combo2.AddItem 48000
Combo2.AddItem 88200
Combo2.AddItem 96000
Combo2.ListIndex = 3
'autres variables
TimePerP = 600
xck = 0
End Sub
Private Function NouvelleSession(NomFichier As String) As String
'nouvelle session d'enregistrement.
Dim p As Long, t As Long, i As Long
'vérifie l'extension
If LCase$(Right$(NomFichier, 4)) <> ".wav" Then
If InStrRev(NomFichier, ".") = Len(NomFichier) - 3 Then
'mauvaise extension
BaseName = Mid$(BaseName, 1, Len(NomFichier) - 4) & ".wav"
Else
'pas d'extension
BaseName = NomFichier & ".wav"
End If
Else
BaseName = NomFichier
End If
'vérifie la présence de la zone variable ####
p = InStr(1, NomFichier, "#", vbBinaryCompare)
t = InStrRev(NomFichier, "#", , vbBinaryCompare) - p + 1
If p = 0 Then
NouvelleSession = "Nom invariant !!"
'si le nom est invariant, on considère n'enregistrer que dans 1 fichier.
'anti-plantage : calcul de la durée max possible avant que le fichier dépasse 2Go :
TimePerP = 2147483640 \ CLng(Combo2.List(Combo2.ListIndex)) * 2
CurrName = BaseName
Exit Function
End If
'mise à jour des variables locales pour le changement de noms
CurrName = BaseName
NameChOf = p
NameChLn = t
NameIndex = 1
NNM = False
'recherche s'il n'y a pas d'anciens fichiers avec ce format,
'décale l'index automatique en conséquence.
Do
Mid(CurrName, NameChOf, NameChLn) = Format$(NameIndex, String$(NameChLn, "0"))
If Dir(CurrName, vbNormal) = "" Then Exit Do
NameIndex = NameIndex + 1
Loop
NouvelleSession = CurrName
End Function
Private Function HMS(ByVal s As Long) As String
'conversion de secondes en heures:minutes:secondes sans passer par les strings...
'extra-rapide :) les divisions sont en fait des rotations de bits shl/sal en asm
Dim i As Long, h As Long, m As Long
Dim osB(1 To 8) As Byte
osB(3) = 58 ' ":"
osB(6) = 58
m = s \ 60
s = s - m * 60
h = m \ 60
m = m - h * 60
i = s \ 10
osB(8) = 48 + (s - i * 10)
osB(7) = 48 + i
i = m \ 10
osB(5) = 48 + (m - i * 10)
osB(4) = 48 + i
i = h \ 10
osB(2) = 48 + (h - i * 10)
osB(1) = 48 + i
HMS = StrConv(osB(), vbUnicode)
End Function
Private Sub Check1_Click()
Dim uFrq As Long
If Check1.Value = 1 Then
'augmente la priorité système
frmProcess = GetCurrentProcess()
Call SetPriorityClass(frmProcess, HIGH_PRIORITY_CLASS)
'initialise l'acquisition et écoute
uFrq = CLng(Combo2.List(Combo2.ListIndex))
If Not VU_StartInput(CBool(Check5.Value), uFrq) Then '<== DEMARRAGE DE L'ECOUTE
Check1.Value = False
Exit Sub
End If
Timer1.Enabled = True
Combo1.Enabled = False
Combo2.Enabled = False
Check5.Enabled = False
Else
Timer1.Enabled = False
VU_StopInput 'stoppe proprement l'écoute
'remet la priorité en normale (pratique si le programme commence à déconner)
frmProcess = GetCurrentProcess()
Call SetPriorityClass(frmProcess, NORMAL_PRIORITY_CLASS)
Combo1.Enabled = True
Combo2.Enabled = True
Check5.Enabled = True
End If
End Sub
Private Sub Check3_Click()
VU_DoFFT = CBool(Check3.Value)
End Sub
Private Sub Check4_Click()
VU_DoCut = CBool(Check4.Value)
End Sub
Private Sub Combo1_Click()
VU_Device = Combo1.ListIndex
End Sub
Private Sub Command1_Click()
Shell "sndvol32 -R -D " & Combo1.ListIndex, vbNormalFocus
End Sub
Private Sub HScroll1_Change()
Call HScroll1_Scroll
End Sub
Private Sub HScroll1_Scroll()
VU_Boost = (CDbl(HScroll1.Value)) / 20
Label3.Caption = Format$(VU_Boost, "#0.00") & " dB"
End Sub
Private Sub Timer1_Timer()
Dim dGain As Double, smG As Double
Dim i As Long, c As Long, p As Long, upd As Boolean
'moulinette
upd = VU_Update() '<== PRINCIPALE FONCTION GERANT L'ACQUISITION DU SON
'VU-metre
dGain = VU_Gain
'Print #1, dGain
If upd Then 'les actions suivantes ne sont mise à jour que s'il y a eu un nouvel enregistrement
RefreshCount = RefreshCount + 1
p = (RefreshCount Mod REFRESH_UPDATE) = 0
'mise à jour paramètres VU-metre
If p Then
'Label1.Caption = Format$(dGain, "#00")
If dGain > zmax Then zmax = dGain
If dGain < zmin Then zmin = dGain
If zmax > 0 Then zmax = zmax - 10
If zmin < 65999 Then zmin = zmin + 10
Me.Caption = Str$(zmin) + " : " + Str$(zmax) + " = " + Str$(zmax - zmin)
'noir=0
'Rouge=1
'Jaune=5
'vert=4
'Cyan=6
'Bleu=2
'Violet=3
'Blanc=7
led = 0
If dGain > (zmin + (zmax - zmin) / 8) Then led = 1
If dGain > (zmin + 2 * (zmax - zmin) / 8) Then led = 5
If dGain > (zmin + 3 * (zmax - zmin) / 8) Then led = 4
If dGain > (zmin + 4 * (zmax - zmin) / 8) Then led = 6
If dGain > (zmin + 5 * (zmax - zmin) / 8) Then led = 2
If dGain > (zmin + 6 * (zmax - zmin) / 8) Then led = 3
If dGain > (zmin + 7 * (zmax - zmin) / 8) Then led = 7
If led = 0 Then Form1.BackColor = 0
If led = 1 Then Form1.BackColor = vbRed
If led = 5 Then Form1.BackColor = vbYellow
If led = 4 Then Form1.BackColor = vbGreen
If led = 6 Then Form1.BackColor = vbCyan
If led = 2 Then Form1.BackColor = vbBlue
If led = 3 Then Form1.BackColor = vbMagenta
If led = 7 Then Form1.BackColor = vbWhite
'If (led = 7) Or (led = 3) Or (led = 2) Or (led = 6) Then
' SaveSetting "HWPorte", "MAIN", "TX", "121"
' Loff = 0
'Else
' If Loff < 10 Then Loff = Loff + 1
'End If
'If Loff = 9 Then
' SaveSetting "HWPorte", "MAIN", "TX", "98"
'End If
Out 888, led
End If
End If 'fin update
End Sub
Private Sub Form_Unload(Cancel As Integer)
Out 888, 0
End
End Sub
Private Sub Timer2_Timer()
If xck > 9 Then Exit Sub
Me.Caption = Str$(10 - xck)
xck = xck + 1
If xck = 9 Then Check1.Value = 1
End Sub
Conclusion :
Merci a Proger pour ENREGISTREUR WAVEIN, FILTRE ET ANALYSE SPECTRALE
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.