VBWaveComp.Net v1.3.1.*Table des procédures 1 - AssemblyInfo.vb 2 - frmVBWaveComp.vb 2.1 - Private Function bChoisirFichierWav 2.2 - Private Function sRapportFrequences$ 2.3 - Private Sub CalculerAmplitudeTrace 2.4 - Private Sub CalculerCoordSpectre 2.5 - Private Sub CalculerMinMax 2.6 - Private Sub CboPondMoy_SelectedIndexChanged 2.7 - Private Sub ChkDecibels_CheckedChanged 2.8 - Private Sub ChkMinLog_CheckedChanged 2.9 - Private Sub ChkNormaliser_CheckedChanged 2.10 - Private Sub ChkRapport_CheckedChanged 2.11 - Private Sub ChkRelatif_CheckedChanged 2.12 - Private Sub ChoisirFichierWav 2.13 - Private Sub cmdFichier1_Click 2.14 - Private Sub CmdNouveau_Click 2.15 - Private Sub EffacerImg 2.16 - Private Sub FrmVBWaveComp_Closed 2.17 - Private Sub FrmVBWaveComp_Load 2.18 - Private Sub ImgSpectre_MouseDown 2.19 - Private Sub ImgSpectre_MouseMove 2.20 - Private Sub Initialisation 2.21 - Private Sub InitVBWaveComp 2.22 - Private Sub LireFichierWave 2.23 - Private Sub MAJSpectres 2.24 - Private Sub NouveauxFichiers 2.25 - Private Sub NUDZoom_ValueChanged 2.26 - Private Sub ProduireRapport 2.27 - Private Sub Retracer 2.28 - Private Sub TracerDiffSpectre 2.29 - Private Sub TracerSignal 2.30 - Private Sub TracerSpectre 2.31 - Private Sub TraiterFichierAudio 2.32 - Private Sub txtFichier1_DoubleClick 2.33 - Protected Overrides Sub OnClick 2.34 - Protected Overrides Sub OnPaint 3 - clsTFR.vb 3.1 - Private Function iReverseBits% 3.2 - Private Function rCalculerLog# 3.3 - Private Function rCalculerLogDB# 3.4 - Private Function rCalculerLogDBGD# 3.5 - Private Function rCalculerLogGD# 3.6 - Private Sub CalculerEnergieLocaleDB 3.7 - Private Sub CalculerEnergieLocaleDirecte 3.8 - Private Sub CalculerEnergieLocaleLog 3.9 - Private Sub CalculerEnergieLocaleMS 3.10 - Private Sub CalculerSommeSpectresLog 3.11 - Private Sub CalculerSommeSpectresNEC 3.12 - Private Sub ComparerSpectresMesure 3.13 - Private Sub FFTDoReverse 3.14 - Private Sub InitAmplitudeTrace 3.15 - Private Sub InitMesure 3.16 - Private Sub InitMesureComp 3.17 - Private Sub InitMesurePlage 3.18 - Private Sub InitMesuresComp 3.19 - Private Sub InitMesureSpectre 3.20 - Private Sub InitMesureSpectrePlage 3.21 - Public Function rCalculerNEC# 3.22 - Public Function rLireSpectre# 3.23 - Public Sub CalculerEnergieLocale 3.24 - Public Sub CalculerSommeSpectres 3.25 - Public Sub CalculerSpectre 3.26 - Public Sub ComparerSpectres 3.27 - Public Sub FFTAudio 3.28 - Public Sub InitMesures 3.29 - Public Sub InitMesuresPlage 3.30 - Public Sub InitTFR 3.31 - Public Sub MemoriserSpectre1 4 - modVBWaveComp.vb 4.1 - Public Function bChoisirFichier 4.2 - Public Function bLireFichierIni 4.3 - Public Function sFormater$ 4.4 - Public Sub AfficherMsgErreur AssemblyInfo.vb ' Fichier AssemblyInfo.vb ' ----------------------- Imports System.Reflection 'Imports System.Runtime.CompilerServices Imports System.Runtime.InteropServices <Assembly: AssemblyTitle("VBWaveComp.Net")> <Assembly: AssemblyDescription("Le comparateur de spectre audio en VB .Net")> <Assembly: AssemblyCompany("ORS Production")> <Assembly: AssemblyProduct("VBWaveComp.Net")> <Assembly: AssemblyCopyright("2002-2007 Par Patrice Dargenton")> <Assembly: AssemblyTrademark("VBWaveComp.Net")> <Assembly: AssemblyCulture("")> <Assembly: AssemblyVersion("1.3.1.*")> frmVBWaveComp.vb ' Fichier frmVBWaveComp.vb ' ------------------------ ' VBWaveComp.Net : Le comparateur de spectre audio en VB .Net ' ----------------------------------------------------------- ' http://www.vbfrance.com/code.aspx?ID=5319 ' Documentation : VBWaveComp.html ' http://patrice.dargenton.free.fr/vbwavecomp/VBWaveComp.html ' http://patrice.dargenton.free.fr/vbwavecomp/VBWaveComp.vbproj.html ' Par Patrice Dargenton : mailto:patrice.dargenton@free.fr ' http://patrice.dargenton.free.fr/index.html ' http://patrice.dargenton.free.fr/CodesSources/index.html ' http://www.vbfrance.com/listeauteur2.aspx?ID=1124 ' Version 1.31 du 11/11/2007 ' Version 1.30 du 21/08/2007 ' Créé à partir des contributions : ' - Afficher le waveform d'un wav, de nicolas.vp@skynet.be ' www.vbfrance.com/article.aspx?Val=3749 ' - Un analyseur de spectre audio numérique ' www.vbfrance.com/article.aspx?Val=4075 ' de quabal@caramail.com, lui-même utilisant : ' - Audio FFT Murphy McCauley ' de MurphyMc@Concentric.NET, lui-même utilisant : ' - Don Cross's FFT code pour le calcul de la TFR (Transformée de Fourier Rapide) ' Merci à Sphax <sphaxs@wanadoo.fr> pour ses formules de Log ' acoustiques que je n'avais aucune chance de deviner avec ma ' méthode habituelle : au pif, jusqu'à temps que ça marche :-) ' http://www.vbfrance.com/auteurdetail.aspx?ID=11069 ' Note : J'ai corrigé un bug sur le code de la TFR ' ImagOut(j) n'était pas bien initialisé ' Conventions de nommage des variables : ' ------------------------------------ ' b pour Boolean (booléen vrai ou faux) ' i pour Integer : % (en VB .Net, l'entier a la capacité du VB6.Long) ' l pour Long : & ' r pour nombre Réel (Single!, Double# ou Decimal : D) ' s pour String : $ ' c pour Char ou Byte ' d pour Date ' u pour Unsigned (non signé : entier positif) ' a pour Array (tableau) : () ' o pour Object : objet instancié localement ' refX pour reference à un objet X préexistant qui n'est pas sensé être fermé ' m_ pour variable Membre de la classe ou de la feuille (Form) ' (mais pas pour les constantes) ' frm pour Form ' cls pour Classe ' mod pour Module ' ... ' ------------------------------------ Friend Class frmVBWaveComp : Inherits Form ' Constantes par défaut Private Const iNbPlagesFrequenceDef% = 40 Private Const iNbBitsTFRDef% = 15 ' 2^15 = 32768 Private Const rFreqCoupureBasseKhzDef! = 12 Private Const rFreqCoupureHauteKhzDef! = 15 Private Const iZoomDiffSpectreDef% = 50 Private Const bNormaliserSpectreDef As Boolean = True 'Private Const iIndexPageFichiers% = 0 ' Indexes des pages des onglets Private Const iIndexPageInfos% = 1 'Private Const iIndexPageOptions% = 2 Private m_grImgSpectre As Graphics ' Tracé dans les images de spectre Private m_grImgCanalG As Graphics Private m_grImgCanalD As Graphics Private Const iEpaisseurTrait% = 1 Private m_penNoir As New Pen(Color.Black, iEpaisseurTrait) Private m_penNoirGras As New Pen(Color.Black, iEpaisseurTrait * 3) Private m_penBleu As New Pen(Color.Blue, iEpaisseurTrait) Private m_penMagenta As New Pen(Color.Magenta, iEpaisseurTrait) Private m_penJaune As New Pen(Color.Yellow, iEpaisseurTrait) Private m_penGris As New Pen(Color.Gray, iEpaisseurTrait) Private Const iMaxEntier16Bits As Short = 32767 ' Short = VB6.Integer Private Const iMinEntier16Bits As Short = -32768 Private Const rMaxDouble# = 1.0E+300 ' (1.79E+308) Private Const rMinDouble# = -rMaxDouble Private Const iFinAvancement% = 10000 ' Val. max. de la barre de progression Private Const sIniRubriqueConfig$ = "Configuration" Private Const sTypePondAucune$ = "Aucune" Private Const sTypePondHautesFreq$ = "Hautes fréquences" Private Const sTypePondEnergie$ = "Energie de la plage" Private Const sMsgFiltreDoc$ = _ "Fichier wave (*.wav)|*.wav|" & _ "Tous les fichiers (*.*)|*.*" Private Const sMsgTitreBoiteDlg$ = "Veuillez choisir un fichier .wav" 'Private Const m_iMaxdBAcq16Bits% = 96 ' Max de dB sur un CD Audio Private m_iNbPixelsImgLarg% ' Nbre de pixels pour le tracé en largeur Private Const iMarge% = 5 ' Marge en pixels pour l'affichage du spectre ' Type pour retracer le signal directe Private Structure TAmplitude Dim iMin%, iMax% End Structure ' Tableau des échantillons visibles Private m_aEchVisibles(,) As TAmplitude Private m_oTFR As New clsTFR() ' Classe pour gérer la TFR ' Tableau d'entier contenant les séquences d'échantillon du signal ' d'entrée Gauche et Droite (dimension 1 : iNumCanal) Private m_aiSeqEchSgl(,) As Short Private Sub FrmVBWaveComp_Load(ByVal eventSender As Object, _ ByVal eventArgs As EventArgs) Handles MyBase.Load InitVBWaveComp() End Sub Private Sub FrmVBWaveComp_Closed(ByVal eventSender As Object, _ ByVal eventArgs As EventArgs) Handles MyBase.Closed FileClose() ' Si on quitte, fermer tous les fichiers au cas où End Sub Private Sub InitVBWaveComp() If bTrapErr Then On Error GoTo Err_InitVBWaveComp Me.txtFichier1.Text = "" Dim sCheminIni$ = Application.StartupPath & "\VBWaveComp.ini" Dim rVal! bLireFichierIni("bNormaliserSpectre", sIniRubriqueConfig, sCheminIni, _ rVal, rDefaut:=CSng(bNormaliserSpectreDef), _ bNumerique:=True, bBooleen:=True) m_oTFR.m_prm.bNormaliserSpectre = CBool(rVal) Me.ChkNormaliser.Checked = m_oTFR.m_prm.bNormaliserSpectre bLireFichierIni("TypePonderationMoy", sIniRubriqueConfig, sCheminIni, _ rVal, rDefaut:=TPonderation.Aucune, bNumerique:=True) m_oTFR.m_prm.TypePonderationMoy = CType(rVal, TPonderation) Select Case m_oTFR.m_prm.TypePonderationMoy Case TPonderation.Aucune : Me.CboPondMoy.Text = sTypePondAucune Case TPonderation.HautesFrequences Me.CboPondMoy.Text = sTypePondHautesFreq Case TPonderation.Energie : Me.CboPondMoy.Text = sTypePondEnergie End Select bLireFichierIni("iNbPlagesFrequence", sIniRubriqueConfig, sCheminIni, _ rVal, rDefaut:=iNbPlagesFrequenceDef) m_oTFR.m_prm.iNbPlagesFrequence = CInt(rVal) bLireFichierIni("iNbBitsTFR", sIniRubriqueConfig, sCheminIni, _ rVal, rDefaut:=iNbBitsTFRDef) m_oTFR.m_prm.iNbBitsTFR = CInt(rVal) If m_oTFR.m_prm.iNbBitsTFR > 23 Then If MsgBoxResult.Cancel = MsgBox( _ "Attention, votre ordinateur va exploser, êtes-vous prêt ?" & _ vbLf & "(iNbBitsTFR > 23)", MsgBoxStyle.OkCancel, sTitreMsg) Then _ Application.Exit() : Exit Sub End If m_oTFR.InitTFR() ' Première dimension : iNumCanal m_iNbPixelsImgLarg = ImgCanalG.ClientRectangle.Width ReDim m_aEchVisibles(iNbCanaux - 1, m_iNbPixelsImgLarg) ' iNbCanaux = 2 : G+D ReDim m_aiSeqEchSgl(iNbCanaux - 1, m_oTFR.m_var.iNbFreqTFR - 1) Dim iZoom% = 2 If clsTFR.bAfficher2SpectresSymetriques Then iZoom = 1 If m_iNbPixelsImgLarg > m_oTFR.m_var.iNbFreqTFR Then m_oTFR.m_var.rMultiplicateurFreq = CSng(iZoom * _ Fix(m_iNbPixelsImgLarg / m_oTFR.m_var.iNbFreqTFR)) Else m_oTFR.m_var.rMultiplicateurFreq = CSng(iZoom * _ Fix(10000 * m_iNbPixelsImgLarg / m_oTFR.m_var.iNbFreqTFR) / 10000) ' Attention si le nombre de fréquences est très grand If m_oTFR.m_var.rMultiplicateurFreq = 0 Then _ MsgBox("rMultiplicateurFreq = 0 !") : Application.Exit() : Exit Sub End If bLireFichierIni("rFreqCoupureBasseKhz", sIniRubriqueConfig, sCheminIni, _ m_oTFR.m_prm.rFreqCoupureBasseKhz, rDefaut:=rFreqCoupureBasseKhzDef) bLireFichierIni("rFreqCoupureHauteKhz", sIniRubriqueConfig, sCheminIni, _ m_oTFR.m_prm.rFreqCoupureHauteKhz, rDefaut:=rFreqCoupureHauteKhzDef) bLireFichierIni("iZoomDiffSpectre", sIniRubriqueConfig, sCheminIni, _ rVal, rDefaut:=iZoomDiffSpectreDef) Me.NUDZoom.Value = CDec(rVal) m_oTFR.m_var.bInit = True NouveauxFichiers() Exit Sub Err_InitVBWaveComp: AfficherMsgErreur(Err, _ "Impossible d'initialiser VBWaveComp.Net", "InitVBWaveComp") End Sub Private Sub LireFichierWave(ByVal sFichier$, ByVal sChemin$) ' *********************************** ' *** LIT LES DONNEES TECHNIQUES *** ' *** ET SONORES D'UN FICHIER WAV *** ' *********************************** m_oTFR.MemoriserSpectre1() 'If VB.Right(sChemin, 1) <> "\" Then sChemin = sChemin & "\" If sChemin.Substring(sChemin.Length - 1, 1) <> "\" Then sChemin = sChemin & "\" m_oTFR.m_aSpectre(iSp2).sFichierAudio = sFichier m_oTFR.m_aSpectre(iSp2).sCheminFichierAudio = sChemin ' 1 : Ouvre le fichier ' ******************** Const iNumFichier% = 1 FileOpen(iNumFichier, sChemin & sFichier, OpenMode.Binary, OpenAccess.Read) Dim n%, X$, sMsgErr$ For n = 1 To 100 X = InputString(iNumFichier, 4) If X = "fmt " Then Exit For Next n ' 2 : Cherche les infos techniques ' ******************************** Dim iEntier32Bits% ' = VB6.Long Dim iEntier16Bits As Short ' = VB6.Int FileGet(iNumFichier, iEntier32Bits) '==> BITS (8/16) FileGet(iNumFichier, iEntier16Bits) '==> TYPE CANAUX (=1) FileGet(iNumFichier, iEntier16Bits) '==> NOMBRE CANAUX(1=mono / 2=stereo) Dim iNbCanaux% = iEntier16Bits ' Affiche les informations sur les canaux If iNbCanaux = 1 Then Me.LblCanaux.Text = "Canaux : Mono" m_oTFR.m_aSpectre(iSp2).bStereo = False ElseIf iNbCanaux = 2 Then Me.LblCanaux.Text = "Canaux : Stéreo" m_oTFR.m_aSpectre(iSp2).bStereo = True Else sMsgErr = "Canaux : Erreur !" Me.LblCanaux.Text = sMsgErr GoTo GestionErreurs End If FileGet(iNumFichier, iEntier32Bits) '==> FREQUENCE (Hz) m_oTFR.m_aSpectre(iSp2).iFreqBase = iEntier32Bits Me.LblFrequence.Text = "Fréquence : " & m_oTFR.m_aSpectre(iSp2).iFreqBase & " Hz" FileGet(iNumFichier, iEntier32Bits) '==> MULTIPLE (Hz * 2) ' DIVISEUR permet de calculer le nombre de samples du fichier FileGet(iNumFichier, iEntier16Bits) '==> DIVISEUR (nbre canaux * 2) Dim iNbOctetsParEch% = iEntier16Bits FileGet(iNumFichier, iEntier16Bits) '==> BITS (8/16) Dim iNbBitsSignalAudio% = iEntier16Bits m_oTFR.m_aSpectre(iSp2).b16Bits = False If iNbBitsSignalAudio = 16 Then m_oTFR.m_aSpectre(iSp2).b16Bits = True If iNbBitsSignalAudio = 8 Or iNbBitsSignalAudio = 16 Then Me.LblNbBits.Text = "Qualité : " & iNbBitsSignalAudio & " Bits." Else sMsgErr = "Qualité : Erreur !" Me.LblNbBits.Text = sMsgErr GoTo GestionErreurs End If ' 3 : LIT LES DONNEES SONORES ' *************************** GotTheData: For n = 1 To 100 X = InputString(iNumFichier, 1) If X = "d" Then Exit For Next n Dim Z$ = InputString(iNumFichier, 3) If Z <> "ata" Then If n > 90 Then sMsgErr = "Impossible de lire l'en-tête du fichier !" GoTo GestionErreurs End If Dim lTemp& = Seek(iNumFichier) Seek(iNumFichier, lTemp - 3) GoTo GotTheData End If FileGet(iNumFichier, iEntier32Bits) '==> BYTES DE DONNEES Me.LblTailleOctets.Text = "Taille : " & iEntier32Bits & " octets" ' iNbOctetsParEch = 2 : mono ou 4 : stéréo m_oTFR.m_aSpectre(iSp2).iNbEchSignal = CInt(iEntier32Bits / iNbOctetsParEch) Me.LblNbEch.Text = "Nb échant.: " & m_oTFR.m_aSpectre(iSp2).iNbEchSignal ' FORMULE : durée (en sec) = NbEch / Fréquence m_oTFR.m_aSpectre(iSp2).rDureeSignalSec = CSng(Int(0.5 + 1000.0# * _ m_oTFR.m_aSpectre(iSp2).iNbEchSignal / m_oTFR.m_aSpectre(iSp2).iFreqBase) / 1000) ' Afficher les secondes Me.LblLongueur.Text = "Longueur : " & _ m_oTFR.m_aSpectre(iSp2).rDureeSignalSec & " secondes" If Not m_oTFR.m_aSpectre(iSp2).b16Bits Then MsgBox("Seuls les fichiers 16 bits sont supportés") GoTo Fin End If ' Préparer le curseur pour la lecture Dim lPosDonneesSonores& = Seek(iNumFichier) ' Afficher le signal et calculer les spectres TraiterFichierAudio(lPosDonneesSonores, iNumFichier) Fin: FileClose(iNumFichier) Exit Sub GestionErreurs: AfficherMsgErreur(Err, sMsgErr, "LireFichierWave") Resume Fin End Sub Private Sub TraiterFichierAudio(ByVal lPosDonneesSonores&, ByVal iNumFichier%) ' ********************************************** ' *** DESSINE LE GRAPHE D'UN FICHIER WAV *** ' *** (sur deux pistes : mono/stereo) *** ' *** PARTIR DES DONNEES SONORES RECUPEREES *** ' ********************************************** ' PS : le code est pas de moi :-))) ' Patrice : de moi non plus ! ben c'est qui qui l'a fait alors ? Cursor = Cursors.WaitCursor EffacerImg() Dim penLocalG As Pen ' Référence de pinceau Dim penLocalD As Pen = Nothing Dim iNbEchSignal% = m_oTFR.m_aSpectre(iSp2).iNbEchSignal Dim iNumLecture%, iNumEch% Dim aiEntiers16Bits() As Short Dim iEntier16Bits As Short Dim lPosLecture& Dim bPasse1, bPasse2 As Boolean Dim iMaxValCanalG% = iMinEntier16Bits Dim iMaxValCanalD% = iMinEntier16Bits Dim amplG As TAmplitude Dim amplD As TAmplitude Dim ampl As TAmplitude amplG.iMin = iMaxEntier16Bits amplD.iMin = iMaxEntier16Bits amplG.iMax = iMinEntier16Bits amplD.iMax = iMinEntier16Bits bPasse1 = False If m_oTFR.m_prm.bNormaliserSpectre Then bPasse1 = True ' Mi-hauteur du spectre et du signal Dim iMilieuSp% = CInt(ImgCanalG.ClientRectangle.Height / 2) ' LIGNE 1 : mediane m_grImgCanalG.DrawLine(m_penNoir, 0, iMilieuSp, m_iNbPixelsImgLarg, iMilieuSp) m_grImgCanalD.DrawLine(m_penNoir, 0, iMilieuSp, m_iNbPixelsImgLarg, iMilieuSp) ' Dessine le graphe en fonction de l'échantillonnage Dim iRedNivAudio% = 1500 Dim iNbCanaux% = 1 Dim iNbOctetsParEchAudio% = 1 If m_oTFR.m_aSpectre(iSp2).b16Bits Then iNbOctetsParEchAudio = 2 penLocalG = m_penNoir If m_oTFR.m_aSpectre(iSp2).bStereo Then _ iNbCanaux = 2 : penLocalG = m_penBleu : penLocalD = m_penMagenta Dim iNbEchAudioFenetre% = m_oTFR.m_var.iNbFreqTFR * iNbCanaux Dim bTracer As Boolean Dim iIndiceAff% ' Indice pour l'affichage Dim iProportionAff% = CInt(iNbEchSignal / m_iNbPixelsImgLarg) ' 1 ou 2 Canaux d'entiers 16 bits ReDim aiEntiers16Bits(iNbEchAudioFenetre - 1) Dim iNbLectures% = 0 If m_oTFR.m_var.iNbFreqTFR >= iNbEchSignal Then iNbLectures = 1 ' 11/11/2007 Else iNbLectures = CInt(iNbEchSignal / m_oTFR.m_var.iNbFreqTFR + 1) End If SecondePasse: ' Il y a 2 passes si on doit normaliser (calcul du max.) If bPasse2 Or Not m_oTFR.m_prm.bNormaliserSpectre Then _ m_oTFR.CalculerSpectre(m_aiSeqEchSgl, bInit:=True) iIndiceAff = 0 For iNumLecture = 0 To iNbLectures - 1 If iNumLecture = iNbLectures - 1 Then ' Si on arrive à la fin, initialiser le signal à 0 For iNumEch = 0 To iNbEchAudioFenetre - 1 aiEntiers16Bits(iNumEch) = 0 Next iNumEch End If lPosLecture = lPosDonneesSonores + _ CLng(1.0 * iNbOctetsParEchAudio * iNumLecture * iNbEchAudioFenetre) Try Dim iMaxEchFichier% = iNbEchSignal * iNbCanaux - _ CInt(1.0 * iNumLecture * iNbEchAudioFenetre) Dim aTableau As System.Array If iMaxEchFichier < iNbEchAudioFenetre - 1 Then ' Lecture du dernier tronçon Dim aiEntiers16Bits0(iMaxEchFichier - 1) As Short 'FileGet(iNumFichier, (aiEntiers16Bits0), lPosLecture) ' marche pas 'FileGet(iNumFichier, aiEntiers16Bits0(0), lPosLecture) ' marche pas 'FileGet(iNumFichier, aiEntiers16Bits0, lPosLecture) ' ok en strict off ' Avec Reflector, on trouve comment il faut procéder : aTableau = aiEntiers16Bits0 FileGet(iNumFichier, aTableau, lPosLecture) aiEntiers16Bits0 = DirectCast(aTableau, Short()) For iNumEch = 0 To iMaxEchFichier - 1 aiEntiers16Bits(iNumEch) = aiEntiers16Bits0(iNumEch) Next iNumEch Else 'FileGet(iNumFichier, aiEntiers16Bits, lPosLecture) aTableau = aiEntiers16Bits FileGet(iNumFichier, aTableau, lPosLecture) aiEntiers16Bits = DirectCast(aTableau, Short()) End If Catch End Try ' Il doit y avoir autant d'échantillon audio que de fréquences dans la TFR For iNumEch = 0 To m_oTFR.m_var.iNbFreqTFR - 1 iEntier16Bits = aiEntiers16Bits(iNumEch * iNbCanaux) If bPasse2 Then ' Normalisation m_aiSeqEchSgl(iCanalG, iNumEch) = CShort(iEntier16Bits * 1.0# * _ iMaxEntier16Bits / iMaxValCanalG) Else m_aiSeqEchSgl(iCanalG, iNumEch) = iEntier16Bits End If If bPasse1 Then If iEntier16Bits > iMaxValCanalG Then iMaxValCanalG = iEntier16Bits If iEntier16Bits < -iMaxValCanalG Then iMaxValCanalG = -CInt(iEntier16Bits) End If bTracer = False If (iNumEch Mod iProportionAff) = 0 Then bTracer = True : iIndiceAff += 1 End If If ((iNumEch - 1) Mod iProportionAff) = 0 Then amplG.iMin = iMaxEntier16Bits amplD.iMin = iMaxEntier16Bits amplG.iMax = iMinEntier16Bits amplD.iMax = iMinEntier16Bits End If If iEntier16Bits > amplG.iMax Then amplG.iMax = iEntier16Bits If iEntier16Bits < amplG.iMin Then amplG.iMin = iEntier16Bits If bTracer And iIndiceAff < m_iNbPixelsImgLarg Then If bPasse2 Then ampl.iMin = CInt(iMilieuSp - amplG.iMin * iMilieuSp / iMaxValCanalG) ampl.iMax = CInt(iMilieuSp - amplG.iMax * iMilieuSp / iMaxValCanalG) Else ampl.iMin = CInt(iMilieuSp - amplG.iMin / iRedNivAudio) ampl.iMax = CInt(iMilieuSp - amplG.iMax / iRedNivAudio) End If m_aEchVisibles(iCanalG, iIndiceAff - 1) = ampl If iIndiceAff > 1 Then _ m_grImgCanalG.DrawLine(penLocalG, _ iIndiceAff - 1, ampl.iMin, _ iIndiceAff - 1, ampl.iMax) End If If m_oTFR.m_aSpectre(iSp2).bStereo Then iEntier16Bits = aiEntiers16Bits(iNumEch * iNbCanaux + 1) If bPasse2 Then ' Normalisation m_aiSeqEchSgl(iCanalD, iNumEch) = CShort(iEntier16Bits * 1.0# * _ iMaxEntier16Bits / iMaxValCanalD) Else m_aiSeqEchSgl(iCanalD, iNumEch) = iEntier16Bits End If If bPasse1 Then If iEntier16Bits > iMaxValCanalD Then iMaxValCanalD = iEntier16Bits If iEntier16Bits < -iMaxValCanalD Then iMaxValCanalD = -CInt(iEntier16Bits) End If If iEntier16Bits > amplD.iMax Then amplD.iMax = iEntier16Bits If iEntier16Bits < amplD.iMin Then amplD.iMin = iEntier16Bits If bTracer And iIndiceAff < m_iNbPixelsImgLarg Then If bPasse2 Then ampl.iMin = CInt(iMilieuSp - amplD.iMin * iMilieuSp / iMaxValCanalD) ampl.iMax = CInt(iMilieuSp - amplD.iMax * iMilieuSp / iMaxValCanalD) Else ampl.iMin = CInt(iMilieuSp - amplD.iMin / iRedNivAudio) ampl.iMax = CInt(iMilieuSp - amplD.iMax / iRedNivAudio) End If m_aEchVisibles(iCanalD, iIndiceAff - 1) = ampl If iIndiceAff > 1 Then _ m_grImgCanalD.DrawLine(penLocalD, _ iIndiceAff - 1, ampl.iMin, _ iIndiceAff - 1, ampl.iMax) End If End If Next iNumEch If bPasse2 Or Not m_oTFR.m_prm.bNormaliserSpectre Then m_oTFR.CalculerSpectre(m_aiSeqEchSgl) End If If iNbLectures = 1 Then pbAvancement.Value = iFinAvancement Else pbAvancement.Value = CInt(1.0! * iFinAvancement * iNumLecture / (iNbLectures - 1)) End If ' Pour que le tracé soit visible Application.DoEvents() If iNbSpectreMax > 0 AndAlso iNumLecture + 1 >= iNbSpectreMax Then Exit For Next iNumLecture If bPasse2 Or Not m_oTFR.m_prm.bNormaliserSpectre Then m_oTFR.CalculerSpectre(m_aiSeqEchSgl, , bFin:=True) End If If bPasse1 Then bPasse1 = False bPasse2 = True : GoTo SecondePasse End If MAJSpectres(bCalculerMinMax:=True) Retracer() ProduireRapport() If m_oTFR.m_var.iNbSpectres = 2 Then _ Me.TabControl.SelectedIndex = iIndexPageInfos Cursor = Cursors.Default pbAvancement.Value = 0 End Sub Private Sub TracerSignal() Dim i% Dim iNbEchEcran% = m_iNbPixelsImgLarg For i = 0 To iNbEchEcran - 1 m_grImgCanalG.DrawLine(m_penBleu, _ i, m_aEchVisibles(iCanalG, i).iMin, _ i, m_aEchVisibles(iCanalG, i).iMax) Next i If m_oTFR.m_aSpectre(iSp2).bStereo Then For i = 0 To iNbEchEcran - 1 m_grImgCanalD.DrawLine(m_penMagenta, _ i, m_aEchVisibles(iCanalD, i).iMin, _ i, m_aEchVisibles(iCanalD, i).iMax) Next i End If End Sub Private Sub TracerSpectre(ByRef SpectreX As TSpectre, _ ByRef pinceau As Pen, _ ByRef GrImgSpectre As Graphics, _ ByRef ImgSpectre As PictureBox, _ ByVal iNumCanal%, ByVal bCalculerMinMax As Boolean) ' Taille exacte de l'écran If False Then GrImgSpectre.DrawLine(Drawing.Pens.Black, _ New Point(ImgSpectre.Width - iMarge, 0), _ New Point(0, ImgSpectre.Height - iMarge)) GrImgSpectre.DrawLine(Drawing.Pens.Black, _ New Point(0, 0), _ New Point(ImgSpectre.Width - iMarge, ImgSpectre.Height - iMarge)) End If If SpectreX.iNumSpectre = iSpNul Then Exit Sub Dim rY#, rMemY#, i% ' rMinSpectreLog#, 'Dim iyMax% = ImgCanalG.ClientRectangle.Height - iMarge * 2 'Dim iyMaxGD% = ImgSpectre.ClientRectangle.Height - iMarge * 2 Dim iyMax% = (Me.ImgCanalG.Height - iMarge) - iMarge * 2 Dim iyMaxGD% = (ImgSpectre.Height - iMarge) - iMarge * 2 Dim iNumSpectre% = SpectreX.iNumSpectre Dim bMinLog As Boolean = Me.ChkMinLog.Checked If bCalculerMinMax Then If SpectreX.bStereo Then CalculerMinMax(iNumSpectre, iCanalG, TCalculSpectre.Log, _ SpectreX.traceLogG.rMinSpectre, SpectreX.traceLogG.rMaxSpectre, bMinLog, bDecibels:=False) CalculerMinMax(iNumSpectre, iCanalD, TCalculSpectre.Log, _ SpectreX.traceLogD.rMinSpectre, SpectreX.traceLogD.rMaxSpectre, bMinLog, bDecibels:=False) CalculerMinMax(iNumSpectre, iCanalGD, TCalculSpectre.Log, _ SpectreX.traceLog.rMinSpectre, SpectreX.traceLog.rMaxSpectre, bMinLog, bDecibels:=False) m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre, SpectreX.traceLogG.rMinSpectre) m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre, SpectreX.traceLogD.rMinSpectre) m_oTFR.m_var.traceLog(iLog, iGD).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLog, iGD).rMinSpectre, SpectreX.traceLog.rMinSpectre) m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre, SpectreX.traceLogG.rMaxSpectre) m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre, SpectreX.traceLogD.rMaxSpectre) m_oTFR.m_var.traceLog(iLog, iGD).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLog, iGD).rMaxSpectre, SpectreX.traceLog.rMaxSpectre) CalculerMinMax(iNumSpectre, iCanalG, TCalculSpectre.Log, _ SpectreX.traceLogDBG.rMinSpectre, SpectreX.traceLogDBG.rMaxSpectre, _ bMinLog, bDecibels:=True) CalculerMinMax(iNumSpectre, iCanalD, TCalculSpectre.Log, _ SpectreX.traceLogDBD.rMinSpectre, SpectreX.traceLogDBD.rMaxSpectre, _ bMinLog, bDecibels:=True) CalculerMinMax(iNumSpectre, iCanalGD, TCalculSpectre.Log, _ SpectreX.traceLogDB.rMinSpectre, SpectreX.traceLogDB.rMaxSpectre, _ bMinLog, bDecibels:=True) m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre, SpectreX.traceLogDBG.rMinSpectre) m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre, SpectreX.traceLogDBD.rMinSpectre) m_oTFR.m_var.traceLog(iLogdB, iGD).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLogdB, iGD).rMinSpectre, SpectreX.traceLogDB.rMinSpectre) m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre, SpectreX.traceLogDBG.rMaxSpectre) m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre, SpectreX.traceLogDBD.rMaxSpectre) m_oTFR.m_var.traceLog(iLogdB, iGD).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLogdB, iGD).rMaxSpectre, SpectreX.traceLogDB.rMaxSpectre) Else CalculerMinMax(iNumSpectre, iCanalG, TCalculSpectre.Log, _ SpectreX.traceLogG.rMinSpectre, SpectreX.traceLogG.rMaxSpectre, _ bMinLog, bDecibels:=False) CalculerMinMax(iNumSpectre, iCanalG, TCalculSpectre.Log, _ SpectreX.traceLogDBG.rMinSpectre, SpectreX.traceLogDBG.rMaxSpectre, _ bMinLog, bDecibels:=True) m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre, SpectreX.traceLogG.rMinSpectre) m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre, SpectreX.traceLogG.rMaxSpectre) m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre = Math.Min( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre, SpectreX.traceLogDBG.rMinSpectre) m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre = Math.Max( _ m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre, SpectreX.traceLogDBG.rMaxSpectre) m_oTFR.m_var.traceLog(iLog, iGD) = m_oTFR.m_var.traceLog(iLog, i1C) m_oTFR.m_var.traceLog(iLogdB, iGD) = m_oTFR.m_var.traceLog(iLogdB, i1C) End If Exit Sub End If CalculerAmplitudeTrace(m_oTFR.m_var.traceLog(iLog, iGD), iyMaxGD) CalculerAmplitudeTrace(m_oTFR.m_var.traceLog(iLog, i1C), iyMax) CalculerAmplitudeTrace(m_oTFR.m_var.traceLog(iLogdB, iGD), iyMaxGD) CalculerAmplitudeTrace(m_oTFR.m_var.traceLog(iLogdB, i1C), iyMax) GrImgSpectre.DrawLine(m_penNoir, _ iMarge, iMarge + iyMaxGD, _ iMarge + (m_oTFR.m_var.iNbFreqTFR - 1) * m_oTFR.m_var.rMultiplicateurFreq, iMarge + iyMaxGD) Dim iNbEchEcran% = m_iNbPixelsImgLarg Dim iProportionAff% = CInt(m_oTFR.m_var.iNbFreqSpectre / iNbEchEcran) Dim iYMaxPixel% = 0 Dim iYMinPixel% = iyMaxGD Dim bDecibels As Boolean = Me.ChkDecibels.Checked For i = 0 To m_oTFR.m_var.iNbFreqSpectre - 1 If m_oTFR.m_var.iNbFreqSpectre <= iNbEchEcran Then rY = m_oTFR.rLireSpectre(i, iNumCanal, TCalculSpectre.Log, _ iNumSpectre, bDecibels, bMinLog, bTrace:=True) If i > 0 Then GrImgSpectre.DrawLine(pinceau, _ CInt(iMarge + (i - 1) * m_oTFR.m_var.rMultiplicateurFreq), _ CInt(iMarge + iyMaxGD - rMemY), _ CInt(iMarge + i * m_oTFR.m_var.rMultiplicateurFreq), _ CInt(iMarge + iyMaxGD - rY)) End If rMemY = rY Else rY = m_oTFR.rLireSpectre(i, iNumCanal, TCalculSpectre.Log, _ iNumSpectre, bDecibels, bMinLog, bTrace:=True) If rY < iYMinPixel Then iYMinPixel = CInt(rY) If rY > iYMaxPixel Then iYMaxPixel = CInt(rY) If (i Mod iProportionAff) = 0 And i > 0 Then ' Pour éviter que le trait ne devienne invisible If iYMaxPixel = iYMinPixel Then iYMaxPixel += 1 GrImgSpectre.DrawLine(pinceau, _ CInt(iMarge + (i - 1) * m_oTFR.m_var.rMultiplicateurFreq), _ CInt(iMarge + iyMaxGD - iYMinPixel), _ CInt(iMarge + (i - 1) * m_oTFR.m_var.rMultiplicateurFreq), _ CInt(iMarge + iyMaxGD - iYMaxPixel)) iYMaxPixel = 0 : iYMinPixel = iyMaxGD End If End If Next i End Sub Private Sub TracerDiffSpectre() ' Tracé de la différence moyenne de spectre If bTrapErr Then On Error GoTo Err_TDS Dim rYMax0!, iYMax0%, k%, l%, rXCoeff0!, rMemY#, rY# Dim penLocal As Pen = Nothing ' Référence de pinceau Dim iyMax% = Me.ImgSpectre.ClientRectangle.Height - iMarge * 2 iYMax0 = CInt(iyMax * 0.75) rXCoeff0 = m_oTFR.m_var.rMultiplicateurFreq * m_oTFR.m_var.iNbFreqParPlage m_grImgSpectre.DrawLine(m_penNoir, _ iMarge, iMarge + iyMax - iYMax0, _ iMarge + (m_oTFR.m_prm.iNbPlagesFrequence - 1) * rXCoeff0, _ iMarge + iyMax - iYMax0) ' En dB, on part de 0 dB à iYMax0 dB d'atténuation 'rYMax0 = 0.25 ' : 1 pixel = 4 dB 'rYMax0 = 0.5 ' : 1 pixel = 2 dB 'rYMax0 = 1 ' : 1 pixel = 1 dB rYMax0 = Me.NUDZoom.Value / 50.0! ' NumericUpDown For l = 1 To 6 For k = 0 To m_oTFR.m_prm.iNbPlagesFrequence - 1 Select Case l Case 1 : rY = m_oTFR.m_aPS(k).rDiffSpectreG : penLocal = m_penBleu Case 2 : rY = m_oTFR.m_aPS(k).rDiffSpectreD : penLocal = m_penMagenta Case 3 : rY = m_oTFR.m_aPS(k).rDiffSpectre : penLocal = m_penNoir Case 4 : rY = m_oTFR.m_aPS(k).rMoyDiffSpectreG : penLocal = m_penBleu Case 5 : rY = m_oTFR.m_aPS(k).rMoyDiffSpectreD : penLocal = m_penMagenta Case 6 rY = m_oTFR.m_aPS(k).rMoyDiffSpectre penLocal = m_penNoir ' Tracé en gras entre les fréquences de coupures Dim iNumPlage% = k Dim rCoefFreq! = CInt(0.001 * 0.5 * m_oTFR.m_aSpectre(iSp2).iFreqBase / _ m_oTFR.m_prm.iNbPlagesFrequence) Dim rFreq1! = rCoefFreq * iNumPlage Dim rFreq2! = rCoefFreq * (iNumPlage + 1) If rFreq2 >= m_oTFR.m_prm.rFreqCoupureBasseKhz And _ rFreq1 <= m_oTFR.m_prm.rFreqCoupureHauteKhz Then _ penLocal = m_penNoirGras End Select If Me.ChkDecibels.Checked Then ' Idée : majorer le nombre de dB par m_iMaxdBAcq16Bits ' et déterminer le zoom en conséquence ' (les décibels > 96 n'ont pas de sens ' pour une acquisitions 16 bits) 'If rY > m_iMaxdBAcq16Bits Then rY = m_iMaxdBAcq16Bits rY *= rYMax0 If l >= 4 Then rY *= -1 ' Tracé des moyennes en neg Else rY *= iYMax0 End If If k > 0 Then If Me.ChkDecibels.Checked Then m_grImgSpectre.DrawLine(penLocal, _ CInt(iMarge + (k - 1) * rXCoeff0), _ CInt(iMarge + iyMax - iYMax0 - rMemY), _ CInt(iMarge + k * rXCoeff0), _ CInt(iMarge + iyMax - iYMax0 - rY)) Else m_grImgSpectre.DrawLine(penLocal, _ CInt(iMarge + (k - 1) * rXCoeff0), _ CInt(iMarge + iyMax - rMemY), _ CInt(iMarge + k * rXCoeff0), _ CInt(iMarge + iyMax - rY)) End If End If rMemY = rY Next k : Next l Exit Sub Err_TDS: AfficherMsgErreur(Err, "", "TracerDiffSpectre") End Sub Private Sub CalculerAmplitudeTrace(ByRef traceLog As TTraceSpectre, ByVal iyMax%) ' Une seule amplitude pour 1, 2, G et D Dim rMinSpectreLog# = traceLog.rMinSpectre Dim rMaxSpectreLog# = traceLog.rMaxSpectre traceLog.rAmplitudeTrace = 1 If Not Me.ChkMinLog.Checked Then rMinSpectreLog = 0 If rMaxSpectreLog - rMinSpectreLog <> 0 Then _ traceLog.rAmplitudeTrace = iyMax / (rMaxSpectreLog - rMinSpectreLog) End Sub Private Sub CalculerMinMax(ByVal iNumSpectre%, ByVal iNumCanal%, _ ByVal TypeSpectre As TCalculSpectre, ByRef rMinSpectre#, _ ByRef rMaxSpectre#, ByVal bMinLog As Boolean, ByVal bDecibels As Boolean) rMaxSpectre = -rMaxDouble : rMinSpectre = rMaxDouble Dim i%, rSpectre# For i = 0 To m_oTFR.m_var.iNbFreqSpectre - 1 rSpectre = m_oTFR.rLireSpectre(i, iNumCanal, TypeSpectre, iNumSpectre, _ bDecibels, bMinLog, bTrace:=False) If rSpectre > rMaxSpectre Then rMaxSpectre = rSpectre If rSpectre < rMinSpectre Then rMinSpectre = rSpectre Next i End Sub Private Sub ChkRapport_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ChkRapport.CheckedChanged ProduireRapport() End Sub Private Sub CboPondMoy_SelectedIndexChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles CboPondMoy.SelectedIndexChanged Select Case Me.CboPondMoy.Text Case sTypePondAucune m_oTFR.m_prm.TypePonderationMoy = TPonderation.Aucune Case sTypePondHautesFreq m_oTFR.m_prm.TypePonderationMoy = TPonderation.HautesFrequences Case sTypePondEnergie m_oTFR.m_prm.TypePonderationMoy = TPonderation.Energie End Select ProduireRapport() End Sub Private Sub ChkNormaliser_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ChkNormaliser.CheckedChanged m_oTFR.m_prm.bNormaliserSpectre = False If Me.ChkNormaliser.Checked Then m_oTFR.m_prm.bNormaliserSpectre = True NouveauxFichiers() End Sub Private Sub ChkMinLog_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ChkMinLog.CheckedChanged Retracer() End Sub Private Sub NUDZoom_ValueChanged(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles NUDZoom.ValueChanged Retracer() End Sub Private Sub ChkDecibels_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ChkDecibels.CheckedChanged Retracer() ProduireRapport() End Sub Private Sub ChkRelatif_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles ChkRelatif.CheckedChanged ProduireRapport() End Sub Private Sub CmdNouveau_Click(ByVal sender As Object, ByVal e As EventArgs) _ Handles CmdNouveau.Click NouveauxFichiers() End Sub Private Sub NouveauxFichiers() ' Initialiser les fichiers m_oTFR.m_var.iNbSpectres = 0 m_oTFR.m_var.bDiffSpectreAffichable = False EffacerImg() If Not m_oTFR.m_var.bInit Then Exit Sub m_oTFR.m_var.traceLog(iLog, i1C).rMinSpectre = rMaxDouble m_oTFR.m_var.traceLog(iLog, iGD).rMinSpectre = rMaxDouble m_oTFR.m_var.traceLog(iLogdB, i1C).rMinSpectre = rMaxDouble m_oTFR.m_var.traceLog(iLogdB, iGD).rMinSpectre = rMaxDouble m_oTFR.m_var.traceLog(iLog, i1C).rMaxSpectre = rMinDouble m_oTFR.m_var.traceLog(iLog, iGD).rMaxSpectre = rMinDouble m_oTFR.m_var.traceLog(iLogdB, i1C).rMaxSpectre = rMinDouble m_oTFR.m_var.traceLog(iLogdB, iGD).rMaxSpectre = rMinDouble End Sub Protected Overrides Sub OnClick(ByVal e As System.EventArgs) 'Retracer() End Sub Private Sub MAJSpectres(Optional ByVal bCalculerMinMax As Boolean = False) If m_grImgSpectre Is Nothing Then Exit Sub If m_oTFR.m_var.iNbSpectres = 0 Then Exit Sub TracerSignal() If m_oTFR.m_var.iNbSpectres = 2 Then TracerSpectre(m_oTFR.m_aSpectre(iSp1), m_penJaune, _ m_grImgCanalG, ImgCanalG, iCanalG, bCalculerMinMax) TracerSpectre(m_oTFR.m_aSpectre(iSp1), m_penJaune, _ m_grImgCanalD, ImgCanalD, iCanalD, bCalculerMinMax) TracerSpectre(m_oTFR.m_aSpectre(iSp1), m_penJaune, _ m_grImgSpectre, ImgSpectre, iCanalGD, bCalculerMinMax) End If TracerSpectre(m_oTFR.m_aSpectre(iSp2), m_penGris, _ m_grImgCanalG, ImgCanalG, iCanalG, bCalculerMinMax) TracerSpectre(m_oTFR.m_aSpectre(iSp2), m_penGris, _ m_grImgCanalD, ImgCanalD, iCanalD, bCalculerMinMax) TracerSpectre(m_oTFR.m_aSpectre(iSp2), m_penGris, _ m_grImgSpectre, ImgSpectre, iCanalGD, bCalculerMinMax) If m_oTFR.m_var.bDiffSpectreAffichable Then TracerDiffSpectre() End Sub Private Sub Initialisation() ' Fct appelée juste après InitializeComponent() ' Activation du double buffering ' Non car on trace aussi lors de la lecture du wave : à revoir ' ControlStyles.AllPaintingInWmPaint Or ' ControlStyles.OptimizedDoubleBuffer ' ControlStyles.DoubleBuffer ' ControlStyles.UserPaint : seulement si ctrl : pas le cas ici : frm 'Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or _ ' ControlStyles.UserPaint Or ControlStyles.DoubleBuffer, True) 'Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or _ ' ControlStyles.DoubleBuffer, True) 'Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or _ ' ControlStyles.OptimizedDoubleBuffer, True) End Sub Private Sub Retracer() Me.Invalidate() 'MyBase.Invalidate() End Sub Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs) ' Appel de la fonction de base du tracé 'MyBase.OnPaint(e) ' Enlevé le 06/08/2007 ' Tenir compte du resize m_grImgSpectre = ImgSpectre.CreateGraphics m_grImgCanalG = ImgCanalG.CreateGraphics m_grImgCanalD = ImgCanalD.CreateGraphics EffacerImg() ' Pour attendre que le tracé soit effacé, sinon l'effacement ' se produit après le tracé ! c'est bizare mais nécessaire ' (pour tester : promener le bloc-notes sur le graphique : ' le DoEvents fait scintiller, mais est nécessaire) Application.DoEvents() MAJSpectres() End Sub Private Sub EffacerImg() If m_grImgSpectre Is Nothing Then Exit Sub If m_grImgCanalG Is Nothing Then Exit Sub If m_grImgCanalD Is Nothing Then Exit Sub m_grImgCanalG.Clear(Color.Cyan) m_grImgCanalD.Clear(Color.Cyan) m_grImgSpectre.Clear(Color.Cyan) End Sub Private Sub ProduireRapport() If Not m_oTFR.m_var.bInit Then Exit Sub If m_oTFR.m_var.iNbSpectres < 2 Then Exit Sub Cursor = Cursors.WaitCursor Dim sOperat$ = "/" Dim sUnite$ = "%" Dim sFormat$ = sFormatPC If Me.ChkDecibels.Checked Then _ sUnite = " dB" : sFormat$ = sFormatdB : sOperat = "-" Dim bStereo As Boolean = m_oTFR.m_aSpectre(iSp2).bStereo Dim mes2 As TMesureSpectre Dim mes1 As TMesureSpectre Dim mes As TMesuresComp m_oTFR.m_var.iNbFreqParPlage = CInt(Fix(m_oTFR.m_var.iNbFreqSpectre / m_oTFR.m_prm.iNbPlagesFrequence)) Dim sRapportG$, sRapportGD$, sRapportD$ sRapportG = "" : sRapportGD = "" : sRapportD = "" ' iNbCanauxSpectre - 1 : G, D, G+D ReDim mes1.mesLog(iNbCanauxSpectre - 1) ReDim mes1.mesLogDB(iNbCanauxSpectre - 1) ReDim mes1.mesD(iNbCanauxSpectre - 1) ReDim mes2.mesLog(iNbCanauxSpectre - 1) ReDim mes2.mesLogDB(iNbCanauxSpectre - 1) ReDim mes2.mesD(iNbCanauxSpectre - 1) ReDim mes.mesComp(iNbCanauxSpectre - 1) ReDim mes.mesCompDB(iNbCanauxSpectre - 1) ReDim mes.mesCompD(iNbCanauxSpectre - 1) m_oTFR.m_var.sComparaisonFinale(iCanalGD) = "" m_oTFR.m_var.sComparaisonFinale(iCanalG) = "" m_oTFR.m_var.sComparaisonFinale(iCanalD) = "" Const iNumFichier% = 2 Dim sFichier1Ext$ = m_oTFR.m_aSpectre(iSp1).sFichierAudio Dim sFichier1$ = IO.Path.GetFileNameWithoutExtension(sFichier1Ext) Dim sFichier2Ext$ = m_oTFR.m_aSpectre(iSp2).sFichierAudio Dim sFichier2$ = IO.Path.GetFileNameWithoutExtension(sFichier2Ext) Dim sFichier$ = Application.StartupPath & "/Comp" & sFichier1 & sFichier2 & ".txt" 'Dim sFichier$ = Application.StartupPath & "/Comp" & _ ' VB.Left(m_oTFR.m_aSpectre(iSp1).sFichierAudio, _ ' Len(m_oTFR.m_aSpectre(iSp1).sFichierAudio) - 4) & _ ' VB.Left(m_oTFR.m_aSpectre(iSp2).sFichierAudio, _ ' Len(m_oTFR.m_aSpectre(iSp2).sFichierAudio) - 4) & ".txt" FileOpen(iNumFichier, sFichier, OpenMode.Output, _ OpenAccess.Write, OpenShare.LockReadWrite) PrintLine(iNumFichier, _ "Rapport sur la comparaison spectrale des fichiers audio") PrintLine(iNumFichier, "Fichier de référence (1) : " & _ m_oTFR.m_aSpectre(iSp1).sCheminFichierAudio & m_oTFR.m_aSpectre(iSp1).sFichierAudio) PrintLine(iNumFichier, "Fichier comparé (2) : " & _ m_oTFR.m_aSpectre(iSp2).sCheminFichierAudio & m_oTFR.m_aSpectre(iSp2).sFichierAudio) PrintLine(iNumFichier, "DiffSpectre = Fichier comparé " & _ sOperat & " référence en " & sUnite) If bStereo Then sRapportGD = sRapportFrequences(mes, mes1, mes2, iCanalGD) sRapportD = sRapportFrequences(mes, mes1, mes2, iCanalD) End If sRapportG = sRapportFrequences(mes, mes1, mes2, iCanalG) PrintLine(iNumFichier, "") PrintLine(iNumFichier, "Comparaison finale = DiffSpectre moyenne :") PrintLine(iNumFichier, "entre les fréquences de coupure basse et haute, et au final :") PrintLine(iNumFichier, "GD : " & m_oTFR.m_var.sComparaisonFinale(iCanalGD) & _ ":" & sFormater(m_oTFR.m_var.rComparaisonFinale(iCanalGD), sFormat)) PrintLine(iNumFichier, "G : " & m_oTFR.m_var.sComparaisonFinale(iCanalG) & ":" & _ sFormater(m_oTFR.m_var.rComparaisonFinale(iCanalG), sFormat)) PrintLine(iNumFichier, "D : " & m_oTFR.m_var.sComparaisonFinale(iCanalD) & ":" & _ sFormater(m_oTFR.m_var.rComparaisonFinale(iCanalD), sFormat)) If m_oTFR.m_prm.bNormaliserSpectre Then PrintLine(iNumFichier, _ "Le signal est normalisé en entrée (amplitude max.) avant le calcul du spectre") Else PrintLine(iNumFichier, _ "Le signal n'est pas normalisé en entrée (amplitude max.) avant le calcul du spectre") End If PrintLine(iNumFichier, "") PrintLine(iNumFichier, "Nombre de fréquences du spectre : " & _ m_oTFR.m_var.iNbFreqSpectre) PrintLine(iNumFichier, "Fréquence de coupure basse : " & _ m_oTFR.m_prm.rFreqCoupureBasseKhz & " KHz") PrintLine(iNumFichier, "Fréquence de coupure haute : " & _ m_oTFR.m_prm.rFreqCoupureHauteKhz & " KHz") PrintLine(iNumFichier, "Fréquence mesurable minimale : " & _ sFormater(0.5 * m_oTFR.m_aSpectre(iSp2).iFreqBase / _ m_oTFR.m_var.iNbFreqSpectre, sFormatFreq)) PrintLine(iNumFichier, "Fréquence maximale : " & _ sFormater(0.5 * m_oTFR.m_aSpectre(iSp2).iFreqBase, sFormatFreq)) PrintLine(iNumFichier, "Nombre de plages de fréquence : " & _ m_oTFR.m_prm.iNbPlagesFrequence) PrintLine(iNumFichier, "Nombre de fréquences par plage : " & _ m_oTFR.m_var.iNbFreqParPlage) Select Case m_oTFR.m_prm.TypePonderationMoy Case TPonderation.Energie PrintLine(iNumFichier, _ "Les moyennes sont pondérées par l'énergie de chaque plage de fréquence") Case TPonderation.HautesFrequences PrintLine(iNumFichier, _ "Les moyennes sont pondérées par les hautes fréquences") Case TPonderation.Aucune PrintLine(iNumFichier, "Les moyennes ne sont pas pondérées") End Select PrintLine(iNumFichier, "ESR : Energie du signal de référence (1)") PrintLine(iNumFichier, "ESC : Energie du signal comparé (2)") If m_oTFR.m_prm.TypePonderationMoy <> TPonderation.Aucune Then _ PrintLine(iNumFichier, "1+2 : Energie des signx comparé + référ.") If Me.ChkDecibels.Checked Then PrintLine(iNumFichier, "0 dB indique que toute l'énergie est conservée dans la bande spectrale") PrintLine(iNumFichier, "9 dB correspond à une atténuation de 50% de l'intensité acoustique") PrintLine(iNumFichier, "96 dB correspond au maximum de la dynamique d'un signal échantillonné sur 16 bits (CD audio)") PrintLine(iNumFichier, "La moyenne affichée est celle des valeurs absolues des DiffSpectre") Else PrintLine(iNumFichier, "100% indique que toute l'énergie est conservée dans la bande spectrale") PrintLine(iNumFichier, " 50% indique que 50% de l'énergie est conservée dans la bande spectrale") PrintLine(iNumFichier, "La moyenne affichée est celle des DiffSpectre ou 1/DiffSpectre tjrs < 100%") End If PrintLine(iNumFichier, "Le ratio G/D1 est l'énergie du canal gauche sur droite du signal 1") PrintLine(iNumFichier, "Le ratio G/D2 est l'énergie du canal gauche sur droite du signal 2") If bStereo Then PrintLine(iNumFichier, "") PrintLine(iNumFichier, sRapportGD) Else PrintLine(iNumFichier, "") PrintLine(iNumFichier, sRapportG) End If If clsTFR.bChronometrer Then 'PrintLine(iNumFichier, "Temps de calcul global du spectre 1 (lecture + TFR) : " & _ ' sFormater(m_oTFR.m_aSpectre(iSp1).rTpsGlobal, sFormatSec)) 'PrintLine(iNumFichier, "Temps de calcul global du spectre 2 (lecture + TFR) : " & _ ' sFormater(m_oTFR.m_aSpectre(iSp2).rTpsGlobal, sFormatSec)) 'PrintLine(iNumFichier, "Temps de calcul du spectre 1 : " & _ ' sFormater(m_oTFR.m_aSpectre(iSp1).rTpsTFR, sFormatSec)) 'PrintLine(iNumFichier, "Temps de calcul du spectre 2 : " & _ ' sFormater(m_oTFR.m_aSpectre(iSp2).rTpsTFR, sFormatSec)) PrintLine(iNumFichier, "Temps de calcul global du spectre 1 (lecture + TFR) en sec.: " & _ m_oTFR.m_aSpectre(iSp1).tsTpsGlobal.TotalMilliseconds / 1000) PrintLine(iNumFichier, "Temps de calcul global du spectre 2 (lecture + TFR) en sec.: " & _ m_oTFR.m_aSpectre(iSp2).tsTpsGlobal.TotalMilliseconds / 1000) PrintLine(iNumFichier, "Temps de calcul du spectre 1 en sec.: " & _ m_oTFR.m_aSpectre(iSp1).tsTpsTFR.TotalMilliseconds / 1000) PrintLine(iNumFichier, "Temps de calcul du spectre 2 en sec.: " & _ m_oTFR.m_aSpectre(iSp2).tsTpsTFR.TotalMilliseconds / 1000) End If PrintLine(iNumFichier, "Durée du signal 1 en sec. : " & _ m_oTFR.m_aSpectre(iSp1).rDureeSignalSec) PrintLine(iNumFichier, "Durée du signal 2 en sec. : " & _ m_oTFR.m_aSpectre(iSp2).rDureeSignalSec) PrintLine(iNumFichier, "Nombre d'échantillons du signal 1 : " & _ m_oTFR.m_aSpectre(iSp1).iNbEchSignal) PrintLine(iNumFichier, "Nombre d'échantillons du signal 2 : " & _ m_oTFR.m_aSpectre(iSp2).iNbEchSignal) If bStereo Then PrintLine(iNumFichier, "") PrintLine(iNumFichier, sRapportG) PrintLine(iNumFichier, "") PrintLine(iNumFichier, sRapportD) End If PrintLine(iNumFichier, "") FileClose(iNumFichier) Dim sCmd$ = "Notepad.exe " & sFichier m_oTFR.m_var.bDiffSpectreAffichable = True If Not Me.ChkRapport.Checked Then GoTo Fin Shell(sCmd, AppWinStyle.NormalFocus) Fin: Cursor = Cursors.Default End Sub Private Function sRapportFrequences$(ByRef mes As TMesuresComp, _ ByRef mes1 As TMesureSpectre, _ ByRef mes2 As TMesureSpectre, ByVal iNumCanal%) Dim sLigne$, sRapportGD$ Dim iIndice%, iNumPlage%, iNumFreq% Dim iNbSpectres2%, iNbSpectres1% Dim bDecibels As Boolean = Me.ChkDecibels.Checked Dim bRelatif As Boolean = Me.ChkRelatif.Checked sLigne = "" : sRapportGD = "" If iNumCanal = iCanalG Then sLigne = sLigne & "Analyse des fréquences du canal de gauche" & vbCrLf iNbSpectres2 = m_oTFR.m_aSpectre(iSp2).iNbSpectresG iNbSpectres1 = m_oTFR.m_aSpectre(iSp1).iNbSpectresG mes2.rModuleSpectraleFinal = m_oTFR.m_aSpectre(iSp2).rModuleSpectraleG mes1.rModuleSpectraleFinal = m_oTFR.m_aSpectre(iSp1).rModuleSpectraleG ElseIf iNumCanal = iCanalD Then sLigne = sLigne & "Analyse des fréquences du canal de droite" & vbCrLf iNbSpectres2 = m_oTFR.m_aSpectre(iSp2).iNbSpectresD iNbSpectres1 = m_oTFR.m_aSpectre(iSp1).iNbSpectresD mes2.rModuleSpectraleFinal = m_oTFR.m_aSpectre(iSp2).rModuleSpectraleD mes1.rModuleSpectraleFinal = m_oTFR.m_aSpectre(iSp1).rModuleSpectraleD Else sLigne = sLigne & "Analyse des fréquences" & vbCrLf iNbSpectres2 = m_oTFR.m_aSpectre(iSp2).iNbSpectresG + m_oTFR.m_aSpectre(iSp2).iNbSpectresD iNbSpectres1 = m_oTFR.m_aSpectre(iSp1).iNbSpectresG + m_oTFR.m_aSpectre(iSp1).iNbSpectresD mes2.rModuleSpectraleFinal = _ m_oTFR.m_aSpectre(iSp2).rModuleSpectraleG + _ m_oTFR.m_aSpectre(iSp2).rModuleSpectraleD mes1.rModuleSpectraleFinal = _ m_oTFR.m_aSpectre(iSp1).rModuleSpectraleG + _ m_oTFR.m_aSpectre(iSp1).rModuleSpectraleD End If m_oTFR.InitMesures(mes, mes1, mes2) ' Calcul du max. Log For iNumPlage = 0 To m_oTFR.m_prm.iNbPlagesFrequence - 1 m_oTFR.InitMesuresPlage(mes1, mes2) For iNumFreq = 0 To m_oTFR.m_var.iNbFreqParPlage - 1 iIndice = iNumPlage * m_oTFR.m_var.iNbFreqParPlage + iNumFreq m_oTFR.CalculerSommeSpectres(iIndice, mes1, mes2) Next iNumFreq m_oTFR.CalculerEnergieLocale(mes, mes1, mes2, iNumCanal, bNoterMax:=True) If m_oTFR.m_prm.TypePonderationMoy = TPonderation.HautesFrequences Then mes.mesCompFin.rCoefAssoc = iNumPlage + 1 mes.mesCompFin.rSommeCoefAssoc += mes.mesCompFin.rCoefAssoc End If Next iNumPlage Dim sFormat$ = sFormatPC Dim sFormatPositif$ = sFormatPCPositif If Me.ChkDecibels.Checked Then _ sFormat$ = sFormatdB : sFormatPositif = sFormatdBPositif m_oTFR.InitMesures(mes, mes1, mes2) Dim iNbFreqComptabilises% = 0 For iNumPlage = 0 To m_oTFR.m_prm.iNbPlagesFrequence - 1 m_oTFR.InitMesuresPlage(mes1, mes2) For iNumFreq = 0 To m_oTFR.m_var.iNbFreqParPlage - 1 iIndice = iNumPlage * m_oTFR.m_var.iNbFreqParPlage + iNumFreq m_oTFR.CalculerSommeSpectres(iIndice, mes1, mes2) Next iNumFreq m_oTFR.CalculerEnergieLocale(mes, mes1, mes2) m_oTFR.ComparerSpectres(mes, mes1, mes2, iNumCanal, sRapportGD, iNumPlage, _ bDecibels, bRelatif) iNbFreqComptabilises += m_oTFR.m_var.iNbFreqParPlage Dim rMoyDiffSpectre# = mes.mesCompFin.rMoyDiffSpectre Dim sCoef$ = "" If m_oTFR.m_prm.TypePonderationMoy <> TPonderation.Aucune Then rMoyDiffSpectre = mes.mesCompFin.rMoyDiffSpectrePond sCoef = sFormater(mes.mesCompFin.rCoefAssoc, "000.00%:Coef") & " " End If Dim rCoefFreq! = CSng(0.001 * 0.5 * m_oTFR.m_aSpectre(iSp2).iFreqBase / _ m_oTFR.m_prm.iNbPlagesFrequence) Dim rFreq1! = rCoefFreq * iNumPlage Dim rFreq2! = rCoefFreq * (iNumPlage + 1) Dim sMoy$ = sFormater(rMoyDiffSpectre, sFormatCourt) & " " If rFreq2 >= m_oTFR.m_prm.rFreqCoupureBasseKhz And _ rFreq1 <= m_oTFR.m_prm.rFreqCoupureHauteKhz Then _ m_oTFR.m_var.sComparaisonFinale(iNumCanal) &= sMoy sLigne &= _ sFormater(rFreq1, "00.0") & "-" & _ sFormater(rFreq2, "00.0 KHz") & _ " Diff=" & sFormater(mes.mesCompFin.rDiffSpectre, sFormat) & _ " Moy=" & sFormater(rMoyDiffSpectre, sFormatPositif) & " " & _ sCoef & _ sFormater(mes2.mesLogFin.rEnergieLocaleNorm, "000.00%:ESC") & " " & _ sFormater(mes1.mesLogFin.rEnergieLocaleNorm, "000.00%:ESR") & _ sRapportGD & vbCrLf Next iNumPlage If bDebug Then ' On doit obtenir 100% sLigne = sLigne & "Somme des coeff. de pond. : " & _ sFormater(mes.mesCompFin.rSommeCoefAssoc, "000.0000%") & vbCrLf sLigne = sLigne & "Somme des % energie 1 Log : " & _ sFormater(mes1.mesLogFin.rSommeCoefEnergLocNorm, "000.0000%") & vbCrLf sLigne = sLigne & "Somme des % energie 2 Log : " & _ sFormater(mes2.mesLogFin.rSommeCoefEnergLocNorm, "000.0000%") & vbCrLf End If sLigne = sLigne & "Nombre de fréquences comptabilisées : " & _ iNbFreqComptabilises & vbCrLf If iNumCanal = iCanalGD Then sLigne = sLigne & "Rapport G/D final (1) = " & _ sFormater(mes1.rRapportGD, sFormatPC) & vbCrLf sLigne = sLigne & "Rapport G/D final (2) = " & _ sFormater(mes2.rRapportGD, sFormatPC) & vbCrLf If mes1.rRapportGD <> 0 Then sLigne = sLigne & _ "Evolution des Rapports G/D finaux 2/1 = " & _ sFormater(mes2.rRapportGD / mes1.rRapportGD, sFormatPC) & vbCrLf End If If mes1.rModuleSpectraleFinal <> 0 Then _ sLigne = sLigne & "DiffSpectre globale " & _ "(comparaison du volume globale des 2 signaux) : " & sFormater( _ mes2.rModuleSpectraleFinal / _ mes1.rModuleSpectraleFinal, sFormatPC) & vbCrLf Dim bPond As Boolean = (m_oTFR.m_prm.TypePonderationMoy <> TPonderation.Aucune) sLigne = sLigne & "DiffSpectre moyenne finale : " & _ sFormater(mes.mesCompFin.rMoyDiffSpectre, sFormat) & vbCrLf If bPond Then _ sLigne = sLigne & "DiffSpectre moy. finale pond. : " & _ sFormater(mes.mesCompFin.rMoyDiffSpectrePond, sFormat) & vbCrLf sLigne = sLigne & "DiffSpectre moyenne dB : " & _ sFormater(mes.mesCompDB(iNumCanal).rMoyDiffSpectre, sFormatdB) & vbCrLf If bPond Then _ sLigne = sLigne & "DiffSpectre moyenne dB pond. : " & _ sFormater(mes.mesCompDB(iNumCanal).rMoyDiffSpectrePond, sFormatdB) & vbCrLf sLigne = sLigne & "DiffSpectre moyenne Log : " & _ sFormater(mes.mesComp(iNumCanal).rMoyDiffSpectre, sFormatPC) & vbCrLf If bPond Then _ sLigne = sLigne & "DiffSpectre moyenne Log pond. : " & _ sFormater(mes.mesComp(iNumCanal).rMoyDiffSpectrePond, sFormatPC) & vbCrLf sLigne = sLigne & "DiffSpectre moyenne directe : " & _ sFormater(mes.mesCompD(iNumCanal).rMoyDiffSpectre, sFormatPC) & vbCrLf If bPond Then _ sLigne = sLigne & "DiffSpectre moy. directe pond. : " & _ sFormater(mes.mesCompD(iNumCanal).rMoyDiffSpectrePond, sFormatPC) & vbCrLf If m_oTFR.m_prm.TypePonderationMoy <> TPonderation.Aucune Then m_oTFR.m_var.rComparaisonFinale(iNumCanal) = mes.mesCompFin.rMoyDiffSpectrePond Else m_oTFR.m_var.rComparaisonFinale(iNumCanal) = mes.mesCompFin.rMoyDiffSpectre End If Dim sInfo$ = "" If iNumCanal = iCanalGD Then sInfo = "(G+D)" sLigne = sLigne & "Nombre de spectres 1 calculés " & sInfo & " : " & iNbSpectres1 & vbCrLf sLigne = sLigne & "Nombre de spectres 2 calculés " & sInfo & " : " & iNbSpectres2 sRapportFrequences = sLigne End Function Private Sub ImgSpectre_MouseMove(ByVal eventSender As Object, _ ByVal eventArgs As MouseEventArgs) Handles ImgSpectre.MouseMove Dim X! = eventArgs.X Dim lNumEchantillon%, iNumPlage% CalculerCoordSpectre(X, lNumEchantillon, m_oTFR.m_prm.rFreqSelect, iNumPlage) Me.LblFrequence.Text = "Fréquence : " & m_oTFR.m_prm.rFreqSelect & " Hz" Dim sFormat$ = sFormatPC If Me.ChkDecibels.Checked Then sFormat = sFormatdB If Not m_oTFR.m_var.bDiffSpectreAffichable Then Me.LblDiffSpectreG.Text = "Différence Spectrale" Me.LblDiffSpectreD.Text = "Différence Spectrale (droite)" Me.LblDiffSpectre.Text = "Différence Spectrale" Exit Sub End If ' Diff. de spectre d'une fréquence Dim sDiffSpectreG0$, sDiffSpectre0$, sDiffSpectreD0$ sDiffSpectre0 = "" sDiffSpectreG0 = "" sDiffSpectreD0 = "" Me.LblDiffSpectre.Text = "" If Me.ChkDecibels.Checked Then sDiffSpectreG0 = sFormater( _ 10 * Math.Log(m_oTFR.m_aSC(iSp2, iCanalG, lNumEchantillon).rSommeNEC) - _ 10 * Math.Log(m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSommeNEC), sFormat) If m_oTFR.m_aSpectre(iSp2).bStereo And m_oTFR.m_aSpectre(iSp1).bStereo Then sDiffSpectreD0 = sFormater( _ 10 * Math.Log(m_oTFR.m_aSC(iSp2, iCanalD, lNumEchantillon).rSommeNEC) - _ 10 * Math.Log(m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSommeNEC), sFormat) sDiffSpectre0 = sFormater( _ 10 * Math.Log( _ m_oTFR.m_aSC(iSp2, iCanalG, lNumEchantillon).rSommeNEC + _ m_oTFR.m_aSC(iSp2, iCanalD, lNumEchantillon).rSommeNEC) - _ 10 * Math.Log( _ m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSommeNEC + _ m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSommeNEC), sFormat) End If Else If m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSpectre <> 0 Then _ sDiffSpectreG0 = sFormater( _ m_oTFR.m_aSC(iSp2, iCanalG, lNumEchantillon).rSpectre / _ m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSpectre, sFormat) If m_oTFR.m_aSpectre(iSp2).bStereo And m_oTFR.m_aSpectre(iSp1).bStereo Then If m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSpectre <> 0 Then _ sDiffSpectreD0 = sFormater( _ m_oTFR.m_aSC(iSp2, iCanalD, lNumEchantillon).rSpectre / _ m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSpectre, sFormat) If m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSpectre + _ m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSpectre <> 0 Then _ sDiffSpectre0 = sFormater( _ (m_oTFR.m_aSC(iSp2, iCanalG, lNumEchantillon).rSpectre + _ m_oTFR.m_aSC(iSp2, iCanalD, lNumEchantillon).rSpectre) / _ (m_oTFR.m_aSC(iSp1, iCanalG, lNumEchantillon).rSpectre + _ m_oTFR.m_aSC(iSp1, iCanalD, lNumEchantillon).rSpectre), sFormat) End If End If ' Diff de spectre d'une plage de fréquence Dim sDiffSpectre$, sMoyDiffSpectre$ Dim sDiffSpectreG$, sMoyDiffSpectreG$ Dim sDiffSpectreD$, sMoyDiffSpectreD$ sDiffSpectre = "" sMoyDiffSpectre = "" sDiffSpectreG = "" sMoyDiffSpectreG = "" sDiffSpectreD = "" sMoyDiffSpectreD = "" sDiffSpectreG = sFormater(m_oTFR.m_aPS(iNumPlage).rDiffSpectreG, sFormat) sMoyDiffSpectreG = sFormater(m_oTFR.m_aPS(iNumPlage).rMoyDiffSpectreG, sFormat) If m_oTFR.m_aSpectre(iSp2).bStereo And m_oTFR.m_aSpectre(iSp1).bStereo Then sDiffSpectre = sFormater(m_oTFR.m_aPS(iNumPlage).rDiffSpectre, sFormat) sMoyDiffSpectre = sFormater(m_oTFR.m_aPS(iNumPlage).rMoyDiffSpectre, sFormat) sDiffSpectreD = sFormater(m_oTFR.m_aPS(iNumPlage).rDiffSpectreD, sFormat) sMoyDiffSpectreD = sFormater(m_oTFR.m_aPS(iNumPlage).rMoyDiffSpectreD, sFormat) Me.LblDiffSpectre.Text = "DiffLocal : " & sDiffSpectre0 & _ " DiffPlage " & iNumPlage + 1 & " : " & sDiffSpectre & _ " MoyDiffPlage : " & sMoyDiffSpectre Me.LblDiffSpectreD.Text = "DiffLocalD : " & sDiffSpectreD0 & _ " DiffPlageD " & iNumPlage + 1 & " : " & sDiffSpectreD & _ " MoyDiffPlageD : " & sMoyDiffSpectreD End If Me.LblDiffSpectreG.Text = "DiffLocalG : " & sDiffSpectreG0 & _ " DiffPlageG " & iNumPlage + 1 & " : " & sDiffSpectreG & _ " MoyDiffPlageG : " & sMoyDiffSpectreG End Sub Private Sub ImgSpectre_MouseDown(ByVal eventSender As Object, _ ByVal eventArgs As MouseEventArgs) Handles ImgSpectre.MouseDown Dim iFreqBeepHz% = CInt(m_oTFR.m_prm.rFreqSelect) If m_oTFR.m_prm.rFreqSelect < 0 Then iFreqBeepHz = 200 If m_oTFR.m_prm.rFreqSelect > 22050 Then iFreqBeepHz = 200 Beep(iFreqBeepHz, 250) ' Freq et durée en ms End Sub Private Sub CalculerCoordSpectre(ByVal X!, _ ByRef iNumEchantillon%, ByRef rFreqSelect!, ByRef iNumPlage%) ' Détermination de l'échantillon de la tfr iNumEchantillon = CInt((X - iMarge) / m_oTFR.m_var.rMultiplicateurFreq) If iNumEchantillon < 0 Then iNumEchantillon = 0 If iNumEchantillon > m_oTFR.m_var.iNbFreqTFR - 1 Then _ iNumEchantillon = m_oTFR.m_var.iNbFreqTFR - 1 If iNumEchantillon > m_oTFR.m_var.iNbFreqTFR / 2 Then If clsTFR.bAfficher2SpectresSymetriques Then iNumEchantillon = m_oTFR.m_var.iNbFreqTFR - iNumEchantillon Else iNumEchantillon = 0 End If End If ' Calcul de la fréquence If iNumEchantillon = 0 Or iNumEchantillon = m_oTFR.m_var.iNbFreqTFR / 2 Then rFreqSelect = 0 Else rFreqSelect = CSng(0.5 * m_oTFR.m_aSpectre(iSp2).iFreqBase * _ iNumEchantillon / (m_oTFR.m_var.iNbFreqTFR / 2 - 1)) End If If m_oTFR.m_var.iNbFreqParPlage = 0 Then Exit Sub Dim iZoom% = 1 If clsTFR.bAfficher2SpectresSymetriques Then iZoom = 2 iNumPlage = CInt(iZoom * (X - iMarge) / (m_oTFR.m_var.rMultiplicateurFreq * _ m_oTFR.m_var.iNbFreqParPlage)) If iNumPlage < 0 Then iNumPlage = 0 If clsTFR.bAfficher2SpectresSymetriques Then If iNumPlage > m_oTFR.m_prm.iNbPlagesFrequence - 1 Then _ iNumPlage = m_oTFR.m_prm.iNbPlagesFrequence * 2 - iNumPlage - 1 If iNumPlage < 0 Then iNumPlage = 0 Else If iNumPlage > m_oTFR.m_prm.iNbPlagesFrequence - 1 Then _ iNumPlage = m_oTFR.m_prm.iNbPlagesFrequence - 1 End If End Sub Private Sub cmdFichier1_Click(ByVal sender As Object, ByVal e As EventArgs) _ Handles cmdFichier1.Click ChoisirFichierWav() End Sub Private Sub ChoisirFichierWav() Dim sFichierWav$ = "" If bChoisirFichierWav(sFichierWav) Then Me.txtFichier1.Text = sFichierWav End Sub 'Private Sub cmdFichier2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) ' ' Dim sFichierWav$ ' If bChoisirFichierWav(sFichierWav) Then Me.txtFichier2.Text = sFichierWav ' 'End Sub Private Function bChoisirFichierWav(ByRef sFichierWav$) As Boolean ' Gerer la boîte de dialogue pour choisir un fichier .wav Dim sInitDir$, sFichier$ sInitDir = "" : sFichier = "" ' Initialiser le chemin seulement la première fois Static bDejaInit As Boolean If Not bDejaInit Then bDejaInit = True : sInitDir = Application.StartupPath If bChoisirFichier(sFichier, sMsgFiltreDoc, "*.txt", sMsgTitreBoiteDlg, sInitDir) Then bChoisirFichierWav = True sFichierWav = sFichier End If End Function Private Sub txtFichier1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtFichier1.DoubleClick If Me.txtFichier1.Text = "" Then ChoisirFichierWav() : Exit Sub LireFichierWave( _ IO.Path.GetFileName(Me.txtFichier1.Text), _ IO.Path.GetDirectoryName(Me.txtFichier1.Text)) End Sub 'Private Sub txtFichier2_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) ' LireFichierWave( _ ' IO.Path.GetFileName(Me.txtFichier2.Text), _ ' IO.Path.GetDirectoryName(Me.txtFichier2.Text)) 'End Sub End Class clsTFR.vb ' Fichier clsTFR.vb : Gestion de la Transformée de Fourier Rapide (TFR) ' --------------------------------------------------------------------- ' Bannière de l'auteur de la TFR : '---------------------------------------------------------------------- ' Audio FFT '---------------------------------------------------------------------- ' This code is basically a stripped-down and ironed-out version of ' my VB FFT Library (available on the Deeth website) done entirely ' with digital audio in mind. ' My VB FFT Library (and thusly -- this as well) is heavily based on ' Don Cross's FFT code. '---------------------------------------------------------------------- ' Murphy McCauley (MurphyMc@Concentric.NET) 08/14/99 '---------------------------------------------------------------------- Public Class clsTFR ' Constantes par défaut Private Const iFreqBaseDef% = 44100 ' Par défaut 44.1 KHz ' Pour calculer le log en décibels (dB) 'Const rPressionP0Pascal# = 20 * (10 ^ -6) 'Const rPressionP0Pascal# = 0.00002 ' Pression P0 au carré en Pascal (Pa) Private Const rPressionP0Pa2# = 0.0000000004 Public m_aSpectre(iNbCanaux - 1) As TSpectre ' 2 spectres Private m_rImagOut#() ' Tableau en interne de la TFR (partie imaginaire) Public m_rRealOut#() ' Tableau en sortie de la TFR (partie réelle et finale) ' Used to store pre-calculated values Private m_iReversedBits%() Public Const bChronometrer As Boolean = True Public Const bAfficher2SpectresSymetriques As Boolean = False ' Structure des paramètres de la TFR Public Structure TParametresTFR Dim iNbBitsTFR% ' Nbre de bits de la TFR ' Résultats finaux présentés entre ces 2 fréq. Dim rFreqCoupureBasseKhz!, rFreqCoupureHauteKhz! ' Fréquence sélectionnée à la souris sur le spectre Dim rFreqSelect! ' Type de pondération des moyennes des diff. de spectre Dim TypePonderationMoy As TPonderation Dim bNormaliserSpectre As Boolean Dim iNbPlagesFrequence% ' Nombre de plages de fréquence End Structure ' Structure des variables de la TFR Public Structure TVariablesTFR Dim iNbFreqTFR% ' = 2 ^ iNbBitsTFR : Nbre de fréquences de la TFR Dim iNbFreqSpectre% ' = Moitié moins car le spectre est symétrique Dim iNbFreqParPlage% ' Nbre de fréquences par plage Dim sComparaisonFinale$() Dim rComparaisonFinale#() Dim rMultiplicateurFreq! 'Dim rCoef# ' Pas utilisé encore Dim iNbSpectres% ' Nombre de spectres en mémoire Dim bDiffSpectreAffichable As Boolean Dim bInit As Boolean ' Vrai lorsque tout est initialisé Dim traceLog(,) As TTraceSpectre End Structure Public m_prm As TParametresTFR Public m_var As TVariablesTFR ' Type du tableau pour le calcul du Log et du Log dB ' des spectres G et D du signal Public Structure TSpectreCalcule Dim rSpectre# ' Spectre pour le calcul du Log Dim rSommeNEC# ' Somme de Niveau Equivalent Cumulable pour le Log dB End Structure ' Tableau des spectres G et D des signaux 1 et 2 en LogdB ou bien directe ' Dimensions : iNumSpectre, iCanal, iIndice Public m_aSC(,,) As TSpectreCalcule ' Structure pour stocker les différences de spectre Public Structure TPlageSpectre Dim rDiffSpectre# ' Diff. de spectre de la plage Dim rDiffSpectreG# Dim rDiffSpectreD# Dim rMoyDiffSpectre# ' Moy des diff. de spectre jusqu'à cette plage Dim rMoyDiffSpectreG# Dim rMoyDiffSpectreD# End Structure ' Tableau des différences de spectre Public m_aPS() As TPlageSpectre Public Sub InitTFR() If bTrapErr Then On Error GoTo Err_InitTFR m_var.iNbFreqTFR = CInt(2 ^ m_prm.iNbBitsTFR) m_var.iNbFreqSpectre = CInt(m_var.iNbFreqTFR / 2) If bAfficher2SpectresSymetriques Then m_var.iNbFreqSpectre = m_var.iNbFreqTFR ReDim m_aPS(m_prm.iNbPlagesFrequence - 1) ReDim m_iReversedBits(m_var.iNbFreqTFR - 1) FFTDoReverse() ' Pré-calcul pour la TFR ' Dimensions : dB ou pas, GD ou pas ReDim m_var.traceLog(1, 1) ' Spectre 0 et 1 ; canal G, D et GD : iNbCanauxSpectre = 3 ReDim m_aSC(iNbSpectres - 1, iNbCanauxSpectre - 1, m_var.iNbFreqTFR - 1) ReDim m_var.sComparaisonFinale(iNbCanauxSpectre - 1) ReDim m_var.rComparaisonFinale(iNbCanauxSpectre - 1) m_aSpectre(iSp2).iFreqBase = iFreqBaseDef ' Par défaut 44.1 KHz m_aSpectre(iSp1).iNumSpectre = iSpNul m_aSpectre(iSp2).iNumSpectre = iSpNul ReDim m_rImagOut(m_var.iNbFreqTFR - 1) ReDim m_rRealOut(m_var.iNbFreqTFR - 1) Exit Sub Err_InitTFR: AfficherMsgErreur(Err, "Impossible d'initialiser VBWaveComp.Net", "InitTFR") End Sub Public Sub MemoriserSpectre1() If m_var.iNbSpectres <> 1 Then Exit Sub ' S'il n'y a qu'un seul spectre, on le recopie m_aSpectre(iSp1) = m_aSpectre(iSp2) m_aSpectre(iSp1).iNumSpectre = iSp1 Dim i% For i = 0 To m_var.iNbFreqSpectre - 1 m_aSC(iSp1, iCanalG, i) = m_aSC(iSp2, iCanalG, i) m_aSC(iSp1, iCanalD, i) = m_aSC(iSp2, iCanalD, i) Next i End Sub Public Sub CalculerSpectre(ByRef aiSeqEchSgl(,) As Short, _ Optional ByVal bInit As Boolean = False, _ Optional ByVal bFin As Boolean = False) ' Calcul du spectre If bFin Then GoTo Fin Dim i% If bInit Then ' Initialisation du spectre m_aSpectre(iSp2).iNumSpectre = iSp2 ' Spectre du signal n°2 For i = 0 To m_var.iNbFreqSpectre - 1 m_aSC(iSp2, iCanalG, i).rSpectre = 0 m_aSC(iSp2, iCanalD, i).rSpectre = 0 m_aSC(iSp2, iCanalG, i).rSommeNEC = 0 m_aSC(iSp2, iCanalD, i).rSommeNEC = 0 aiSeqEchSgl(iCanalG, i) = 0 aiSeqEchSgl(iCanalD, i) = 0 Next i InitAmplitudeTrace(m_aSpectre(iSp2).traceLog) InitAmplitudeTrace(m_aSpectre(iSp2).traceLogG) InitAmplitudeTrace(m_aSpectre(iSp2).traceLogD) InitAmplitudeTrace(m_aSpectre(iSp2).traceLogDB) InitAmplitudeTrace(m_aSpectre(iSp2).traceLogDBG) InitAmplitudeTrace(m_aSpectre(iSp2).traceLogDBD) m_aSpectre(iSp2).iNbSpectresG = 0 m_aSpectre(iSp2).iNbSpectresD = 0 m_aSpectre(iSp2).rModuleSpectraleG = 0 m_aSpectre(iSp2).rModuleSpectraleD = 0 'If bChronometrer Then m_aSpectre(iSp2).rTpsGlobal = VB.Timer() 'm_aSpectre(iSp2).rTpsTFR = 0 'If bChronometrer Then m_aSpectre(iSp2).tsTpsGlobal.Add(Now.Subtract(dDebTpsTFR)) If bChronometrer Then m_aSpectre(iSp2).dtDeb = Now m_aSpectre(iSp2).tsTpsGlobal = New TimeSpan(0) m_aSpectre(iSp2).tsTpsTFR = New TimeSpan(0) End If Exit Sub End If Dim rValTfr#, rValSqr# FFTAudio(aiSeqEchSgl, TCalculSpectre.Carre, _ iCanalG, m_aSpectre(iSp2).tsTpsTFR) For i = 0 To m_var.iNbFreqSpectre - 1 rValTfr = m_rRealOut(i) rValSqr = Math.Sqrt(rValTfr) m_aSC(iSp2, iCanalG, i).rSpectre += rValSqr m_aSC(iSp2, iCanalG, i).rSommeNEC += _ rCalculerNEC(rValTfr, TCalculSpectre.Log) m_aSpectre(iSp2).rModuleSpectraleG += rValSqr Next i m_aSpectre(iSp2).iNbSpectresG += 1 FFTAudio(aiSeqEchSgl, TCalculSpectre.Carre, _ iCanalD, m_aSpectre(iSp2).tsTpsTFR) For i = 0 To m_var.iNbFreqSpectre - 1 rValTfr = m_rRealOut(i) rValSqr = Math.Sqrt(rValTfr) m_aSC(iSp2, iCanalD, i).rSpectre += rValSqr m_aSC(iSp2, iCanalD, i).rSommeNEC += _ rCalculerNEC(rValTfr, TCalculSpectre.Log) m_aSpectre(iSp2).rModuleSpectraleD += rValSqr Next i m_aSpectre(iSp2).iNbSpectresD += 1 Exit Sub Fin: 'If bChronometrer Then m_aSpectre(iSp2).rTpsGlobal = _ ' (VB.Timer - m_aSpectre(iSp2).rTpsGlobal) If bChronometrer Then Dim dtFin As DateTime = Now Dim tsTps As TimeSpan = dtFin.Subtract(m_aSpectre(iSp2).dtDeb) m_aSpectre(iSp2).tsTpsGlobal = m_aSpectre(iSp2).tsTpsGlobal.Add(tsTps) 'Dim lMs& = m_aSpectre(iSp2).tsTpsGlobal.TotalMilliseconds End If If m_var.iNbSpectres < 2 Then m_var.iNbSpectres += 1 End Sub Private Sub InitAmplitudeTrace(ByRef trace As TTraceSpectre) trace.rAmplitudeTrace = 1 trace.rMinSpectre = 0 trace.rMaxSpectre = 0 End Sub Public Function rCalculerNEC#(ByRef rSpectre2#, _ ByVal TypeSpectre As TCalculSpectre) ' Le spectre calculé doit être du type iSpectreCarre Select Case TypeSpectre 'Case iSpectreReelAbs: rCalculerNEC = rSpectre2 ' Pas utilisé 'Case iSpectreCarre : rCalculerNEC = rSpectre2 ' Pas utilisé 'Case iSpectreNormal : rCalculerNEC = Math.Sqrt(rSpectre2) ' Pas utilisé Case TCalculSpectre.Log ' Etapes de calcul du spectre en décibels (dB) ' -------------------------------------------- ' On appelle intensité, l'énergie d'une onde acoustique : ' L'énergie est proportionnelle au carré de l'amplitude ' de l'onde acoustique, soit P². ' 1°) rSpectre2 est proportionnel à P², ' car il est calculé suivant iSpectreCarre (voir TFR) : ' RealOut(i) = RealOut(i) * RealOut(i) + ImagOut(i) * ImagOut(i) ' 2°) Niveau Equivalent en dB : NE = 10*Log(P²/P0²) ' 3°) Niveau Equivalent Global en dB pour plusieurs fréquences ' NEG = 10*Log( 10^(NE1/10) + 10^(NE2/10) + ...) ' 4°) Niveau Equivalent Global en dB pour G+D : même principe ' NEGGD = 10*Log( 10^(NEGG/10) + 10^(NEGD/10) ) ' 5°) Niveau Equivalent Cumulable : NEC = 10 ^ (NE / 10) ' NEC = 10^( NE /10) soit : ' NEC = 10^( 10*Log(P²/P0²) /10) soit : ' NEC = 10^( Log(P²/P0²) ) : Formule finale de la fonction ' et donc on calculera ensuite : ' NEG = 10*Log( NEC1 + NEC2 + ... ) ' NEGGD = 10*Log( NECG1 + NECD1 + NECG2 + NECD2 + ... ) ' 6°) SommeNECG = NECG1 + NECG2 + ... ' SommeNECD = NECD1 + NECD2 + ... ' 7°) SpectreLogG dB = 10*Log(SommeNECG) ' SpectreLogD dB = 10*Log(SommeNECD) ' SpectreLogGD dB = 10*Log(SommeNECG + SommeNECD) If rSpectre2 = 0 Then rCalculerNEC = 0 : Exit Function rCalculerNEC = 10 ^ Math.Log(rSpectre2 / rPressionP0Pa2) End Select End Function Private Function rCalculerLog#(ByVal rSpectre#, _ ByVal rMinSpectreLog#, ByVal rCoefLog#, _ ByVal bTrace As Boolean, ByVal bMinLog As Boolean) If rSpectre = 0 Then 'If bDebug Then Stop rCalculerLog = 0 Exit Function End If rCalculerLog = Math.Log(rSpectre) If bTrace Then If Not bMinLog Then rMinSpectreLog = 0 rCalculerLog = (rCalculerLog - rMinSpectreLog) * rCoefLog End If End Function Private Function rCalculerLogGD#(ByVal rSpectreG2#, ByVal rSpectreD2#, _ ByVal rMinSpectreLog#, ByVal rCoefLog#, _ ByVal bTrace As Boolean, ByVal bMinLog As Boolean) If rSpectreG2 + rSpectreD2 = 0 Then 'If bDebug Then Stop rCalculerLogGD = 0 Exit Function End If rCalculerLogGD = Math.Log(Math.Sqrt(rSpectreG2) + Math.Sqrt(rSpectreD2)) If bTrace Then If Not bMinLog Then rMinSpectreLog = 0 rCalculerLogGD = (rCalculerLogGD - rMinSpectreLog) * rCoefLog End If End Function Private Function rCalculerLogDB#(ByVal rNEC#, _ ByVal rMinSpectreLogDB#, ByVal rCoefLogDB#, _ ByVal bTrace As Boolean, ByVal bMinLog As Boolean) If rNEC = 0 Then 'If bDebug Then Stop rCalculerLogDB = 0 Exit Function End If rCalculerLogDB = 10 * Math.Log(rNEC) If bTrace Then If Not bMinLog Then rMinSpectreLogDB = 0 rCalculerLogDB = (rCalculerLogDB - rMinSpectreLogDB) * rCoefLogDB End If End Function Private Function rCalculerLogDBGD#(ByVal rNECG#, ByVal rNECD#, _ ByVal rMinSpectreLogDB#, ByVal rCoefLogDB#, _ ByVal bTrace As Boolean, ByVal bMinLog As Boolean) If rNECG + rNECD = 0 Then 'If bDebug Then Stop rCalculerLogDBGD = 0 Exit Function End If ' Niveau Equivalent G et D rCalculerLogDBGD = 10 * Math.Log(rNECG + rNECD) If bTrace Then If Not bMinLog Then rMinSpectreLogDB = 0 rCalculerLogDBGD = (rCalculerLogDBGD - rMinSpectreLogDB) * rCoefLogDB End If End Function Public Function rLireSpectre#(ByVal iIndice%, _ ByVal iNumCanal%, ByVal TypeSpectre As TCalculSpectre, _ ByVal iNumSpectre%, ByVal bDecibels As Boolean, _ ByVal bMinLog As Boolean, ByVal bTrace As Boolean) Dim iTypeLog% = iLog If bDecibels Then iTypeLog = iLogdB Dim iTypeCanal% = i1C If iNumCanal = iCanalGD Then iTypeCanal = iGD Dim rMinSpectre# = m_var.traceLog(iTypeLog, iTypeCanal).rMinSpectre Dim rAmplitudeTrace# = m_var.traceLog(iTypeLog, iTypeCanal).rAmplitudeTrace If iNumCanal = iCanalGD Then Select Case TypeSpectre Case TCalculSpectre.Log If bDecibels Then rLireSpectre = rCalculerLogDBGD( _ m_aSC(iNumSpectre, iCanalG, iIndice).rSommeNEC, _ m_aSC(iNumSpectre, iCanalD, iIndice).rSommeNEC, _ rMinSpectre, rAmplitudeTrace, bTrace, bMinLog) Else rLireSpectre = rCalculerLogGD( _ m_aSC(iNumSpectre, iCanalG, iIndice).rSpectre, _ m_aSC(iNumSpectre, iCanalD, iIndice).rSpectre, _ rMinSpectre, rAmplitudeTrace, bTrace, bMinLog) End If ' Pas encore utilisé : Case TCalculSpectre.Carre rLireSpectre = _ Math.Pow(m_aSC(iNumSpectre, iCanalG, iIndice).rSpectre, 2) + _ Math.Pow(m_aSC(iNumSpectre, iCanalD, iIndice).rSpectre, 2) 'If bTrace Then rLireSpectre = rLireSpectre * m_var.rCoef Case TCalculSpectre.Normal rLireSpectre = _ m_aSC(iNumSpectre, iCanalG, iIndice).rSpectre + _ m_aSC(iNumSpectre, iCanalD, iIndice).rSpectre 'If bTrace Then rLireSpectre = rLireSpectre * m_var.rCoef End Select Exit Function End If If TypeSpectre = TCalculSpectre.Log Then If bDecibels Then rLireSpectre = rCalculerLogDB( _ m_aSC(iNumSpectre, iNumCanal, iIndice).rSommeNEC, _ rMinSpectre, rAmplitudeTrace, bTrace, bMinLog) Else rLireSpectre = rCalculerLog( _ m_aSC(iNumSpectre, iNumCanal, iIndice).rSpectre, _ rMinSpectre, rAmplitudeTrace, bTrace, bMinLog) End If Exit Function End If ' Pas utilisé encore : Dim rSpectre# = m_aSC(iNumSpectre, iNumCanal, iIndice).rSpectre If TypeSpectre = TCalculSpectre.Carre Then rLireSpectre = rSpectre * rSpectre ElseIf TypeSpectre = TCalculSpectre.Normal Then rLireSpectre = rSpectre End If 'If bTrace Then rLireSpectre = rLireSpectre * m_var.rCoef End Function Public Sub ComparerSpectres(ByRef mes As TMesuresComp, _ ByRef mes1 As TMesureSpectre, ByRef mes2 As TMesureSpectre, _ ByVal iNumCanal%, ByRef sRapportGD$, ByVal iNumPlage%, _ ByVal bDecibels As Boolean, ByVal bRelatif As Boolean) ComparerSpectresMesure(mes.mesCompD(iCanalG), _ mes1.mesD(iCanalG), mes2.mesD(iCanalG), _ iNumPlage, mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompD(iCanalG), mes.mesCompD(iCanalD), bRelatif) ComparerSpectresMesure(mes.mesCompD(iCanalD), _ mes1.mesD(iCanalD), mes2.mesD(iCanalD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompD(iCanalG), mes.mesCompD(iCanalD), bRelatif) ComparerSpectresMesure(mes.mesCompD(iCanalGD), _ mes1.mesD(iCanalGD), mes2.mesD(iCanalGD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompD(iCanalG), mes.mesCompD(iCanalD), bRelatif, bGD:=True) ComparerSpectresMesure(mes.mesComp(iCanalG), _ mes1.mesLog(iCanalG), mes2.mesLog(iCanalG), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesComp(iCanalG), mes.mesComp(iCanalD), bRelatif) ComparerSpectresMesure(mes.mesComp(iCanalD), _ mes1.mesLog(iCanalD), mes2.mesLog(iCanalD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesComp(iCanalG), mes.mesComp(iCanalD), bRelatif) ComparerSpectresMesure(mes.mesComp(iCanalGD), _ mes1.mesLog(iCanalGD), mes2.mesLog(iCanalGD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesComp(iCanalG), mes.mesComp(iCanalD), bRelatif, bGD:=True) ComparerSpectresMesure(mes.mesCompDB(iCanalG), _ mes1.mesLogDB(iCanalG), mes2.mesLogDB(iCanalG), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompDB(iCanalG), mes.mesCompDB(iCanalD), bRelatif, , bDecibel:=True) ComparerSpectresMesure(mes.mesCompDB(iCanalD), _ mes1.mesLogDB(iCanalD), mes2.mesLogDB(iCanalD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompDB(iCanalG), mes.mesCompDB(iCanalD), bRelatif, , bDecibel:=True) ComparerSpectresMesure(mes.mesCompDB(iCanalGD), _ mes1.mesLogDB(iCanalGD), mes2.mesLogDB(iCanalGD), iNumPlage, _ mes1.rModuleSpectraleFinal, mes2.rModuleSpectraleFinal, _ mes.mesCompDB(iCanalG), mes.mesCompDB(iCanalD), _ bRelatif, bGD:=True, bDecibel:=True) Dim mesLog1 As TMesureEnergieSpectre Dim mesLog2 As TMesureEnergieSpectre Dim mesComp As TMesureComp mesComp = mes.mesComp(iNumCanal) mesLog1 = mes1.mesLog(iNumCanal) mesLog2 = mes2.mesLog(iNumCanal) If bDecibels Then mesComp = mes.mesCompDB(iNumCanal) mesLog1 = mes1.mesLogDB(iNumCanal) mesLog2 = mes2.mesLogDB(iNumCanal) End If 'If Not bEnergieDirecte Then mesComp = mes.mesCompD(iNumCanal) mes.mesCompFin = mesComp mes1.mesLogFin = mesLog1 mes2.mesLogFin = mesLog2 If iNumCanal = iCanalG Then m_aPS(iNumPlage).rDiffSpectreG = mesComp.rDiffSpectre m_aPS(iNumPlage).rMoyDiffSpectreG = mesComp.rMoyDiffSpectre If m_prm.TypePonderationMoy <> TPonderation.Aucune Then _ m_aPS(iNumPlage).rMoyDiffSpectreG = mesComp.rMoyDiffSpectrePond ElseIf iNumCanal = iCanalD Then m_aPS(iNumPlage).rDiffSpectreD = mesComp.rDiffSpectre m_aPS(iNumPlage).rMoyDiffSpectreD = mesComp.rMoyDiffSpectre If m_prm.TypePonderationMoy <> TPonderation.Aucune Then _ m_aPS(iNumPlage).rMoyDiffSpectreD = mesComp.rMoyDiffSpectrePond Else m_aPS(iNumPlage).rDiffSpectre = mesComp.rDiffSpectre m_aPS(iNumPlage).rMoyDiffSpectre = mesComp.rMoyDiffSpectre If m_prm.TypePonderationMoy <> TPonderation.Aucune Then _ m_aPS(iNumPlage).rMoyDiffSpectre = mesComp.rMoyDiffSpectrePond If mes2.mesD(iCanalD).rSommeSpectre <> 0 Then mes2.rRapportGD = _ mes2.mesD(iCanalG).rSommeSpectre / mes2.mesD(iCanalD).rSommeSpectre If mes1.mesD(iCanalD).rSommeSpectre <> 0 Then mes1.rRapportGD = _ mes1.mesD(iCanalG).rSommeSpectre / mes1.mesD(iCanalD).rSommeSpectre sRapportGD = ", G/D1=" & sFormater(mes1.rRapportGD, sFormatPC) & _ ", G/D2=" & sFormater(mes2.rRapportGD, sFormatPC) End If End Sub Private Sub ComparerSpectresMesure(ByRef mesComp As TMesureComp, _ ByRef mesLog1 As TMesureEnergieSpectre, _ ByRef mesLog2 As TMesureEnergieSpectre, ByVal iNumPlage%, _ ByVal rModuleSpectraleFinal1#, ByVal rModuleSpectraleFinal2#, _ ByRef mesCompG As TMesureComp, ByRef mesCompD As TMesureComp, _ ByVal bRelatif As Boolean, _ Optional ByVal bGD As Boolean = False, _ Optional ByVal bDecibel As Boolean = False) If bDecibel Then ' Diff de spectre en dB ' Rappel : ' mesLogDB.rEnergieLocale = 10 * Math.Log(mesLogDB.rSommeSpectre) mesComp.rDiffSpectre = mesLog2.rEnergieLocale - mesLog1.rEnergieLocale mesComp.rDiffSpectreNorm = Math.Abs(mesComp.rDiffSpectre) If bGD Then ' On fait la moyenne de la différence de spectre normalisée ' de façon à ce que les voies G et D ne se compensent pas : ' Moy(-5dB + 5dB) = 5dB et non 0dB If Math.Sign(mesCompG.rDiffSpectre) <> Math.Sign(mesCompD.rDiffSpectre) Then mesComp.rDiffSpectreNorm = _ 0.5 * (mesCompG.rDiffSpectreNorm + mesCompD.rDiffSpectreNorm) mesComp.rDiffSpectre = mesComp.rDiffSpectreNorm Else mesComp.rDiffSpectre = _ 0.5 * (mesCompG.rDiffSpectre + mesCompD.rDiffSpectre) mesComp.rDiffSpectreNorm = Math.Abs(mesComp.rDiffSpectre) End If End If Else ' Comparaison If m_prm.bNormaliserSpectre Or Not bRelatif Then If mesLog1.rEnergieLocale <> 0 Then _ mesComp.rDiffSpectre = _ mesLog2.rEnergieLocale / mesLog1.rEnergieLocale Else ' Nouveau : Si Me.ChkRelatif.Checked, ' on relativise avec le module spectral qui est tjrs bien ' proportionnel à l'energie totale du signal If mesLog1.rEnergieLocale <> 0 And rModuleSpectraleFinal1 <> 0 Then _ mesComp.rDiffSpectre = _ mesLog2.rEnergieLocale * rModuleSpectraleFinal2 / _ (mesLog1.rEnergieLocale * rModuleSpectraleFinal1) End If If mesComp.rDiffSpectre <= 1 Then mesComp.rDiffSpectreNorm = mesComp.rDiffSpectre Else ' Si le signal est augmenté, la moyenne est comptabilité ' en % inversé : <= 100% mesComp.rDiffSpectreNorm = 0 If m_prm.bNormaliserSpectre Or Not bRelatif Then If mesLog2.rEnergieLocale <> 0 Then _ mesComp.rDiffSpectreNorm = _ mesLog1.rEnergieLocale / mesLog2.rEnergieLocale Else If mesLog2.rEnergieLocale <> 0 And rModuleSpectraleFinal2 <> 0 Then _ mesComp.rDiffSpectreNorm = _ mesLog1.rEnergieLocale * rModuleSpectraleFinal1 / _ (mesLog2.rEnergieLocale * rModuleSpectraleFinal2) End If End If If bGD Then ' On fait la moyenne de la différence de spectre normalisée ' de façon à ce que les voies G et D ne se compensent pas : ' Moy(90% + 110%) = 90% et non 100% mesComp.rDiffSpectreNorm = _ 0.5 * (mesCompG.rDiffSpectreNorm + mesCompD.rDiffSpectreNorm) mesComp.rDiffSpectre = mesComp.rDiffSpectreNorm End If End If mesComp.rSommeDiffSpectre += mesComp.rDiffSpectreNorm ' Normalisation de l'energie locale log If mesLog2.rMaxCoefEnergLoc <> 0 Then _ mesLog2.rEnergieLocaleNorm = _ mesLog2.rEnergieLocale / mesLog2.rMaxCoefEnergLoc If mesLog1.rMaxCoefEnergLoc <> 0 Then _ mesLog1.rEnergieLocaleNorm = _ mesLog1.rEnergieLocale / mesLog1.rMaxCoefEnergLoc mesLog1.rSommeCoefEnergLocNorm += mesLog1.rEnergieLocaleNorm mesLog2.rSommeCoefEnergLocNorm += mesLog2.rEnergieLocaleNorm Select Case m_prm.TypePonderationMoy Case TPonderation.Energie ' Pondération par l'énergie locale normalisée mesComp.rCoefAssoc = 0.5 * _ (mesLog2.rEnergieLocaleNorm + mesLog1.rEnergieLocaleNorm) Case TPonderation.HautesFrequences ' Pondération proportionnelle à la fréquence, car les basses ' fréquences sont toujours bien conservées, elles ne sont ' donc pas bien discriminantes pour mesurer la qualité de ' la conservation du signal mesComp.rCoefAssoc = iNumPlage + 1 If mesComp.rMaxCoefAssoc <> 0 Then _ mesComp.rCoefAssoc /= mesComp.rMaxCoefAssoc Case TPonderation.Aucune ' Pas de pondération mesComp.rCoefAssoc = 1 / m_prm.iNbPlagesFrequence End Select mesComp.rSommeCoefAssoc += mesComp.rCoefAssoc mesComp.rSommeDiffSpectrePond += _ mesComp.rDiffSpectreNorm * mesComp.rCoefAssoc mesComp.rMoyDiffSpectre = mesComp.rSommeDiffSpectre / (iNumPlage + 1) mesComp.rMoyDiffSpectrePond = _ mesComp.rSommeDiffSpectrePond / mesComp.rSommeCoefAssoc End Sub Public Sub InitMesures(ByRef mes As TMesuresComp, _ ByRef mes1 As TMesureSpectre, ByRef mes2 As TMesureSpectre) InitMesure(mes1) InitMesure(mes2) InitMesuresComp(mes) End Sub Private Sub InitMesure(ByRef mes As TMesureSpectre) mes.rRapportGD = 0 InitMesureSpectre(mes.mesLog(iCanalGD)) InitMesureSpectre(mes.mesLog(iCanalG)) InitMesureSpectre(mes.mesLog(iCanalD)) InitMesureSpectre(mes.mesLogDB(iCanalGD)) InitMesureSpectre(mes.mesLogDB(iCanalG)) InitMesureSpectre(mes.mesLogDB(iCanalD)) InitMesureSpectre(mes.mesD(iCanalGD)) InitMesureSpectre(mes.mesD(iCanalG)) InitMesureSpectre(mes.mesD(iCanalD)) End Sub Private Sub InitMesuresComp(ByRef mes As TMesuresComp) InitMesureComp(mes.mesCompFin) If mes.mesComp Is Nothing Then Exit Sub InitMesureComp(mes.mesComp(iCanalG)) InitMesureComp(mes.mesComp(iCanalD)) InitMesureComp(mes.mesComp(iCanalGD)) InitMesureComp(mes.mesCompDB(iCanalGD)) InitMesureComp(mes.mesCompDB(iCanalG)) InitMesureComp(mes.mesCompDB(iCanalD)) InitMesureComp(mes.mesCompD(iCanalG)) InitMesureComp(mes.mesCompD(iCanalD)) InitMesureComp(mes.mesCompD(iCanalGD)) End Sub Private Sub InitMesureSpectre(ByRef mesLog As TMesureEnergieSpectre) mesLog.rSommeSpectre = 0 mesLog.rEnergieLocale = 0 mesLog.rSommeCoefEnergLoc = 0 mesLog.rSommeCoefEnergLocNorm = 0 mesLog.rEnergieLocaleNorm = 0 End Sub Private Sub InitMesureComp(ByRef mesComp As TMesureComp) mesComp.rCoefAssoc = 1 mesComp.rDiffSpectre = 0 mesComp.rDiffSpectreNorm = 0 mesComp.rSommeCoefAssoc = 0 mesComp.rSommeDiffSpectre = 0 mesComp.rSommeDiffSpectrePond = 0 mesComp.rMoyDiffSpectre = 0 mesComp.rMoyDiffSpectrePond = 0 End Sub Public Sub InitMesuresPlage( _ ByRef mes1 As TMesureSpectre, ByRef mes2 As TMesureSpectre) InitMesurePlage(mes1) InitMesurePlage(mes2) End Sub Private Sub InitMesurePlage(ByRef mes As TMesureSpectre) InitMesureSpectrePlage(mes.mesLog(iCanalGD)) InitMesureSpectrePlage(mes.mesLog(iCanalG)) InitMesureSpectrePlage(mes.mesLog(iCanalD)) InitMesureSpectrePlage(mes.mesLogDB(iCanalGD)) InitMesureSpectrePlage(mes.mesLogDB(iCanalG)) InitMesureSpectrePlage(mes.mesLogDB(iCanalD)) End Sub Private Sub InitMesureSpectrePlage( _ ByRef mesLog As TMesureEnergieSpectre) mesLog.rSommeSpectre = 0 mesLog.rEnergieLocale = 0 mesLog.rEnergieLocaleNorm = 0 End Sub Public Sub CalculerEnergieLocale( _ ByRef mes As TMesuresComp, _ ByRef mes1 As TMesureSpectre, _ ByRef mes2 As TMesureSpectre, _ Optional ByVal iNumCanal% = iCanalG, _ Optional ByVal bNoterMax As Boolean = False) CalculerEnergieLocaleMS(mes1) CalculerEnergieLocaleMS(mes2) If bNoterMax Then mes1.mesLog(iCanalGD).rMaxCoefEnergLoc = mes1.mesLog(iCanalGD).rSommeCoefEnergLoc mes1.mesLog(iCanalG).rMaxCoefEnergLoc = mes1.mesLog(iCanalG).rSommeCoefEnergLoc mes1.mesLog(iCanalD).rMaxCoefEnergLoc = mes1.mesLog(iCanalD).rSommeCoefEnergLoc mes1.mesLogDB(iCanalGD).rMaxCoefEnergLoc = mes1.mesLogDB(iCanalGD).rSommeCoefEnergLoc mes1.mesLogDB(iCanalG).rMaxCoefEnergLoc = mes1.mesLogDB(iCanalG).rSommeCoefEnergLoc mes1.mesLogDB(iCanalD).rMaxCoefEnergLoc = mes1.mesLogDB(iCanalD).rSommeCoefEnergLoc mes2.mesLog(iCanalGD).rMaxCoefEnergLoc = mes2.mesLog(iCanalGD).rSommeCoefEnergLoc mes2.mesLog(iCanalG).rMaxCoefEnergLoc = mes2.mesLog(iCanalG).rSommeCoefEnergLoc mes2.mesLog(iCanalD).rMaxCoefEnergLoc = mes2.mesLog(iCanalD).rSommeCoefEnergLoc mes2.mesLogDB(iCanalGD).rMaxCoefEnergLoc = mes2.mesLogDB(iCanalGD).rSommeCoefEnergLoc mes2.mesLogDB(iCanalG).rMaxCoefEnergLoc = mes2.mesLogDB(iCanalG).rSommeCoefEnergLoc mes2.mesLogDB(iCanalD).rMaxCoefEnergLoc = mes2.mesLogDB(iCanalD).rSommeCoefEnergLoc mes.mesCompFin.rMaxCoefAssoc = mes.mesCompFin.rSommeCoefAssoc mes.mesComp(iNumCanal).rMaxCoefAssoc = mes.mesCompFin.rMaxCoefAssoc mes.mesCompDB(iNumCanal).rMaxCoefAssoc = mes.mesCompFin.rMaxCoefAssoc mes.mesCompD(iNumCanal).rMaxCoefAssoc = mes.mesCompFin.rMaxCoefAssoc End If End Sub Private Sub CalculerEnergieLocaleMS(ByRef mes As TMesureSpectre) CalculerEnergieLocaleDirecte(mes.mesD(iCanalGD)) CalculerEnergieLocaleDirecte(mes.mesD(iCanalG)) CalculerEnergieLocaleDirecte(mes.mesD(iCanalD)) ' Il n'y a pas bcp de différence entre Log et LogDB : juste 10* CalculerEnergieLocaleLog(mes.mesLog(iCanalGD)) CalculerEnergieLocaleLog(mes.mesLog(iCanalG)) CalculerEnergieLocaleLog(mes.mesLog(iCanalD)) CalculerEnergieLocaleDB(mes.mesLogDB(iCanalGD)) CalculerEnergieLocaleDB(mes.mesLogDB(iCanalG)) CalculerEnergieLocaleDB(mes.mesLogDB(iCanalD)) End Sub Private Sub CalculerEnergieLocaleDirecte(ByRef mes As TMesureEnergieSpectre) ' Calcul le plus simple : somme des modules spectraux mes.rEnergieLocale = mes.rSommeSpectre mes.rSommeCoefEnergLoc += mes.rEnergieLocale End Sub Private Sub CalculerEnergieLocaleLog(ByRef mesLog As TMesureEnergieSpectre) If mesLog.rSommeSpectre = 0 Then Exit Sub mesLog.rEnergieLocale = Math.Log(mesLog.rSommeSpectre) mesLog.rSommeCoefEnergLoc += mesLog.rEnergieLocale End Sub Private Sub CalculerEnergieLocaleDB(ByRef mesLogDB As TMesureEnergieSpectre) If mesLogDB.rSommeSpectre = 0 Then Exit Sub mesLogDB.rEnergieLocale = 10 * Math.Log(mesLogDB.rSommeSpectre) mesLogDB.rSommeCoefEnergLoc += mesLogDB.rEnergieLocale End Sub Public Sub CalculerSommeSpectres(ByVal iIndice%, _ ByRef mes1 As TMesureSpectre, ByRef mes2 As TMesureSpectre) CalculerSommeSpectresLog(iIndice, mes1, iSp1) CalculerSommeSpectresLog(iIndice, mes2, iSp2) CalculerSommeSpectresNEC(iIndice, mes1, iSp1) CalculerSommeSpectresNEC(iIndice, mes2, iSp2) End Sub Private Sub CalculerSommeSpectresLog(ByRef lIndice%, _ ByRef mes As TMesureSpectre, ByVal iNumSpectre%) ' On calcule une somme de somme mes.mesLog(iCanalG).rSommeSpectre += m_aSC(iNumSpectre, iCanalG, lIndice).rSpectre mes.mesLog(iCanalD).rSommeSpectre += m_aSC(iNumSpectre, iCanalD, lIndice).rSpectre mes.mesLog(iCanalGD).rSommeSpectre = _ mes.mesLog(iCanalG).rSommeSpectre + mes.mesLog(iCanalD).rSommeSpectre mes.mesD(iCanalG) = mes.mesLog(iCanalG) mes.mesD(iCanalD) = mes.mesLog(iCanalD) mes.mesD(iCanalGD) = mes.mesLog(iCanalGD) End Sub Private Sub CalculerSommeSpectresNEC(ByRef lIndice%, _ ByRef mes As TMesureSpectre, ByVal iNumSpectre%) ' En mode Log dB, le spectre contient maintenant une ' somme de Niv. Equiv. cumulables ' On calcule donc une somme de sommeNEC mes.mesLogDB(iCanalG).rSommeSpectre += _ m_aSC(iNumSpectre, iCanalG, lIndice).rSommeNEC mes.mesLogDB(iCanalD).rSommeSpectre += _ m_aSC(iNumSpectre, iCanalD, lIndice).rSommeNEC mes.mesLogDB(iCanalGD).rSommeSpectre = _ mes.mesLogDB(iCanalG).rSommeSpectre + mes.mesLogDB(iCanalD).rSommeSpectre End Sub Public Sub FFTAudio(ByRef RealIn(,) As Short, _ ByVal TypeSpectre As TCalculSpectre, ByVal iNumCanal%, ByRef tsTpsTFR As TimeSpan) 'ByRef rTpsTFR!) 'In this case, iNbFreqTFR isn't included (since it's always the same), 'and the imaginary components are left out since they have no meaning here. 'I've used Singles instead of Doubles pretty much everywhere. I think this 'makes it faster, but due to type conversion, it actually might not. I should 'check, but I haven't. ' Patrice : Double au lieu de Single pour augmenter la précision 'The imaginary components have no meaning in this application. I just left out 'the parts of the calculation that need the imaginary input values (which is a 'big speed improvement right there), but we still need the output array because 'it's used in the calculation. It's static so that it doesn't get reallocated. 'Static ImagOut#() 'ReDim ImagOut(m_var.iNbFreqTFR - 1) ' Patrice : m_rImagOut tableau privé de la classe au lieu de Static 'In fact... I declare everything as static! They all get initialized elsewhere, 'and Staticing them saves from wasting time reallocating and takes pressure off 'the heap. ' Patrice : pas besoin de Static, c'est assez difficile à maintenir comme code ' et le gain de temps sera infime en l'occurence Dim BlockSize%, k%, i%, j%, n%, BlockEnd% Dim DeltaAngle#, DeltaAr# Dim Alpha#, Beta#, AR#, TR#, TI#, AI# 'Dim rDebTpsTFR! 'If bChronometrer Then rDebTpsTFR = VB.Timer() Dim dtDebTpsTFR As DateTime If bChronometrer Then dtDebTpsTFR = Now For i = 0 To m_var.iNbFreqTFR - 1 m_rImagOut(i) = 0 j = m_iReversedBits(i) 'I saved time here by pre-calculating all these values m_rRealOut(j) = RealIn(iNumCanal, i) ' Patrice : Bug corrigé : tous les j ne sont pas obtenus, m_rImagOut n'est ' pas bien initialisé. J'ai ajouté m_rImagOut(i) = 0 2 lignes plus haut 'm_rImagOut(j) = 0 'Since this array is static, gotta make sure it's clear Next i BlockEnd = 1 BlockSize = 2 ' These don't change in this program, so I made them constants ' so they're as fast as can be. Const m_rAngleNumerator# = 2 * Math.PI Do While BlockSize <= m_var.iNbFreqTFR DeltaAngle = m_rAngleNumerator / BlockSize Alpha = Math.Sin(0.5# * DeltaAngle) Alpha = 2.0# * Alpha * Alpha Beta = Math.Sin(DeltaAngle) i = 0 Do While i < m_var.iNbFreqTFR AR = 1.0# AI = 0.0# j = i For n = 0 To BlockEnd - 1 k = j + BlockEnd TR = AR * m_rRealOut(k) - AI * m_rImagOut(k) TI = AI * m_rRealOut(k) + AR * m_rImagOut(k) m_rRealOut(k) = m_rRealOut(j) - TR m_rImagOut(k) = m_rImagOut(j) - TI m_rRealOut(j) = m_rRealOut(j) + TR m_rImagOut(j) = m_rImagOut(j) + TI DeltaAr = Alpha * AR + Beta * AI AI = AI - (Alpha * AI - Beta * AR) AR = AR - DeltaAr j = j + 1 Next i = i + BlockSize Loop BlockEnd = BlockSize BlockSize = BlockSize * 2 Loop 'If bChronometrer Then rTpsTFR += VB.Timer() - rDebTpsTFR If bChronometrer Then tsTpsTFR = tsTpsTFR.Add(Now.Subtract(dtDebTpsTFR)) For i = 0 To m_var.iNbFreqSpectre - 1 Select Case TypeSpectre Case TCalculSpectre.ReelAbs m_rRealOut(i) = Math.Abs(m_rRealOut(i)) ' Vue du module spectral au lieu de la seule partie réele Case TCalculSpectre.Carre ' L'énergie est proportionnelle au carré de l'amplitude ' de l'onde acoustique. m_rRealOut(i) = _ m_rRealOut(i) * m_rRealOut(i) + m_rImagOut(i) * m_rImagOut(i) Case TCalculSpectre.Normal m_rRealOut(i) = Math.Sqrt( _ m_rRealOut(i) * m_rRealOut(i) + m_rImagOut(i) * m_rImagOut(i)) End Select Next i End Sub Private Sub FFTDoReverse() ' I pre-calculate all these values. It's a lot faster to just read them from an ' array than it is to calculate 1024 of them every time FFTAudio() gets called. Dim i% Dim iDeb% = LBound(m_iReversedBits) Dim iFin% = UBound(m_iReversedBits) For i = iDeb To iFin m_iReversedBits(i) = iReverseBits(i, m_prm.iNbBitsTFR) Next i End Sub Private Function iReverseBits%(ByVal Index%, ByVal iNbBitsTFR%) Dim i%, Rev% For i = 0 To iNbBitsTFR - 1 Rev = (Rev * 2) Or (Index And 1) Index \= 2 Next i iReverseBits = Rev End Function End Class modVBWaveComp.vb ' Fichier modVBWaveComp.vb ' ------------------------ Public Module modVBWaveComp Public Const sTitreMsg$ = "VBWaveComp.Net" ' Avec VBExpress 2005, pour choisir le mode debug ou pas, il faut ' sélectionner le menu Build : Configuration Manager... Debug ou Release ' ... mais pour voir ce menu, il faut le demander !!! ' menu Tools : Options... : Projets and Solutions : "Show Advanced Build Configuration" ' inutile donc de définir la constante DEBUG directement : '#Const DEBUG = True '#Const DEBUG = False #If DEBUG Then Public Const bDebug As Boolean = True Public Const bRelease As Boolean = False Public Const bTrapErr As Boolean = False #Else Public Const bDebug As Boolean = False Public Const bRelease As Boolean = True Public Const bTrapErr As Boolean = True #End If ' Nb spectres max. (si > 0, sinon désactivé) Public Const iNbSpectreMax% = 0 Public Const sFormatCourt$ = "0.00" Public Const sFormatPCPositif$ = "000.00%" Public Const sFormatdBPositif$ = "000.00 dB" Public Const sFormatPC$ = "-000.00%" ' Prévoir un espace si c'est positif Public Const sFormatdB$ = "-000.00 dB" Public Const sFormatSec$ = "00.000 sec." Public Const sFormatFreq$ = "0.00 Hz" ' Types de pondération des moyennes des plages de fréquences Public Enum TPonderation Aucune HautesFrequences Energie End Enum Public Const iSp1% = 0 ' Spectre n°1 Public Const iSp2% = 1 ' Spectre n°2 Public Const iSpNul% = -1 ' Spectre nul Public Const iNbSpectres% = 2 ' 2 signaux comparés l'un à l'autre Public Const iNbCanaux% = 2 ' G, D Public Const iNbCanauxSpectre% = 3 ' G, D, G+D Public Const iCanalG% = 0 ' Canal de Gauche Public Const iCanalD% = 1 ' Canal de Droite Public Const iCanalGD% = 2 ' Canal Gauche+Droite ' Ordre du tableau de tracé Public Const iLog% = 0 Public Const iLogdB% = 1 Public Const iGD% = 0 ' G+D réunis Public Const i1C% = 1 ' 1 seul canal G ou D ' Types de spectre calculés Public Enum TCalculSpectre ReelAbs ' Abs(Reel) Carre ' Reel2+Img2 Normal ' Sqr(Reel2+Img2) Log ' Log(Sqr(Reel2+Img2)) : Log et LogdB End Enum 'Private Declare Function WritePrivateProfileString% Lib "kernel32" _ 'Alias "WritePrivateProfileStringA"(ByVal lpApplicationName$, _ 'ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName$) Private Declare Function GetPrivateProfileString% Lib "kernel32" _ Alias "GetPrivateProfileStringA" (ByVal lpApplicationName$, _ ByVal lpKeyName$, ByVal lpDefault$, ByVal lpReturnedString$, _ ByVal nSize%, ByVal lpFileName$) Public Declare Function Beep% Lib "kernel32" ( _ ByVal dwFreq%, ByVal dwDuration%) ' Type pour tracer le spectre : G et D Public Structure TTraceSpectre Dim rMinSpectre#, rMaxSpectre#, rAmplitudeTrace# End Structure ' Structure du spectre Public Structure TSpectre Dim sFichierAudio$, sCheminFichierAudio$ Dim rDureeSignalSec! Dim iNbEchSignal% 'Dim rTpsTFR! ' Temps de calcul de la TFR en secondes 'Dim rTpsGlobal! ' Temps de calcul global du spectre en secondes Dim dtDeb As DateTime Dim tsTpsTFR As TimeSpan ' Temps de calcul de la TFR en secondes Dim tsTpsGlobal As TimeSpan ' Temps de calcul global du spectre en secondes Dim iNbSpectresG%, iNbSpectresD% Dim rModuleSpectraleG#, rModuleSpectraleD# Dim bStereo As Boolean Dim iFreqBase% ' Fréquence de base du signal en Hz Dim b16Bits As Boolean Dim iNumSpectre% ' Numéro du spectre Dim traceLog As TTraceSpectre Dim traceLogG As TTraceSpectre Dim traceLogD As TTraceSpectre Dim traceLogDB As TTraceSpectre Dim traceLogDBG As TTraceSpectre Dim traceLogDBD As TTraceSpectre End Structure ' Structure pour stocker un calcul d'énergie ' sur les plages de fréquences Public Structure TMesureEnergieSpectre Dim rSommeSpectre# Dim rEnergieLocale# Dim rSommeCoefEnergLoc# Dim rSommeCoefEnergLocNorm# Dim rMaxCoefEnergLoc# Dim rEnergieLocaleNorm# End Structure ' Structure pour stocker tous les calculs sur un spectre Public Structure TMesureSpectre Dim mesLogFin As TMesureEnergieSpectre ' Résultat final Dim mesLog() As TMesureEnergieSpectre ' Energie Log Dim mesLogDB() As TMesureEnergieSpectre ' Energie Log dB Dim mesD() As TMesureEnergieSpectre ' Mesure directe sans Log ni dB Dim rRapportGD# Dim rModuleSpectraleFinal# End Structure ' Structure pour stocker un calcul de comparaison d'énergie ' sur les plages de fréquences Public Structure TMesureComp Dim rDiffSpectre# ' Différence de spectre Dim rDiffSpectreNorm# ' Différence de spectre normalisé (tjrs < 100%) Dim rMoyDiffSpectre# ' Moyenne des différences de spectre Dim rMoyDiffSpectrePond# ' Moyenne pondérée Dim rCoefAssoc# ' Coef. de pondération des moyennes Dim rSommeCoefAssoc# Dim rMaxCoefAssoc# Dim rSommeDiffSpectre# Dim rSommeDiffSpectrePond# End Structure ' Structure pour stocker les calculs de comparaison d'énergie ' sur les plages de fréquences Public Structure TMesuresComp Dim mesCompFin As TMesureComp Dim mesComp() As TMesureComp Dim mesCompDB() As TMesureComp Dim mesCompD() As TMesureComp End Structure Public Sub AfficherMsgErreur(ByRef Erreur As Microsoft.VisualBasic.ErrObject, _ Optional ByVal sTitreFct$ = "", Optional ByVal sInfo$ = "", _ Optional ByVal sDetailMsgErr$ = "") If Not Cursor.Current.Equals(Cursors.Default) Then _ Cursor.Current = Cursors.Default Dim sMsg$ = "" If sTitreFct <> "" Then sMsg = "Fonction : " & sTitreFct If sInfo <> "" Then sMsg &= vbCrLf & sInfo If Erreur.Number > 0 Then sMsg &= vbCrLf & "Err n°" & Erreur.Number.ToString & " :" sMsg &= vbCrLf & Erreur.Description End If If sDetailMsgErr <> "" Then sMsg &= vbCrLf & sDetailMsgErr MsgBox(sMsg, MsgBoxStyle.Critical, sTitreMsg) End Sub Public Function sFormater$(ByVal rValeur#, ByVal sFormat$) ' Pour les formats avec valeures négatives possibles : If sFormat.Substring(0, 1) = "-" Then sFormat = sFormat.Substring(1) ' Ajouter un espace si la valeur formatée n'est pas négative ' Recherche du format numérique seul Dim sFormatNum$ = sFormat Dim iPos% = InStr(sFormat, "%") If iPos > 0 Then sFormatNum = sFormat.Substring(0, iPos - 1) iPos = InStr(sFormat, "dB") If iPos > 0 Then sFormatNum = sFormat.Substring(0, iPos - 1) If Val(Format(rValeur, sFormatNum)) >= 0 Then sFormat = " " & sFormat End If End If sFormater = Format(rValeur, sFormat) End Function Public Function bLireFichierIni(ByVal sCle$, ByVal sSection$, _ ByVal sFichier$, ByRef rValeur!, ByVal rDefaut!, _ Optional ByVal bNumerique As Boolean = True, _ Optional ByVal bBooleen As Boolean = False, _ Optional ByVal bPromptErr As Boolean = False) As Boolean ' Lire la valeur d'un paramètre dans un fichier ini If bTrapErr Then On Error GoTo Err_bLireRubrique Dim sContenu$ = New String(Chr(0), 255) Dim iRet% = GetPrivateProfileString(sSection, sCle, "", _ sContenu, Len(sContenu), sFichier) If iRet > 0 Then Dim sValeur$ = sContenu.Substring(0, iRet) ' = Left(sContenu, iRet) If bNumerique Or bBooleen Then rValeur = CSng(Val(sValeur)) If bBooleen And rValeur <> 0 Then rValeur = CSng(True) Else rValeur = rDefaut End If If bPromptErr And iRet <= 0 Then GoTo Err_bLireRubrique bLireFichierIni = True Exit Function Err_bLireRubrique: Dim sMsg$ sMsg = "Fonction: bLireFichierIni" & vbCrLf sMsg = sMsg & "Impossible de lire la rubrique [" & sCle & "]" sMsg = sMsg & vbCrLf & "dans la section [" & sSection & "]" sMsg = sMsg & vbCrLf & "dans le fichier [" & sFichier & "]" sMsg = sMsg & vbCrLf & "Défaut : [" & rDefaut & "]" AfficherMsgErreur(Err, sMsg) rValeur = rDefaut Exit Function End Function Public Function bChoisirFichier(ByRef sCheminFichier$, ByVal sFiltre$, ByVal sExtDef$, _ ByVal sTitre$, Optional ByVal sInitDir$ = "") As Boolean 'bChoisirUnFichierAPI(ByRef sFichier$, ByRef sFiltre$, ByRef sTitre$, ByRef sInitDir$, ByRef lHandelWnd As Integer) As Boolean ' Afficher une boite de dialogue pour choisir un fichier .mdb Static bInit As Boolean = False Dim ofd As New OpenFileDialog With ofd If Not bInit Then bInit = True If sInitDir = "" Then .InitialDirectory = Application.StartupPath '& "\" & sDossierDonnees Else .InitialDirectory = sInitDir End If End If .CheckFileExists = True .DefaultExt = sExtDef .Filter = sFiltre .Multiselect = False .Title = sTitre .ShowDialog() If .FileName <> "" Then bChoisirFichier = True : sCheminFichier = .FileName End With End Function End Module