PC MULTIMEDIA-BASED LEAK DETECTION SYSTEM FOR WATER TRANSMISSION AND DISTRIBUTION PIPES

Abstract: This invention pertains to the detection of leaks in plastic water distribution pipes by processing the sound or vibration induced in the pipe by water escaping under pressure. Acoustic leak signals are measured at two (or more) contact points with the pipe, e.g., fire hydrants or valves, using vibration sensors or hydrophones. The signals are digitally recorded using the computer's soundcard. The leak is located using the difference in arrival times of two leak signals as determined from the cross-correlation function traditionally used in leak detection applications or an enhanced impulse response function. The enhanced impulse response function eliminates the need to filter leak signals before processing and hence avoids the uncertainty involved in selecting filter cutoff frequencies for non-experts. Listening to leak sound in plastic pipes is made possible in software by shifting their low-frequency content to an audible higher range. The software implementation of this system can be readily integrated with commercially available RF-based data transmitters and leak sensors - thus providing a complete, fexible, and inexpensive leak detection system.

Description: PC MULTIMEDIA-BASED LEAK DETECTION SYSTEM FORVATER TRANSMISSION AND DISTRIBUTION PIPES Field of the Invention The present invention relates to leak detection and more particularly to a method and system for locating leaks in municipal water distribution pipes. Background of the Invention In most municipal water distribution systems a significant percentage of water is lost while in transit from treatment plants to users. According to an inquiry made in 1991 by the International Water Supply Association (IWSA), the amount of lost water is typically in the range of 20 to 30% of production. In the case of some systems, mostly older ones, the percentage of lost water could be as high as 50% or even more. Lost water is usually attributed to several causes including leakage, metering errors, and theft - according to the IWSA survey, leakage is the major cause. Water leakage is a costly problem - not only in terms of wasting a precious natural resource but also in economic terms. The primary economic loss due to leakage is the cost of raw water, its treatment, and transportation. Leakage inevitably also results in secondary economic loss in the form of damage to the pipe network itself, e.g., erosion of pipe bedding and major pipe breaks, and in the form of damage to foundations of roads and buildings. Besides the environmental and economic losses caused by leakage, leaky pipes create a public health risk as every leak is a potential entry point for contaminants if a pressure drop occurs in the system. Economic pressure, concern over public health risk and simply the need to conserve water motivate water system operators to implement leak detection surveys. Leaks may in some cases be detected visually by spotting leaking water on the ground surface. In most cases, however, leaks never surface and normally acoustic methods are used to locate leaks by utilizing the sound or vibration induced by water as it escapes from pipes under pressure. Locating leaks using acoustic equipment normally consist of two phases. In the first phase, an initial survey is conducted by listening for leak sounds using for example listening rods or aquaphones on all accessible contact points with the distribution system such as fire hydrants, valves, etc. Suspect leak locations found in this phase are noted for more accurate determination (pinpointing) in the second phase. Leaks are pinpointed by using geophones or ground microphones to listen for leak sounds on the ground directly above the pipe at very close intervals, e.g., every 1 m (3.3 ft); or by using leak noise correlation devices known as leak correlators. Listening devices utilize sensitive mechanisms or materials, e.g., piezoelectric elements, for sensing leak-induced sound and vibration. They could be either of the mechanical or electronic type. Modern electronic devices may include signal amplifiers and noise filters, which could be very helpful in adverse environments. The use of listening devices is usually straightforward but their effectiveness depends on the experience of the user. Locating leaks in water distribution pipes is a classical application of the cross-correlation method described in the book "Engineering applications of Correlation and Spectral Analysis" written by J.S. Bendat and A.G. Piersol, and published by John Wylie and Sons, New York, 1980. The method has been applied in U.S. Patents No. 4,083,229 and 5,205,173. In U.S. Patent No. 5,974,862 several enhancements of the cross-correlation method were applied to improve the method's accuracy for detecting leaks. The enhancements included achieving higher signal-to-noise ratio by transmitting leak signals using a digital wireless system wherein signals are digitized at the sensor, achieving a higher dynamic range of the measurement system by applying variable-gain to leak signals to utilize the full range of analog-to-digital converters, and introducing an incremental approach in the calculation of the cross-correlation function. The cross-correlation method works by measuring vibration or sound in the pipe at two points that bracket the location of a suspected leak. Vibration sensors (normally accelerometers) are attached to fire hydrants or any other contact points with water pipes as shown schematically in Fig. 1. Alternatively, hydrophones (or underwater microphones) can be used. These are inserted into fire hydrants using modified hydrant caps. Vibration or sound signals are transmitted from the sensors to the correlator wirelessly or using wires. The cross-correlation is calculated for the measured leak signals directly in the time domain or indirectly in the frequency domain. For leak signals/i (t) and / 2 (t) in digital form, the estimate of the cross-correlation function (C 12 ) is calculated in the time domain using the following sum expression: N -i , , . C 12 QΔt) = _ y fk fk +ι N- -i , ^ J \ J 2 k = 1 where i = 1 , 2, ..., M, Δf is the sampling interval, /* and /* are the / " 7 samples of signals 1 and 2, respectively, and N is the total number of digital samples. In the above expression, fewer and fewer terms will be included with increasing / ' . It is therefore necessary to limit M to a small fraction of N, say VΛ. In the frequency domain, the estimate of the cross-correlation function (C ) is obtained via the inverse Fourier transform of the cross-spectral function as C 1 c 2 (r) = (ω) e jωτ dω ] where j = V-1 , and E xz is estimate of the cross-spectral density function defined as E 12 (ω) = F * (ω) F 2 (ω) F, and F 2 are the spectral density functions of signals (t) and h (t), respectively. F * is the complex conjugate of F v The spectral density function of a signal f (t) is obtained via the Fourier Transform as F(ω) = f (t) e- J ""dt For signals in digital form, the integrals in the above equations are evaluated by using equivalent summation expressions. The cross-correlation function obtained in the frequency domain is circular, as indicated by the superscript c. This is due to the implicit periodicity of the time signals in the Fourier transform of finite signals. Time delays corresponding to peaks of circular correlation functions might be distorted. The circular effect is easily eliminated by padding time signals with a zero-amplitude segment of length T. The estimate of the cross-spectral density function used in the above equations is usually obtained by averaging the results of calculations performed for several records or measurements of time signals as where k designates signal or record number and N r is the total number of measurements. Averaging reduces the effect of incoherent random noise on the accuracy of the cross-correlation function. A measure of the relationship of the response at the two measurement points for a particular frequency components is provided by the coherence function defined as where E u and E 22 are estimates of the auto-spectra of measurements at locations 1 and 2, respectively. The value of ranges from 0 to 1 - a value of 1 indicates that signals at location 1 and 2 are caused by the same source(s) and value of 0 indicates that the signals at the two locations are unrelated. Values between 0 and 1 indicate the presence of related and unrelated components. If a leak exists between the two measurement points, the cross- correlation function will have a distinct peak and the corresponding time shift (τ max ) will correspond to the difference in arrival times between measured leak signals. In reference to Fig. 1 , the time delay between measured "teak signals is related to the location of the leak relative to measurement points by Lt-L ΪØ max _ where -i and 2 are the positions of the leak relative to sensors 1 and 2, respectively, and c is the propagation velocity of the leak sound in the water pipe. For leaks located at mid-point between the sensors, the time delay is zero. By substituting 2 = D - Li in the above equation, the position of the leak relative to point 1 is found as where D is the distance between the sensors - usually measured on site or read off system maps. The propagation velocity c depends on the type and size of pipe. Velocity values could be obtained from pipe manufacturers or they could be calculated using the following equation: where c Q is the propagation velocity of sound in an infinite body of water equal to K P , K w is the bulk modulus of elasticity of water, p is density of water, E p is the modulus of elasticity of the pipe material, D is internal diameter of the pipe, e is the thickness of the pipe wall, and a is constant that depends on the constraints of longitudinal movement of the pipe (a equals 1 for pipes having expansion joints, which is normally the case for water distribution pipes). Preferably, for more accuracy, the propagation velocity should be measured on- site using a known in-bracket or out-of-bracket simulated leak source. In most cases, leak signals must be filtered to remove high-amplitude narrow-band noise, e.g., resonance response of the pipe and electrical noise caused by ground loops at the power mains frequency. Otherwise, the cross- correlation function of leak signals will be dominated by the frequencies in the narrow-band resonance response or noise and in turn obscures or distorts the peak corresponding to the leak position. Alternatively, the time difference between leak signals can be determined using the impulse response function also described in the book "Engineering applications of Correlation and Spectral Analysis" written by J.S. Bendat and A.G. Piersol, and published by John Wylie and Sons, New York, 1980. The impulse response function was applied in U.S. Patent No. 5,038,614 for calculating the time shift between leak signals in wellbore conduits and pipes. The impulse response function is defined as the inverse Fourier transform of the frequency response function (i.e., transfer function between output and input), that is, iclύt ϊ\ 2 (τ) = Re[- f H 12 (ω) e jωτ dω ] IT J where the transfer function H 12 (ώ) is given as E H x2 (ω) 12 E Previous implementations of the cross-correlation and impulse response methods for detecting leaks in municipal water distribution pipes as well as traditional listening devices suffer from several disadvantages. These include the following: The cross-correlation method does not perform well for leak signals that have concentration of power in a narrow frequency band. For such signals, commonly found in plastic pipes, peaks corresponding to a leak and those caused by out-of-bracket sources become distorted or difficult to distinguish due to the "spreading effect" of the peaks. The narrower the frequency band the more spread are the peaks and in the limit the cross-correlation function becomes a harmonic one for infinitely narrow-band signals. For narrow band signals, the impulse response function might provide improved resolution of cross-correlation peaks due to its "computational whitening" effect of leak signals. Although the impulse response method might provide improved resolution for signals having power concentration in one or more frequency bands, the spectrum of the signals must extend over a wide range. In other words, the impulse response function does not provide improved performance for "truly" narrow band signals in which the data outside the main frequency band is extremely small and / or is dominated by noise. Leak signals in plastic pipes are truly narrow band signals. In plastic pipes also, leak signals are attenuated over distance at a much higher rate that in other types of pipe. In view of the fact that the leak is usually positioned asymmetrically between measurement points, measured leak signals will have significantly different power levels. Therefore if the higher level signal is used as the reference one in the impulse response calculation, the whitening effect of this method will not be effective and the transfer function will be dominated very narrow band peaks, e.g., resonance response of the pipe. Previous implementations of leak detection systems require specially designed and integrated hardware. Therefore, they are expensive, inflexible, and difficult to modify. Existing listening devices are not effective for leaks in plastic pipes unless they are used very closed to leaks. The power of leak signals in plastic pipes is concentrated in a narrow low-frequency range (< 50 Hz). The human hearing is not sensitive enough to sound at frequencies in this range. Pre-filtering of leak signals using digital filters to remove interfering noise is time consuming. This is especially the case when leak signals have to be analyzed several times to find an optimum cross-correlation result or when very long leak signals have to be used to improve signal-to-noise ratio for low level leak signals. In order to overcome some of the above noted shortcomings of the prior art it is an object of the invention to provide an improved method of leak detection. Summary of the Invention In accordance with the invention there is provided a method of detecting leaks in pipes, in particular plastic pipes and other non-metallic pipes, comprising the steps of: measuring of leak-induced sound or vibration in a water pipe from a first location and from a second location simultaneously to provide first and second signals respectively, the first and second location separated by a known distance of pipe; and, calculating an enhanced impulse response function or a post-filtered cross-correlation function based on the first and second signals to determine a leak location within the pipe, the leak location a distance from the first location. In accordance with the invention also there is provided a method for digitally shifting the frequency content of leak-induced sound. In accordance with the invention acquisition and processing of and listening to leak signals are carried out via multimedia-equipped personal computers. The present invention offers the following advantages: The enhanced impulse response method eliminates the need for pre-or post-filtering of interfering noises and hence eliminates the uncertainty and difficulties encountered by non-experts in selecting filter settings especially for low-frequency narrow band signals such as those prevalent in plastic and other non-metallic pipes. Post-filtering of the cross-correlation function using digital filters is considerably more efficient than the prior practice of pre-filtering leak signals. Digitally shifting the frequency content of leak-induced sound makes it possible to hear low-frequency leak-induced sound prevalent in plastic and other non-metallic pipes by shifting their frequency content to a range audible to a typical human ear. Utilising multimedia-equipped personal computers to record, process and playback leak signals provides proved suitable for low-level signals and in turn eliminated the need for specialised and costly data acquisition and processing hardware. Brief Description of the Drawings The invention will now be described with reference to the drawings in which: Fig. 1 is a schematic illustration of the field setup for locating a suspected leak by using the cross-correlation or impulse response methods; Fig. 2 is a simplified diagram of a PC having a sound card coupled to a set of speakers and to a sensor; Fig. 3 is a simplified block diagram of an exemplary system according to the invention comprising three main modules: (i) a data acquisition module, (ii) a signal conditioning module including digital filters, and (iii) a spectral analysis module; Fig. 4 is a simplified data flow diagram of the data acquisition module; Figs. 5a-c illustrate a graphical demonstration of the effect of filtering method on the cross-correlation function (test07.t03, npoint = 1024, nzero = 512, HP = 15 Hz, LP = 100 Hz); Figs. 6a-f illustrate a graphical demonstration of the effect of upper integration limit on the impulse response function (test04.t08, channels reversed, npoint = 4096, nzero = 2048); Figs. 7a-f show a graphical demonstration of the effect of reference channel on the impulse response function (test16.t03, npoint = 4096, nzero = 2048, upper integration limit = 50 Hz); Figs. 8a-b provide a comparison of results for leak signals in 6" PVC pipe acquired and analysed using LeakFinder and TurboLab PC-based systems (actual leak position is 73.5 m from sensor 1 or A); Figs. 8c-d provide a comparison of results for leak signals in 8" ductile iron pipe acquired and analysed using LeakFinder and TurboLab PC-based systems (actual leak position is 40 m from sensor 1 or A); Fig. 9 is an exemplary main graphical user interface (default); Fig. 10 is an exemplary graphical display of spectral analysis results; and, Fig. 1 1 is an exemplary graphical display of the time history of recorded leak signals. Detailed Description of the Invention According to the invention, an enhanced impulse response function or a post-filtered cross-correlation function is used to determine a distance from a known location to a leak along a pipe conducting fluid under pressure. The use of an the enhanced impulse response allows for captured signals to be processed absent filtering which is highly advantageous because filtering of signals relating to leaks in a pipe, especially those having narrow band frequency spectra, is often difficult and filtering errors lead to incorrectly located leaks. Reducing the number of potential sources of errors is advantageous. Further, the use of an impulse response is well suited to locating leaks in plastic pipes. Post-filtering of the cross-correlation function, to remove interfering noise, is more efficient than pre-filtering of leak signals, more so when cross-correlation is calculated in the frequency domain. Another inventive feature of the present embodiment of the invention is that sound signals can be captured and replayed at a different frequency to allow a human user to hear leaks in, for example, plastic pipes wherein the sound signal relating to such a leak is at a frequency that is inaudible. Turning now to an embodiment of the present invention and referring to Fig. 2, a PC 1 is shown having a sound card 3 coupled to a set of speakers 5 and to a microphone 7 in the form of a leak sensor. The leak sensor 7 is similar to those typically used in the field of leak detection. Optionally, when a portable computer is used, headphones (not shown) are used in place of the speakers in order to facilitate use of the unit. The present invention is implementable in part as a PC-based software application to locate leaks in water distribution pipes using an enhanced impulse response technique. An exemplary embodiment of the invention is implemented and titled LeakFinder. This software represents a new radical concept that taps into the capabilities of multimedia components of modern PCs, mainly their soundcards, to record and playback leak signals. It also utilises a high-speed CPU of presently available PCs to perform computationally-intensive calculations of impulse response and cross-correlation functions. Nowadays, PCs incorporate extremely fast CPUs as well as soundcards having analogue-to-digital resolution of at least 16-bits - surpassing that of commonly used data acquisition systems in many research labs. Utilising multimedia components in leak detection in water pipes and other scientific applications has been traditionally overlooked because of concerns over further noise introduce by these components as well as by the systems in which they are installed. However, the nature of this noise proved to be inconsequential in this implementation for the acquisition and processing of leak signals. LeakFinder, as implemented, is a windows-based application that runs under either Windows NT or Windows 98. Of course, the application could be implemented to operate with any operating system as dictated by design requirements. The present application has user-friendly menus and data displays, but this need not be so. The LeakFinder software is readily integrated with commercially available digital or analogue wireless RF-based data transmitters and leak sensors such as hydrophones and accelerometers - thus providing a complete leak locating system. The LeakFinder leak detection system overcomes many limitations of existing "black-box" commercial leak noise correlators. Its features include very low-frequency response, a wide-range of spectral estimates, storage of raw data for off-site analysis, finely-tunable digital filters for noise suppression and so forth. Advantageously, it is inexpensive relative to a typical leak detection system which on average costs about $50,000. This renders the system affordable for use in underdeveloped countries where water leak rates are as high as 70% of production. Referring to Fig. 3, the system comprises three main modules: (i) a data acquisition module, (ii) a signal conditioning module including digital filters, and (iii) a spectral analysis module. These modules as well as processing and analysis parameters, program output, and verification examples are presented below. A listing of pertinent sections of the system's computer software code is included in appendix A. Data Acquisition Module Referring to Fig. 4, a block diagram and data flow diagram of the data acquisition module is shown. In the data acquisition module, leak signals are recorded using the soundcard of the PC at any of the card's sampling frequencies, normally between 11 ,025 and 44,000 Hz. Recorded leak signals can be stored in either standard .wav or .ascii formats. Typical user-specified data acquisition parameters include the following: data recording mode, e.g., stereo or mono, resolution, sampling frequency, duration, and volume controls for recording and playback. The soundcard are set to stereo mode (i.e., dual-channel input) when the system is used for locating leaks using a cross-correlation method, and to mono mode when measuring leak sounds at one point only such as in listening surveys. Of course, when listening devices are used remotely and sound recordings are time stamped, it is possible to use the method of the present invention with two separate audio data files. Normally, leak signals are recorded using 16-bit resolution and the lowest possible sampling rate of the soundcard (e.g., 11 ,025 Hz). In most cases, it is sufficient to record leak signals for a duration between 30 to 60 seconds. Of course, the selection of duration and sampling rate is straightforward to those of skilled in the art. Optionally, it is automated in software. In record mode, the volume control is preferably adjusted to utilise as much as possible of the soundcard's voltage range, without overloading it, in order to achieve a high signal-to-noise ratio. Of course, this may also be automated. The volume control of the record mode is easily set in software to an appropriate level while checking the level of leak signals using, for example, a preview function. The preview function records and displays leak signals without saving them to disk. Once the recording volume control level is selected, the signals are recorded and saved to disk using the record function. The complete time history of saved signals is optionally stored, displayed and/or printed using Leak Finder's display function. Signal Conditioning Module In LeakFinder, the frequency range of recorded leak signals can be optionally limited in order to suppress interfering noise components by applying low and high-pass digital filters at user-specified cut-off frequencies. In accordance with this invention, one may opt to post-filter when the cross- correlation function is used for locating a leak instead of pre-filtering of the leak signals themselves. The effect of filtering method is demonstrated in Fig. 4. The filters are of the recursive 4th order Butterworth type. The square of the absolute value of the transfer function has the following forms for low and highpass filters of this kind, respectively. |H (/)| 2 = l /(l + (tan πfAt I tan πBXt) 2M ) and |H(/)| 2 = l/(l + (cot Δt /tan^δΔt) 2Λ ) where/ is frequency, B is filter cutoff frequency (or 3 dB point), Δt is sampling interval, and M is number of poles or order of the filter (set to 4 in the present embodiment of LeakFinder). Filtering is applied in both the forward and reverse directions of leak signals to eliminate time delays caused by the response of filters. Of course, when impulse response is used, filtering need not be performed. A unique feature of LeakFinder is that the speed at which leak signals are played back is alterable. For example the speed is increased or decreased arbitrarily by simply overriding the sampling frequenting at which leak signals were digitally recorded with a higher or lower sampling frequency. This is very useful when playing back leak signals detected within plastic pipes or other non- metallic pipes, which only have very low-frequency components, e.g., in the infra- sound range, and thus cannot be heard by an unaided human ear. Speeding up the playback of low-frequency signals shifts their frequency content to a higher range at which the sensitivity of human hearing is sufficient to detect the leak sound. Thus, the present system overcomes a shortcoming in the prior art that leaks in plastic pipes could not be previewed using listening devices since they typically are inaudible. Spectral Analysis Module In the spectral analysis module, a position of the leak source is calculated using the time shift corresponding to the maximum of an enhanced impulse- response function or post-filtered cross-correlation function. The functions are calculated in the frequency domain as described in the section titled "Review of Prior state-of-the-art". Although the impulse response function might provide improved resolution for signals having power concentration in one or more frequency bands, the spectrum of the signals must extend over a wide range. For "truly" narrow band signals in which the data outside the main frequency band is extremely small and / or is dominated by noise, which is the case for plastic pipes, the impulse response method does not provide improved performance over the cross-correlation function. In accordance with this invention in order to improve the performance of the impulse response function for low-frequency truly narrow band leak signals, the upper integration limit of the inverse Fourier transform used in calculating the impulse response function normally taken as the Nyquist frequency is replaced by the frequency beyond which power of leak signals or the value of the transfer function between them is small. For example, for 6 and 8-inch plastic pipes and typically used sensor-to-sensor spacing of 300 to 500 feet, this upper limit could be between 25 to 50 Hz. Auto-spectra of leak signals, transfer function, coherence function, and impulse response functions calculated with upper integration limit equal to Nyquist frequency and 20 Hz are shown in Figs. 5a-c for a simulated service connection leak in an 8-inch plastic PVC pipe. The impulse response function may not provide improved performance over the cross-correlation function when leak signals are excessively damped or attenuated over distance such as occurs in plastic pipes and other non-metallic types of pipe. For such situations, measured leak signals will have significantly different power levels and therefore if the higher level signal is used as the reference signal in the impulse response calculation, the whitening effect of this method is not achieved and the transfer function is dominated by very narrow band peaks, e.g., resonance response of the pipe. In accordance with this invention in order to avoid this drawback, the low level signal is always used as the reference signal. The effect of the reference channel on the impulse response function is demonstrated in Figs. 6a-f for a joint leak in a 6-inch plastic PVC pipe. LeakFinder performs spectral analysis on filtered or unfiltered leak sound signals and produces the following spectral estimates: (i) auto-spectra of the signals, (ii) coherence function, (iii) cross-correlation function, and (iv) impulse response function. The auto-spectra provide information about the frequency content of leak signals. The coherence function provides a measure of the relationship between recorded leak signals - i.e., whether they were induced by the same source or not. The closer the coherence function to 1 , the more related the signals. The cross-correlation and impulse response functions provide information about a time lag between leak signals which in turn is used to calculate a leak location. The impulse response function, unlike the cross- correlation function, eliminates a need to filter leak signals to remove interfering low-frequency pipe resonance. Consequently, it avoids the uncertainty involved in selecting filter cut-off frequencies. A user need only specify a frequency above which the amplitude of the auto-spectra of the leak signals or the transfer function between them becomes insignificant. Of course, this task is optionally automated based on material type or other detectable qualities of the sound signal. Processing and Analysis Parameters Optionally, user-specified parameters and options are provided for digital filtering and spectral analysis of leak signals including the following: filter ON/OFF switch, cut-off frequency of low and high-pass filters, number of points in the Fast Fourier Transform (FFT), number of zero-points, propagation velocity of leak signals in the water pipe, sensor-to-sensor spacing, and finally modified sampling frequency of leak signals. Typical values for FFT size and number of zero-points are 1024 and 512 points, respectively corresponding to a rectangular force- window with 50% overlap. Sensor-to-sensor spacing could be determined from system maps but preferably should be measured on-site. The propagation velocity depends on the type, material and size of pipe. Typical velocities were not programmed in the software but appropriate values are often found in tables used by those of skill in the art for several types and sizes of water pipes. Alternatively, they can be calculated using the equation described above. Appropriate cut-off frequencies of low and high-pass filters to be applied when a cross-correlation function is used for locating a leak depend on the type of pipe and sensor-to-sensor spacing and therefore no fixed rules are specified herein. That said, normal experimentation will lead to useful values. Normally, the cut-off frequencies are selected so that they correspond to the frequency range where the amplitude of the auto-spectra of leak signals is significant and the coherence function is high. However, this is not always evident, especially for plastic pipes for which the amplitude of leak signals is very small and their frequency content is narrow and occurs in the low-frequency range close to pipe resonance. Recommended high and low-pass cutoff frequencies for typical plastic water distribution pipes, e.g., 6" or 8" PVC pipes, are 10 and 100 Hz, respectively. The high-pass limit may need to be increased or decreased in small increments, e.g., 1 or 2 Hz, until a distinct peak emerges. The option of post- filtering the cross-correlation function embodied in this invention is much more efficient in this case than pre-filtering of leak signals and recalculating the cross- correlation function. For metal pipes, leak signals contain much higher frequency components than plastic pipes and consequently a high frequency range is preferably used for determining the distance to the leak, e.g., 200 to 800 Hz. Leak signals in water distribution pipes rarely contain frequency components above 1000 Hz in the case of metal pipes and above 200 Hz in the case of plastic ones. Therefore, in order to speed up digital filtering and spectral analysis of the leak signals, the sampling frequency of recorded signals is optionally reduced to selected frequencies, e.g., 500, 1000, 2000, and 5000 Hz depending of course on their frequency content and the required resolution for locating suspected leaks. Output of Analysis The results of spectral analysis are then provided graphically and include a time shift corresponding to a maximum of the impulse response function, the calculated leak position from the measurement point of one of the signals, and signal processing and analysis parameters. The results are optionally transmitted to a printer or exported to a spreadsheet. A function that calculates a leak position corresponding to any time shift of any peak or point in the impulse response or cross-correlation functions is provided that is very useful for measuring the leak signal propagation velocity from peaks corresponding to coherent out-of -bracket sources. Verification of Results LeakFinder was implemented and tested extensively. The results were compared to known results. The results obtained with LeakFinder were compared with those obtained with a PC-based data acquisition system consisting of analogue-to-digital conversion board, power amplification board, anti-aliasing filters, and spectral analysis software (TurboLab version 4.3). The results were in excellent agreement. Example results for leak signals in plastic and metal pipes analysed with both systems are shown in Figs. 8a and 8b. Program code according to the invention is included herein in Appendix A. Numerous other embodiments of the invention may be envisaged without departing from the spirit or scope of the invention. εε U31 L 0 = 3I1I1ΛV011SI Ji I - βμ Λvoqsi = epijMoqsi ()JΘUH1 ~ Z91U!13UJ4 qng SJBAUJ OS qng pug 9 = p3iqEua-z3uιι 3iuj • jI B0 !U3Λ uuoj J9JUΘ3 , z I (1M§! 9 H " HJ§!3H 'U93J0 S) = ^°_L • lH-luozuoq uuoj J3}U33 , z / (inpiΛ - ΨP! ' U33JD S) = 1J 9 ! ζv 000l = |BΛJ3iuι 2 aaιιχ9uιι ()pBOi-uuoj qng ΘJEΛIJJ Ov jaSajuj s v spiJΛ-ioqsi IUIQ jnoqytuJJ , εε suuo^ I3Λ3J s nssj Suj oqs JOJ SuiuiuiBjSojd oiqdεj-? - πv ΛVO MS B l3 u !S nose oj ysΛuoo pue ^OBq Bjd 'pjooaj - S3JΠ§IJUO3{B[ < J uoμiuijsp ΪUBJSUOO iBqojQ - SNOD3010 Suusηij uiBuiop gulp φjoΛusjjng - JJBJJSJJIJ SZ uopεinDiBO xjj - Ut-d XJ soiqdβjS OJΠB puε jssqs oxg oj jjnsaj jnjjno - SΛBjj oxg ssji 3X3- qjiΛ. |ui| o] uEjSoj H3i)S - 3JnS uo3oipnv ssinpojΛj (q (OUOJΛJ) BJBp UlBUlOp 3U11) jo UJJOJ - ouoii3iuι uuj oz (03J3JS) BJBp UlBUlOp 3LUI) JO UIJOj - U33J0S3UIiχiUJJ UOJ1B|3JJOO-SSOJO JO OJUl [lBJ3p JO ιαιo,j - OqSJOJJUUJ SIS JBUB pue >pεq Sui Bjd SuipjOOSJ SuiUUOJJSd SOBJJβJUl UIBUI JO UUOj - p.l033fl3ΛB UijJ SI UOIJBUUOJUI pJBO pUnOS JO UUOJ - sdBQΛSQUIJ UOIJBUUOJUΓ ]B_.3j o LUO j - jnoqvuiJJ SllUOJ (B :s3pnpuι lUBjSojd 3qχ ************************************************************************* 01 6661 9un f 11 SuB/ X3]V Aq p3UIUIBj3θJJ (ot NOiSHaΛ) «aaNwxvai VXiαN3ddV 81 XDd t06ϊ£/ΪO OΛV frmWaveRecord.Show Unload frmAbout tmeTime2.Enabled = False End If End Sub ' frmWaveRecord ********************************************************************** Option Explicit #If Win32 Then Private Declare Function mciExecute Lib "winmm" (ByVal IpstrCommand As String) As Long Private Declare Sub MessageBeep Lib "user32" (ByVal wType As Long) Private Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal IpszSoundName As String, ByVal uFlags As Long) As Long Private Declare Function mciGetErrorString Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal IpstrBuffer As String, ByVal uLength As Long) As Long Private Declare Function mciSendCommand Lib "winmm" Alias "mciSendCommandA" (ByVal wDevicelD As Long, ByVal uMessage As Long, ByVal dwParaml As Long, dwParam2 As Any) As Long Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal IpstrCommand As String, IpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function lstrcpy Lib "kerncl32" Alias "IstrcpyA" (ByVal lpStringl As Any, By Val lpString2 As Any) As Long #Else Private Declare Function mciExecute Lib "MMSystem" (ByVal CommandString As String) As Integer Private Declare Sub MessageBeep Lib "User" (ByVal wAlert As Integer) Private Declare Function sndPlaySound Lib "MMSystem" (ByVal IpSound As String, ByVal flag As Integer) As Integer Private Declare Function mciSendString Lib "MMSystem" (By Val IpstrCommand As String, ByVal IpstrRtnString As Any, ByVal wRtnLength As Integer, ByVal hCallback As Integer) As Long Private Declare Function mciSendCommand Lib "MMSystem" (ByVal wDevicelD As Integer, ByVal wMessage As Integer, ByVal dwParaml As Long, dwParam2 As Any) As Long Private Declare Function lstrcpy Lib "Kernel" (lpl As Any, lp2 As Any) As Long Private Declare Function mciGetErrorString Lib "MMSystem" (ByVal dwError As Long, ByVal IpstrBuffer As String, ByVal wLength As Integer) As Integer #End If Dim CommandString As String Dim ReturnString As String * 255 Dim RetValue As Long Dim uDuration As Integer Dim uBarValue As Integer Dim uAcqirTime As Long Dim uBarStep As Long Dim wDevicelD As Long Dim mciErrorString As String * 256 Dim coffeplaylength As Integer Dim iNumberChannel As Integer Dim acqfreq As Long Dim bPlayButton As Boolean Dim bRecordButton As Boolean Dim bStopButton As Boolean ' for the mixer part Dim h ixer As Long ' mixer handle Dim volCtrl As MIXERCONTROL ' waveout volume control Dim micCtrl As MIXERCONTROL ' microphone volume control Dim re As Long ' return code Dim ok As Boolean ' boolean return code Private Sub cboFFTSize_Change() 'automatic to change the FFT zero point number cboDataPoints.Text = Trim$(Str(cboFFTSize.Text \ 2)) End Sub Private Sub cboFFTSize_Click() cboDataPoints.Text = Trim$(Str(cboFFTSize.Text \ 2)) End Sub Private Sub cboNewSamρling_Change() ' any change in typing that will lead convert SaveFileAscu do again bAsciiFileSaved = False End Sub Private Sub cboNewSampling_DropDown() ' any change in selecting that will lead convert SaveFileAscu do again bAsciiFileSaved = False End Sub Private Sub cmdPause_Click() If Trim$(cmdPause.Caption) <> "&Conti" Then If bPlayButton Then WaveOut.Pause End If If bRecordButton Then Waveln.Pause End If cmdPause.Caption = "&Conti" Else If bPlayButton Then WaveOut.Restart End If If bRecordButton Then Waveln. Restart End If cmdPause.Caption - "&Pause" End If End Sub Private Sub cmdPlayButton_Click() WaveOut.Start cmdStop. Enabled = True cmdPause.Enabled = True cmdAnalysis. Enabled = False cmdRecordButton.Enabled = False cmdPlot.Enabled = False cmdPreTest.Enabled = False bPlayButton = True bRecordButton = False bStopButton = False End Sub Private Sub cmdPreTest_Click() If cmdPreTest.Caption = "Pre&View" Then MMLEDLABEL1. Caption = " " + " PRE- VIEW SIGNAL" cmdPreTest. Caption = "&End" cmdRecordButton.Enabled = False cmdPlayButton.Enabled = False cmdPlot.Enabled = False cmdAnalysis. Enabled = False WavelnS.Start Else MMLEDLABEL1.Caption = " " + " WELCOME TO LEAKFINDER" cmdPreTest.Caption = "Pre&View" cmdRecordButton.Enabled = True WavelnS.Close End If MMLEDPanelHz. Visible = False MMLEDPanelBitNisible = False MMLEDMode. Visible = False LabellO. Visible = False Labelll .Visible = False End Sub Private Sub cmdSPPlay_Click() WaveFile. Wave. filename = gsFileName DSWaveOut.Start End Sub Private Sub cmdSPStop_Click() DSWaveOut.Stop DSWaveOut.Close End Sub Private Sub DSWaveOut_OnStart() cmdSPStop.Enabled = True cmdSPPlay.Enabled = False End Sub Private Sub DSWaveOut_OnStop() DSWaveOut.Close cmdSPStop.Enabled = False cmdSPPlay.Enabled = True End Sub Private Sub MMLEDSpin OnChangeO If MMLEDSpin.Value = 0 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate MMLEDPanelHz.Value = DSWaveOut.Frequency End If ' for Speed Up If MMLEDSpin.Value = 1 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate * 2 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = 2 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate * 4 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = 3 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate * 8 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = 4 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate * 10 MMLEDPanelHz.Value = DSWaveOut.Frequency End If ' For speed down If MMLEDSpin.Value = -1 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate \ 2 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = -2 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate \ 4 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = -3 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate \ 8 MMLEDPanelHz.Value = DSWaveOut.Frequency End If If MMLEDSpin.Value = -4 Then DSWaveOut.Frequency = WaveFile. Wave.SampleRate \ 10 MMLEDPanelHz.Value = DSWaveOut.Frequency End If End Sub Private Sub mnuChangeSpeed_Click() mnuNormalPlayback.Checked = False mnuChangeSpeed.Checked = True fraSpeedChange.Visible = True End Sub Private Sub mnuNormalPlayback ClickO mnuNormalPlayback. Checked = True mnuChangeSpeed.Checked = False fraSpeedChange. Visible = False MMLEDPanelHz.Value = PlayFile. Wave.SampleRate MMLEDSpin.Value = 0 End Sub Private Sub optApplyFilter_Click() lblLowPassM.ForeColor = QBColor(O) lblHiPassM.ForeColor = QBColor(O) txtLowPass.ForeColor = QBColor(O) txtHiPass.ForeColor = QBColor(O) End Sub Private Sub optCustomedCrossCorr_Click() lblLowPassM.ForeColor = QBCoIor(O) lblHiPassM.ForeColor = QBColor(O) txtLowPass.ForeColor = QBColor(O) txtHiPass.ForeColor = QBColor(O) End Sub Private Sub oρtNoFilter_Click() lblLowPassM.ForeColor = QBColor(8) lblHiPassM.ForeColor = QBColor(8) txtLowPass.ForeColor = QBColor(8) txtHiPass.ForeColor = QBColor(8) End Sub Private Sub WaveOut_OnStart() cmdPlayButton.Enabled = False MMSlider.Position = 0 Timer.Enabled = True End Sub Private Sub WaveOut_OnStop() Timer.Enabled = False WaveOut.Close cmdAnalysis. Enabled = True cmdPause.Enabled = False cmdPlayButton.Enabled = True cmdStop. Enabled - False cmdRecordButton.Enabled = True cmdPlot.Enabled = True cmdPreTest.Enabled = True End Sub Private Sub cmdPlot_Click() mnuTimeData_Click End Sub Private Sub cmdRecordButton ClickO bPlayButton = False bRecordButton = True bStopButton = False If SaveDialog. Execute Then gsFileName = SaveDialog.filename RecFile. Wave. filename = SaveDialog.filename MMLEDLABEL1.Caption = " " + UCase(gsFileName) Waveln.MaxRecordTime = Trim$(cboTimeDuration.Text) * 1000 If Trim$(cboResolution.Text) <> "16-bit" Then Waveln.BitLength = b8Bit Else Waveln.BitLength = blόBit End If If Trim$(cboChannel.Text) <> "Stereo" Then Waveln.Mode = mMono Else Waveln.Mode = mStereo End If Waveln.SampleRate = Trim$(cboSampling.Text) MMSlider.Max Value = Trim$(cboTimeDuration.Text) * 1000 MMLEDPanelHz.Visible = False MMLEDPanelBitNisible = False MMLED Mode. Visible = False LabellONisible = False Labelll .Visible = False cmdStop.Enabled = True cmdPause. Enabled - False cmdPlayButton.Enabled = False cmdAnalysis. Enabled = False cmdPlot.Enabled = False cmdPreTest.Enabled = False Waveln. Start End If End Sub Private Sub Timer_OnTimer() Dim time As Long If bPlayButton Then time = WaveOut.Position MMSlider.Position = PlayFile. Wave. Position IblPosition.Caption = Str(PlayFile.Wave.Position \ 1000) + " sec" Else time = Waveln. Position MMSlider.Position = Waveln.Position IblPosition.Caption = Str(WaveIn.Position \ 1000) + " sec" End If End Sub Private Sub WaveIn_OnStart() MMSlider.Position = 0 Timer.Enabled - True End Sub Private Sub WaveIn_OnStop() Timer.Enabled = False Waveln. Close If Not bStopButton Then Open WaveFile (gsFileName) MsgBox "Save to file:" + gsFileName Else Exit Sub End If 1 IblPosition.Caption = Trim$(cboTimeDuration.Text) PlayFile. Wave. filename = gsFileName cmdAnalysis. Enabled = True cmdPlayButton.Enabled = True cmdStop.Enabled = False cmdPause. Enabled = False cmdPlot.Enabled = True cmdPreTest.Enabled = True End Sub Private Sub Form_Load() Dim vol Left - (Screen.Width - Width) / 2 ' Center form horizontally. Top = (Screen. Height - Height) / 2 ' Center form vertically. mnuEffects.Enabled = False mnuTimeData.Enabled = False mnuSaveToExcel. Enabled = False cmdPlayButton.Enabled = False cmdStop.Enabled = False cmdPlot.Enabled = False cmdAnalysis. Enabled = False cmdPause.Enabled = False cmdRecordButton.Enabled = True 'for the pannel MMLEDPanelHzNisible = False MMLEDPanelBitNisible = False MMLEDModeNisible = False Label 10. Visible = False Labelll .Visible = False bPlayButton = False bRecordButton - False bFileFromOpen = False fraSpeedChange. Visible = False ' Open the mixer with devicelD 0. re = mixerOpen(hmixer, 0, 0, 0, 0) If ((MMSYSERR_NOERROR <> re)) Then MsgBox "Couldn't open the mixer." Exit Sub End If ' Get the waveout volume control ok = GetVolumeControKhmixer, _ MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _ MIXERCONTROL_CONTROLTYPE_VOLUME, _ volCtrl) If (ok = False) Then MsgBox "Couldn't open the Volume control." End If ' If the function successfully gets the volume control, ' the maximum and minimum values are specified by ' Maximum and Minimum sldPlayBack. Max = volCtrl. Maximum sldPlayBack.Min = volCtrl. Minimum sldPlayBack. Value = Int((volCtrl. Maximum - volCtrl. Minimum) / 2) ' Get the microphone volume control 'ok = GetVolumeControKhmixer, _ MIXERLlNE_COMPONENTTYPE_SRC_MICROPHONE, _ MIXERCONTROL_CONTROLTYPE_VOLUME, _ micCtrl) ' Get the linein control ok = GetVolumeControKhmixer, MIXERLINE_COMPONENTTYPE_SRC_LINE, _ MIXERCONTROL_CONTROLTYPE_VOLUME, _ micCtrl) If (ok = False) Then MsgBox "Couldn't open the Volume control." End If sldRecord. Max = micCtrl. aximum sldRecord. Min = micCtrl. Minimum sldRecord. Value = Int((micCtrl. Maximum - micCtrl. inimum) / 2) 'setting mixer Recording (microphone) volume vol = sldRecord. Value SetVolumeControl hmixer, micCtrl, vol 'setting mixer master volume vol = sldPlayBack. Value SetVolumeControl hmixer, volCtrl, vol ' set time one second interval ' set up progressbar minimun level ' set up screen show giSampleSelectCoffe = 100 'setup reduce sampling to 441Hz gSampleFrequency = 441 optApplyFilter.Enabled = True bAsciiFileSaved = False blmpulseChoice = False ' set the scree high ' Me.Height = 10815 End Sub Private Sub Form_Unload(Cancel As Integer) ' don't forgot to close the devices at the end Waveln.Close WaveOut.Close WavelnS.Close DSWaveOut.Close End End Sub Private Sub mnuAbout_Click() frm About. Show End Sub Private Sub mnuMediaControl ClickO Call MediaProperties End Sub Private Sub mnuSaveToExcel_Click() Dim sSampleFreq As Single sSampleFreq •= CSng(gSampleFrequency) SaveToExcel sSampleFreq, gFFTSizeEx End Sub Private Sub mnuSoundPlay_Click() SoundProperties End Sub Private Sub mnuVolumeControl_Click() volumeProperties End Sub Private Sub savetofile_Click() Dim iCounter As Long Dim SaveAsciiFileName As String ' input the file name The file will be saved decimated ascii format SaveAsciiFileName = InputBoxC'Enter Name For Save in Ascii", "Ascii FileName", "D:\WaveRaw.dat") SaveFileAscu ReDim signalshow(gArrDimension) Open SaveAsciiFileName For Output As #2 For iCounter = 0 To gArrDimension - 1 Print #2, gSignalY(iCounter); gSignalX(iCounter) Next iCounter Close #2 frmTimeScreen.Show 'just checking Call ResultShow(gSignalY, gArrDimension, frmTimeScreen.picTimeLeft) Call ResultShow(gSignalX, gArrDimension, frmTimeScreen.picTimeRight) End Sub Private Sub mnuTimeData_Click() Dim iCounter As Long ' defined the global frequecy and dicimal analysis frequency gSampleFrequency = Trim$(cboNewSampling.Text) If bFileFromOpen Then ' read acqfreq from OpenOption sub Else ' when recorder file and do the analysis the sampling frequency always screen acqfreq = Trim$(cboSampling.Text) End If ' defined the global frequecy and dicimal analysis frequency gSampleFrequency = Trim$(cboNewSampling.Text) giSampleSelectCoffe = Int(acqfreq / gSampleFrequency) gSampleFrequency = acqfreq / giSampleSelectCoffe SaveFileAscu ReDim signalshow(gArrDimension) gTotalTime = gArrDimension / gSampleFrequency If iNumberChannel = 2 Then frmTimeScreen.Show 'Show window checking Call ResultShow(gSignalY, gArrDimension, frmTimeScreen.picTimeLeft) Call ResultShow(gSignalX, gArrDimension, frmTimeScreen.picTimeRight) End If iNumberChannel = Trim$(PCMWaveFmtRecord.wf.nChannels) If iNumberChannel = 1 Then frmTimeMono.Show Call ResultShow(gSignalX, gArrDimension, frmTimeMono.picTimcMono) End If End Sub Private Sub sldPlayBack_Change() Dim vol vol = sldPlayBack.Value SetVolumeControl hmixer, volCtrl, vol End Sub Private Sub sldRecord_Scroll() Dim vol vol - sldRecord. Value SetVolumeControl hmixer, micCtrl, vol End Sub Private Sub SpeedDown ClickO Screen.MousePointer = 11 frmWarning.Show bDownSpeed = True bUpSpeed = False WaveOutA frm Warning. Hide Screen.MousePointer = 0 End Sub Private Sub SpeedUp ClickO Screen.MousePointer = 11 frmWarning.Show bDownSpeed = False bUpSpeed = True WaveOutA frmWarning.Hide Screen.MousePointer = 0 End Sub Private Sub cmdExit ClickO mixerClose (hmixer) Unload Me End End Sub Private Sub cmdStop ClickO cmdStop.Enabled = False cmdPause.Caption = "&Pause" cmdPause.Enabled = False cmdPreTest.Enabled - True If bRecordButton Then cmdPlayButton.Enabled = False cmdPlot.Enabled = False cmdAnalysis. Enabled = False MMLEDLABEL1. Caption = " " + " WELCOME TO LEAKFINDER" Else cmdPlayButton.Enabled = True cmdPlot.Enabled = True cmdAnalysis. Enabled = True End If bPlayButton = False bRecordButton = False bStopButton = True Waveln. Stop WaveOut.Close End Sub Private Sub mnuExit_Click() ' Unload WavePlay End End Sub Private Sub OpenOption ClickO bFileFromOpen = True bAsciiFileSaved = False 'FileOpenDialog. Action = 1 ' Set CancelError is True If OpenDialog. Execute Then gsFileName = OpenDialog. filename If Open WaveFile (gsFileName) Then mnuEffects. Enabled = True mnuTimeData.Enabled = True cmdPlayButton.Enabled = True cmdStop.Enabled = False cmdRecordButton.Enabled = True cmdAnalysis. Enabled = True cmdPlot.Enabled = True cmdPause.Enabled = False 'for pannel PlayFile. Wave. filename = gsFileName MMLEDPanelHz.Visible = True MMLEDPanelBit. Visible = True MMLEDMode.Visible = True LabellO. Visible = True Labelll.Visible = True MMLEDLABEL1.Caption = " " + UCase (gsFileName) MMSlider.Max Value = PlayFile. Wave.DataSize MMLEDPanelHz.Value = PlayFile. Wave.SampleRate MMLEDPanelBit.Value = PlayFile. Wave.BitLength MMLEDMode.Mode = PlayFile. Wave.Mode End If End If iNumberChannel = Trim$(PCMWaveFmtRecord.wf.nChannels) ' when do the analysis the sampling frequency always from from file info acqfreq = Trim$(PCMWaveFmtRecord.wf.nSamplesPerSec) End Sub Private Sub varifym_Click() SaveDisk End Sub Private Sub VolumeOption_Click() Screen.MousePointer = 11 frmWarning.Show ' PlayOption.Enabled = False ChangeLevel -50 ' PlayOption.Enabled = True frmWarning.Hide Screen.MousePointer = 0 End Sub Private Sub VolumeOptionl_Click() Screen.MousePointer = 11 fr Warning. Show ' PlayOption.Enabled = False ChangeLevel 50 ' PlayOption.Enabled = True frmWarning.Hide Screen.MousePointer = 0 End Sub Private Sub DeviceCapsOption_Click() Dim Result As Long Dim CapsRecord As WAVEOUTCAPS Dim MajorVersion As Integer Dim MinorVersion As Integer Dim ProductName As String Dim Counter As Integer frmDevCaps.Show Result = waveOutGetDevCaps(0, CapsRecord, Len(CapsRecord)) If Result = 0 Then frmDevCaps.Picturel .Cls frmDevCaps.Picturel. Print "Manufacturer's Driver ID: "; CapsRecord.wMid frmDevCaps.Picturel. Print "Product ID: "; CapsRecord. wPid MajorVersion = CapsRecord. vDriverVersion \ 256 MinorVersion = CapsRecord. vDriverVersion Mod 256 frmDevCaps.Picturel. Print "Driver Version: "; MajorVersion; "."; MinorVersion 'Str$ (CapsRecord. vDriverVersion) ProductName = Left$(CapsRecord.szPname, InStr(CapsRecord.szPname, Chr$(0)) - 1) frmDevCaps.Picturel. Print "Product Name: "; ProductName frmDevCaps.Picturel. Print "Wave Formats Supported:" For Counter = 0 To 11 If CapsRecord.dwFormats And 2 * Counter Then frmDevCaps.Picturel. Print " "; WaveFormatStringFromConstant(2 A Counter) End If Next Counter frmDevCaps.Picturel. Print "Number of Channels: "; Str$(CapsRecord.wChannels) frmDevCaps.Picturel. Print "Device Functions Supported:" For Counter = 0 To 4 If CapsRecord.dwSupport And 2 Λ Counter Then frmDevCaps.Picturel. Print " "; WaveFunctionStringFromConstant(2 * Counter) End If Next Counter End If End Sub Private Sub cmdAnalysis_Click() Dim sSampleFreq As Single Dim iPoints As Integer Dim IFFTSize As Long Dim lTotalPoints As Long Dim Wave Velocity As Single Dim SensorSpacing As Single Dim iSegments As Integer Dim i As Long Dim j As Integer Dim IStartPoint As Long Dim FilterOption As String Dim FilterPoles As Integer Dim CutFreq As Single Dim FreqLimit As Single Dim FreqLimitPoints As Long Dim ISignalO As Double Dim FilterSignalXO As Double Dim FilterSignalYO As Double Dim FilterSignalTempO As Double Dim fftinXO As cmplx Dim fftoutXO As cmplx Dim fftinYO As cmplx Dim fftoutYO As cmplx Dim CrossSpectraO As cmplx Dim aveCrossO As cmplx Dim impulseResponseSO As cmplx ' Dim impulseResρonseF() As cmplx Dim repoint As Long Dim tempO As Double ' control enable the command function mnuSaveToExcel. Enabled = False cmdPlayButton.Enabled = False cmdRecordButton.Enabled = False cmdPlot.Enabled = False cmdAnalysis.Enabled = False cmdStop.Enabled = False cmdPause.Enabled = False cmdPreTest.Enabled = False ' get the ascii file If PCMWaveFmtRecord.wf.nChannels <> 2 Then MsgBox "Only One Channel, Can't perform analysis!" GoTo ErrHandle End If If bFileFromOpen Then ' read acqfreq from OpenOption sub Else ' when recorder file and do the analysis the sampling frequency always screen acqfreq = Trim$(cboSamρling.Text) End If ' defined the global frequecy and dicimal analysis frequency gSampleFrequency = Trim$(cboNewSampling.Text) giSampleSelectCoffe = Int(acqfreq / gSampleFrequency) gSampleFrequency = acqfreq / giSampleSelectCoffe 'Call sub, convert data to Ascii, get gSignalXO and gSignalYO If bAsciiFileSaved = False Then SaveFileAscu End If ' Starting data analysis Screen.MousePointer = 11 IFFTSize = Trim$(cboFFTSize.Text) gFFTSizeEx = IFFTSize ' only for export to Excel file iPoints = Trim$(cboDataPoints.Text) ITotalPoints = gArrDimension Wave Velocity = Trim$(txtWaveVelocity.Text) SensorSpacing = Trim$(txtSensorSpacing.Text) sSampleFreq = CSng(gSampleFrequency) iSegments = ITotalPoints \ iPoints IStartPoint = 0 If (optApplyFilter) Then 'using butterworth filter ReDim FilterSignalX(lTotalPoints) ReDim FilterSignalTemp(lTotalPoints) 'Do the filtring Channel 1 FilterOption = "LowPass" FilterPoles = 4 CutFreq = Trim$(txtLowPass.Text) Call BWFilter(gSignalX, FilterSignalTemp, FilterOption, FilterPoles, CutFreq, ITotalPoints, sSampleFreq) FilterOption = "HiPass" CutFreq = Trim$(txtHiPass.Text) Call BWFilter(FilterSignalTemp, FilterSignalX, FilterOption, FilterPoles, CutFreq, ITotalPoints, sSampleFreq) ' do filtring channel 2 ReDim FilterSignalY(lTotalPoints) FilterOption = "LowPass" FilterPoles = 4 CutFreq = Trim$(txtLowPass.Text) Call BWFilter(gSignalY, FilterSignalTemp, FilterOption, FilterPoles, CutFreq, ITotalPoints, sSampleFreq) FilterOption = "HiPass" CutFreq = Trim$(txtHiPass.Text) Call BWFilter(FilterSignalTemp, FilterSignalY, FilterOption, FilterPoles, CutFreq, ITotalPoints, sSampleFreq) 'FFT Calculation ReDim fftinX(lFFTSize) ReDim fftoutX(lFFTSize) ReDim aveoutX(lFFTSize) ReDim fftinY(lFFTSize) ReDim fftoutY(lFFTSize) ReDim aveoutY(lFFTSize) ReDim CrossSpectra(lFFTSize) ReDim aveCross (IFFTSize) For j = 0 To iSegments - 1 For i = 0 To IFFTSize - 1 If i < iPoints Then fftinX(i).re = FilterSignalX(lStartPoint + i) fftinY(i)-re = FilterSignalY (IStartPoint + i) Else fftinX(i).re = 0 fftinY(i).re = 0 End If fftinX(i).im = 0 fftinY(i).im = 0 Next i IStartPoint = IStartPoint + iPoints Call FFT(fftinX, fftoutX, IFFTSize, 1) Call FFT(fftinY, fftoutY, IFFTSize, 1) 'CrossSpectra average Call CrossSpec (fftoutY, fftoutX, CrossSpectra, IFFTSize) Ifj = 0 Then For i = 0 To IFFTSize - 1 aveCross(i) = cequ(CrossSpectra(i)) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveCross (i). re = ((aveCross(i).re * CDbKj) + CrossSpectra(i).re)) / CDbKj + 1) aveCross (i).im = ((aveCross(i).im * CDbl(j) + CrossSρectra(i).im)) / CDbKj + 1) Next i End If ' AutoSpec average: the first segment calculation If j = 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = AutoSpec(fftoutX(i)) aveoutY(i) = AutoSpec(fftoutY(i)) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = (aveoutX(i) * CDbl(j) + AutoSpec(fftoutX(i))) / CDbKj + 1) aveoutY(i) = (aveoutY(i) * CDbKj) + AutoSpec(fftoutY(i))) / CDbl(j + 1) Next i End If Nextj blmpulseChoice = False End If ' doing anlysis without filtering If (optNoFilter) Then 'FFT Calculation ReDim fftinX (IFFTSize) ReDim fftoutX(lFFTSize) ReDim aveoutX (IFFTSize) ReDim fftinY(lFFTSize) ReDim fftoutY(lFFTSize) ReDim aveoutY (IFFTSize) ReDim CrossSpectra(lFFTSize) ReDim aveCross(IFFTSize) For j = 0 To iSegments - 1 For i = 0 To IFFTSize - 1 If i < iPoints Then fftinX(i).re = gSignalX(lStartPoint + i) fftinY(i).re = gSignalY(lStartPoint + i) Else fftinX(i).re = 0 fftinY(i).re = 0 End If fftinX(i).im = 0 fftinY(i).im = 0 Next i IStartPoint = IStartPoint + iPoints Call FFT(fftinX, fftoutX, IFFTSize, 1) Call FFT(fftinY, fftoutY, IFFTSize, 1) 'CrossSpectra average Call CrossSpec(fftoutY, fftoutX, CrossSpectra, IFFTSize) If j = 0 Then For i = 0 To IFFTSize - 1 aveCross(i) = cequ(CrossSpectra(i)) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveCross (i). re = ((aveCross(i).re * CDbl(j) + CrossSpectra(i).re)) / CDbKj + 1) aveCross(i).im = ((aveCross(i).im * CDbl(j) + CrossSpectra (i).im)) / CDbKj + 1) Next i End If ' AutoSpec average: the first segment calculation Ifj = 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = AutoSρec(fftoutX(i)) aveoutY(i) = AutoSpec(fftoutY(i)) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = (aveoutX(i) * CDbKj) + AutoSpec(fftoutX(i))) / CDbl(j + 1) aveoutY(i) = (aveoutY(i) * CDbKj) + AutoSpec(fftoutYG))) / CDbKj + 1) Next i End If Nextj blmpulseChoice = False End If ' doing custom-defined cross-correlation anlysis - without filtring also If (optCustomedCrossCorr) Then 'FFT Calculation ReDim fftinX (IFFTSize) ReDim fftoutX(lFFTSize) ReDim aveoutX(lFFTSize) ReDim fftinY(lFFTSize) ReDim fftoutY(lFFTSize) ReDim aveoutY(lFFTSize) ReDim CrossSpectra(lFFTSize) ReDim aveCross(lFFTSize) For j = 0 To iSegments - 1 For i = 0 To IFFTSize - 1 If i < iPoints Then fftinX(i).re = gSignalX(lStartPoint + i) fftinY(i).re = gSignalY(lStartPoint + i) Else fftinX(i).re = 0 fftinY(i).re = 0 End If fftinX(i).im = 0 fftinY(i).im = 0 Next i IStartPoint = IStartPoint + iPoints Call FFT(fftinX, fftoutX, IFFTSize, 1) Call FFT(fftinY, fftoutY, IFFTSize, 1) 'CrossSpectra average Call CrossSpec(fftoutY, fftoutX, CrossSpectra, IFFTSize) Ifj = 0 Then For i = 0 To IFFTSize - 1 aveCross(i) = cequ(CrossSpectraø)) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveCross (i). re = ((aveCross (i). re * CDbl(j) + CrossSpectra(i).re)) / CDbl(j + 1) aveCross(i).im = ( (aveCross (i).im * CDbKj) + CrossSpectra(i).im)) / CDbl(j + 1) Next i End If ' AutoSpec average: the first segment calculation If j = 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = AutoSpec(fftoutX(i)) aveoutY(i) = AutoSpec(fftoutY(ø) Next i End If 'average the output results If j > 0 Then For i = 0 To IFFTSize - 1 aveoutX(i) = (aveoutX(i) * CDbl(j) + AutoSρec(fftoutX(i))) / CDbl(j + 1) aveoutY(i) = (aveoutY(i) * CDbl ) + AutoSpec(fftoutYG))) / CDbl(j + 1) Next i End If Next j ' above calculation is the regular calculation without filtering ' next is the calculation with impulse response spectra ReDim imρulseResρonseS(lFFTSize) ReDim impulseResponseF(lFFTSize) FreqLimit = Trim$(txtFreqLimit.Text) FreqLimitPoints = CLng((FreqLimit / sSampleFreq) * IFFTSize) For i = 0 To IFFTSize - 1 If i < FreqLimitPoints Or i > IFFTSize - FreqLimitPoints Then impulseResponseS(i).re = aveCross(i).re / aveoutY(i) impulseResponseS(i).im = aveCross (i).im / aveoutY(i) Else impulseResponseS(i).re = 0 impulseResponseS(i).im = 0 End If Next i ' Call IFFT to get impulse response function Call FFT(impulseResponseS, impulseResponseF, IFFTSize, -1) blmpulseChoice = True End If Screen.MousePointer = 0 Debug.Print "iSegments = "; iSegments 'Result show on the vb screen frmResultScreen.Show ReDim lSignal(lFFTSize) ' Show autospecY Right Channel For i = 0 To IFFTSize - 1 lSignal(i) = aveoutY(i) / (IFFTSize * sSampleFreq) Next i Call ResultShowdSignal, IFFTSize / 2, frmResultScreen.picAutoSpecX) 'Show AutospecX Left Channel For i = 0 To IFFTSize - 1 lSignal(i) = aveoutX(i) / (IFFTSize * sSampleFreq) Next i Call ResultShowdSignal, IFFTSize / 2, frmResultScreen.picAutoSpecY) ' Show Coherence for regular analysis, ReDim cohefunc(lFFTSize) Call Coherence(aveoutX, aveoutY, aveCross, cohefunc, IFFTSize) For i = 0 To IFFTSize - 1 lSignal(i) = cohefunc(i) Next i frmResultScreen.lblCoherence.Caption = "Coherence" Call ResultShowdSignal, IFFTSize / 2, frmResultScreen.picCoherence) ' Show Cross-correlation (t),show impulse reseponsefuction if selected Dim nomalizeMax As Double Dim nomalizeMaxAt As Long nomalizeMax = 0 nomalizeMaxAt = 0 If (optCustomedCrossCorr) Then blmpulseChoice = True ReDim temp(lFFTSize) For i = 0 To IFFTSize - 1 repoint = IFFTSize / 2 temp(i) = impulseResponseF(i).re If i < repoint Then impulseResponseF(i).re = impulseResponseF(repoint + i).re If impulseResponseF(i).re > nomalizeMax Then nomalizeMax = impulseResponseF(i).re nomalizeMaxAt = i End If Else impulseResponseF(i).re = temp(i - repoint) If impulseResponseF(i).re > nomalizeMax Then nomalizeMax = impulseResponseF(i).re nomalizeMaxAt = repoint + i End If End If Next i For i = 0 To IFFTSize - 1 impulseResponseF(i).re = impulseResponseF(i).re / nomalizeMax lSignal(i) = impulseResponseF(i).re Next i frmResultScreen.lblCrossCorr.Caption = "Customed Cross-Correlation" Call ResultShowdSignal, IFFTSize, frmResultScreen.picCrossCorr) Else blmpulseChoice = False ReDim CrossCorrelation (IFFTSize) Call FFT(aveCross, CrossCorrelation, IFFTSize, -1) 'Re-arrange the data ReDim temp(lFFTSize) For i = 0 To IFFTSize - 1 repoint = IFFTSize / 2 temp(i) = CrossCorrelation(i).re If i < repoint Then CrossCorrelation(i).re = CrossCorrelation (repoint + i).re If CrossCorrelation (i). re > nomalizeMax Then nomalizeMax = CrossCorrelation (i). re nomalizeMaxAt = i End If Else CrossCorrelation(i).re = tempd - repoint) If CrossCorrelation(i).re > nomalizeMax Then nomalizeMax = CrossCorrelation(i).re nomalizeMaxAt = i End If End If Next i For i = 0 To IFFTSize - 1 CrossCorreIation(i).re = CrossCorrelation(i).re / nomalizeMax lSignal(i) = CrossCorrelation(i).re Next i frmResultScreen.lblCrossCorr.Caption = "Cross-Correlation" Call ResultShowdSignal, IFFTSize, frmResultScreen.picCrossCorr) End If ' do the calculation of leak distance Dim TimeStart As Double Dim TimeDelta As Double Dim TimeStep As Double Dim LeakDistance As Single TimeStart = -1 * CDbl(lFFTSize / sSampleFreq / 2#) TimeStep = 1 / sSampleFreq TimeDelta = TimeStart + TimeStep * nomalizeMaxAt - TimeStep LeakDistance = (SensorSpacing - WaveVelocity * TimeDelta) / 2 With frmResultScreen .lblDistance.Caption = "Leak Distance from station 1 = " + Format$(LeakDistance, "##0.000") + " m" .lblDelta.Caption = "Time shift = " + Format$ (TimeDelta, "##0.000") + " sec" .IblVelocity.Caption = "Wave Velocity = " + Str(WaveVelocity) + " m/s" .lblSpacing. Caption = "Sensor Spacing = " + Str(SensorSpacing) + " m" .IblSampling. Caption = "Sampling Frequency = " + Str(sSampleFreq) + " Hz" .lblFFTSize.Caption = "FFT Size = " + Str(lFFTSize) + " Points" .IblDataSize.Caption = "No.of zero = " + Str(iPoints) + " Points" If (optApplyFilter) Then .IblFilterType.Caption = "Filter Type = 4th Order Butterworth" .IblHipass.Caption = "Hi-Pass Frequency = " + Trim$(frmWaveRecord.txtHiPass.Text) + " Hz" .lblLowPass.Caption = "Low-Pass Frequency = " + Trim$(frmWaveRecord.txtLowPass.Text) + " Hz" Else .IblFilterType.Caption = "Filter Type = None" .IblHipass.Caption = "Hi-Pass Frequency = None" .lblLowPass.Caption = "Low-Pass Frequency = None" End If End With ' Functional enable mnuSaveToExcel. Enabled = True cmdPlayButton.Enabled = True cmdRecordButton.Enabled = True cmdPlot.Enabled = True cmdAnalysis.Enabled = True cmdPreTest.Enabled = True ErrHandle: cmdPlayButton.Enabled = True cmdRecordButton.Enabled = True cmdPlot.Enabled = True cmdAnalysis.Enabled = True cmdPreTest.Enabled = True End Sub ' frmDevCaps Private Sub Form_Load() ' Left = (Screen.Width - Width) / 2 ' Center form horizontally. ' Top = (Screen. Height - Height) / 2 ' Center form vertically. End Sub Private Sub Picturel_Click() Unload frmDevCaps End Sub ' frmResultScreen Private Sub cmdExitResult ClickO Dim i For i = 2 To 24 Unload lblAxis(i) Next i Unload Me f rm WaveRecord .Show End Sub Private Sub cmdPrint_Click() PrintForm End Sub Private Sub Form_Click() Dim i As Integer For i = 2 To 24 Unload lblAxis(i) Next i Unload Me frm WaveRecord. Show End Sub Private Sub Form_Load() Dim i As Integer Dim iLeftX As Integer Dim iLeftY As Integer ' start point from left Dim iAxisLong As Integer Dim iLabalLong As Integer Dim iPictureBetween As Integer iLeftX = 255 'pixel units iAxisLong = 3000 iLabalLong = 300 ' one word cost 100 unit If gSampleFrequency > 1000 Then iLabalLong = 500 End If iPictureBetween = 240 iAxisLong = 3000 iLeftY = 3480 frmWaveRecord.Hide Left = (Screen.Width - Width) / 2 ' Center form horizontally. Top = (Screen. Height - Height) / 2 ' Center form vertically. With lblAxis(l) Top = 2160 ■ .Left = iLeftX .Height = 200 .Width = 300 End With lblAxis(l).Visible = True lblAxis(l).Caption = "0" ' Starting loading the IblAxis for the AutoSpecX labal For i = 2 To 5 Load lblAxis(i) With lblAxis(i) Top = 2160 .Left = iLeftX + (iAxisLong / 4) * (i - 1) - iLabalLong / 2 If i = 5 Then .Left = iLeftX + (iAxisLong / 4) * (i - 1) - iLabalLong End If .Height = 200 .Width = iLabalLong End With lblAxis(i)Nisible = True IblAxis(i). Alignment = 2 If i = 5 Then lblAxis(i). Alignment = 1 End If lblAxis(i). Caption = Trim$((CInt(gSampleFrequency / 8) * (i - 1))) Next i Load lblAxis(ό) With lblAxis(ό) Top = 2360 .Left = 1700 .Height = 200 .Width = 300 End With lblAxis(6).Visible = True lblAxis(6).Caption = "Hz" 'Start loading labal for AutoSpecY For i = 7 To 11 Load lblAxis(i) With lblAxis(i) op = 2160 .Left = iLeftY + (iAxisLong / 4) * (i - 7) - iLabalLong / 2 If i = 7 Then .Left = iLeftY + (iAxisLong / 4) * (i - 7) End If If i = 11 Then .Left = iLeftY + (iAxisLong / 4) * (i - 7) - iLabalLong End If .Height = 200 .Width = iLabalLong End With lblAxis(i).Visible = True lblAxis(i). Alignment = 2 'alignment center If i = 7 Then lblAxis(i). Alignment = 0 ' alignment left End If If i = 11 Then lblAxis(i). Alignment = 1 ' alignment right End If lblAxis(i). Caption = Trim$((CInt(gSampleFrequency / 8) * (i - 7))) Next i Load lblAxis(12) With lblAxis(12) Top = 2360 .Left = 4950 .Height = 200 .Width = 300 End With lblAxis(12).Visible = True lblAxis(12).Caption = "Hz" 'Start loading labal for Coherence or impulse response function For i = 13 To 17 Load lblAxis(i) With lblAxis(i) .Top = 4800 .Left = iLeftX + (iAxisLong / 4) * (i - 13) - iLabalLong / 2 If i = 13 Then .Left = iLeftX + (iAxisLong / 4) * (i - 13) End If If i = 17 Then .Left = iLeftX + (iAxisLong / 4) * (i - 13) - iLabalLong End If .Height = 200 .Width = iLabalLong End With lblAxis(i)Nisible = True lblAxis(i). Alignment = 2 'alignment center If i = 13 Then lblAxis(i).Alignment = 0 ' alignment left End If If i = 17 Then lblAxis(i). Alignment = 1 ' alignment right End If lblAxis(i).Caρtion = Trim$((CInt(gSampleFrequency / 8) * (i - 13))) Next i Load lblAxis(18) With lblAxis(18) Top = 5000 .Left = 1700 .Height = 200 .Width = 300 If blmpulseChoice Then .Width = 800 End If End With lblAxis(18).Visib.e = True lblAxis(18).Caption = "Hz" 'Start loading labals for Cross-Correlation For i = 19 To 23 Load lblAxis(i) With lblAxis(i) Top = 4800 .Left = iLeftY + (iAxisLong / 4) * (i - 19) - iLabalLong / 2 If i = 19 Then .Left = iLeftY + (iAxisLong / 4) * (i - 19) End If If i = 23 Then .Left = iLeftY + (iAxisLong / 4) * (i - 19) - iLabalLong End If .Height = 200 .Width = iLabalLong End With lbl Axis(i) .Visible = True lblAxis(i). Alignment = 2 'alignment center If i = 19 Then IblAxis (i) .Alignment = 0 ' alignment left End If If i = 23 Then lblAxis(i). Alignment = 1 ' alignment right End If If i = 20 Then lblAxis(i).Caption = "-0.5" End If If i = 22 Then lblAxis(i).Caption = "0.5" End If If i = 19 Then lblAxis(i).Caption = "-l" End If If i = 21 Then lblAxis(i).Caption = "0" End If If i = 23 Then lblAxis(i).Caption = "l " End If Next i Load lblAxis(24) With lblAxis(24) Top = 5000 .Left = 4700 .Height = 200 .Width = 800 End With lblAxis(24) .Visible = True lblAxis(24). Caption = "Second" End Sub Private Sub imgFindDetail_Click() Dim nPoints As Long Dim showsignaK) As Double Dim i As Long nPoints = gFFTSizeEx ReDim showsignal(nPoints) If blmpulseChoice Then For i = 0 To nPoints - 1 showsignal(i) = impulseResponseF(i).re Next i Else For i = 0 To nPoints - 1 showsignal(i) = CrossCorrelation(i).re Next i End If frmProf Show. Show Call ResultShow(showsignal, nPoints, frmProfShow.picProfShow) End Sub ' frmProfShow Dim bMarkedResults As Boolean Dim YMarkSpace As Integer Dim RightEndSpace As Integer Dim TopSpace As Integer Dim iAxisLabalWidth As Integer Dim sFreqShow As Single Dim MouseChangeAtPoint As Long Private Sub Form_Load() Dim i bMarkedResults = False YMarkSpace = 400 RightEndSpace = 200 TopSpace = 100 ' resize picturebox Debug. Print frmProfShow.ScaleWidth, picProfShow.Scale Width With frmProfShow.picProfShow Top = TopSpace .Left = YMarkSpace .Width = Scale Width - YMarkSpace - RightEndSpace .Height = ScaleHeight - 1000 End With ' relocation labal With frmProfShow.lblAxisX ' .Height = 200 .Width = 1000 Top = TopSpace + picProf Show. ScaleHeight + 500 .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) - 1000 End With lblAxisX.Alignment = 1 With frmProfShow.lblAxisY .Height = 200 .Width = 1000 Top = TopSpace + picProf Show. ScaleHeight + 700 .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) - 1000 End With lblAxisY. Alignment = 1 With lblAxisXValue ' .Height = 200 .Width = 500 .Top = TopSpace + picProf Show. ScaleHeight + 500 .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) End With lblAxisXValue.Alignment = 0 With IblAxis YValue ' .Height = 200 .Width = 500 Top = TopSpace + picProfShow.ScaleHeight + 700 .Left = YMarkSpace + CInt (picProf Show. Scale Width / 4) End With IblAxis YValue. Alignment = 0 With lblMarkedResult ' .Height = 200 .Width = 2000 Top = TopSpace + picProfShow.ScaleHeight + 600 .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * 3 - 2000 End With lbMarkedResult.Alignment = 1 With IbMarkedResultValue ' .Height = 200 .Width = 500 op = TopSpace + picProfShow.ScaleHeight + 600 .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * 3 End With lblMarkedResultValue.Alignment = 0 ' give the Axis labal first one iAxisLabalWidth = 500 Dim labalshow As Single With lblAxisMarkl .Top = 100 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace .Height = 200 .Width = iAxisLabalWidth End With lblAxisMarkl .Visible = True labalshow = -1 * (CSng(gFFTSizeEx) / CSng(gSampleFrequency)) / 2 lblAxisMarkl. Caption = Format$ (labalshow, "##0.00") ' Starting loading the IblAxis labal With lblAxisMark2 op = 100 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * (1) - iAxisLabalWidth / 2 .Height = 200 .Width = iAxisLabalWidth End With lblAxisMark2Nisible = True lblAxisMark2.Alignment = 2 labalshow = -1 * (CSng(gFFTSizeEx) / CSng (gSampleFrequency)) / 4 lblAxisMark2.Caption = Format$ (labalshow, "##0.00") With lblAxisMark3 .Top = 100 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * (2) - iAxisLabalWidth / 2 .Height = 200 .Width = iAxisLabalWidth End With lblAxisMark3Nisible = True lblAxisMark3. Alignment = 2 lblAxisMark3.Caption = "0" With lblAxisMark4 .Top = 100 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * (3) - iAxisLabalWidth / 2 .Height = 200 .Width = iAxisLabalWidth End With lblAxisMark4Nisible = True lblAxisMark4.Alignment = 2 labalshow = (CSng(gFFTSizeEx) / CSng(gSampleFrequency)) / 4 lblAxisMark4.Caption = Format$(labalshow, "##0.00") With IblAxisMarkδ Top = 100 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * (4) - iAxisLabalWidth .Height = 200 .Width = iAxisLabalWidth End With lblAxisMark5Nisible = True lblAxisMark5. Alignment = 1 labalshow = (CSng(gFFTSizeEx) / CSng(gSampleFrequency)) / 2 lblAxisMark5.Caption = Format$(labalshow, "##0.00") With lblAxisMarkό .Top = 300 + TopSpace + picProfShow.ScaleHeight .Left = YMarkSpace + CInt(picProfShow.ScaleWidth / 4) * (2) - iAxisLabalWidth / 2 .Height = 200 .Width = iAxisLabalWidth + 200 End With lblAxisMarkό. Visible = True lblAxisMarkό.Caption = "Second" End Sub Private Sub Form_Unload(Cancel As Integer) Dim i Unload Me End Sub Private Sub picProfShow_MouseDown(Buiton As Integer, Shift As Integer, X As Single, Y As Single) Dim startpoint As Single Dim steptime As Single Dim xPosition As Single startpoint = -1 * (CSng(gFFTSizeEx) / CSng(gSampleFrequency)) / 2 steptime = 1 / CSng(gSampleFrequency) xPosition = startpoint + steptime * X IblMarkedResultValue = Format$(((102.6 - 480 * xPosition) / 2), "##0.00") End Sub Private Sub picProfShow_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim startpoint As Single Dim steptime As Single Dim xPosition As Single startpoint = -1 * (CSng(gFFTSizeEx) / CSng(gSamρleFrequency)) / 2 steptime = 1 / CSng(gSamρleFrequency) xPosition = startpoint + steptime * X lblAxisXValue.Caption = Format$((Str(xPosition)), "##0.000") IblAxisYValue.Caption = Format$((Str(l - 2# / 500# * Y)), "##0.00") End Sub ' frmTimeScreen Private Sub picTimeScreen ClickO Unload frmTimeScreen End Sub Private Sub Form Load() [Bugis puuεqo 3qj jusssjdθJ , θjqnoQ sy ()Aiεu ι I B q°l9 jBugis uuB ;} }J9[ 9ifl }U9S9jd9j , 9]qno sy OxjBuSjsg lεqoio guoq sy 39zisxj.j lεqojQ Λou9nb9J §ui|duιεs, guoq sy DU9nb9Jj9|duιεsS |Bqoi{) ςς puuεqo qoεθ ui juiod Bjεp o 9Zis, Suoq sy uoisuθuiiQjjyg |ε oιo jg gjuj sy 3jj03nboy3iduiBSiS ιεqo|9 uoμo9[9s gui[dιuBS 9onp9J, jθ θjuj sy gjoQ θ sθiduiBsiS [εqoiQ SUUJS sy IEqo[9 oε 1BJ9U9Q , jpμdxg uoμdø suoQqojo - g poM , qns pu a εε (9Uiιχ[Bjoχg)Jis = uoμdε 'gqoiqi COO**,, / (ε * (3iu!χiB}oχ § )Sus3))$lEuuoj = uoμdB3 q ιqι („0O##„ 'P I (Z * (3ω!l|BloχS)SusD))$JBu oj = uoμ E3-£i q| („0O## N / (9 J!χ|B]oχg) usθ)$iεαuod = „0„ = uoμdB3-ιq3iq] o ()pBoq ~ ιujoj qng 9jBΛμd εz OUOJΛJ9UliχuUJ pBOJU l ()>|0iI3-ouojΛj9Uiχ0!d qns 9jBΛμ oz 0U0JΛJ9UiiχUUJ qn S pug (9UJ!χ|B)θχ )jJS = uoμdBQ-gqMOiqi oi (.OO**,, / (ε * ( 9 *JJ!XlBloχS)SuSD))$lBUJJθa = uoμdB -frqqoiqi („0'0##, ' I (Z * (3UitχiBjoχg)gus3))$iεujjoa = uoμdEQ-eqqoiqi ( u 0'0##.. / (9tn!Xiεjoχg)gus3)$iεuuoa = „0„ = uoμdB3t qoιqι (9uπχiBjoχg).ns = uoμdBO-SBqoiq] g („0'0##„ / (ε * ( 9 tu! i oχ ) us3))$lBuuoa = uoμdB3-t.Bioιqι ( u 0'0##„ / (Z * (3i"!XIBloχ2)gusD))$lBuuoa = uoμdB3-εBq3iqι ( U OO## H > / (9ui!χlBjo ) usD)$iεuuoa = uoμdB0--Bq3i „0„ = uoμdB3-χBq3iqι 9P 0C000/ϊ0V3/X3d t06ϊ£/ΪO OΛV Global gTotalTime As Integer ' represnt the total time in domain window Global aveoutXO As Double ' present the autospectra X Global aveoutYO As Double ' present the autospectra Y Global CrossCorrelation () As cmplx ' cross-correlation in time domain Global cohefuncO As Double 'Present the coherence function Global impulseResponseFO As cmplx 'Present the impulse response function Global bAsciiFileSaved As Boolean Global blmpulseChoice As Boolean Global bFileFromOpen As Boolean Global bDownSpeed As Boolean Global bUpSpeed As Boolean 1 Function Parameters ' MsgBox parameters Global Const MB_OK = 0 ' OK button only Global Const MB_OKCANCEL = 1 ' OK and Cancel buttons Global Const MB_ABORTRETRYlGNORE = 2 ' Abort, Retry, and Ignore buttons Global Const MB_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons Global Const MB_YESNO = 4 ' Yes and No buttons Global Const MB_RETRYCANCEL = 5 ' Retry and Cancel buttons Global Const MB CONSTOP = 16 ' Critical message Global Const MB CONQUESTION = 32 ' Warning query Global Const MB CONEXCLAMATION = 48 ' Warning message Global Const MBJCONINFORMATION = 64 ' Information message Global Const MB_APPLMODAL = 0 ' Application Modal Message Box Global Const MB_DEFBUTTONl = 0 ' First button is default Global Const MB_DEFBUTTON2 = 256 ' Second button is default Global Const MB DEFBUTTON3 = 512 ' Third button is default Global Const MB_SYSTEMMODAL = 4096 'System Modal ' MsgBox return values Global Const IDOK = 1 ' OK button pressed Global Const IDCANCEL = 2 ' Cancel button pressed Global Const IDABORT = 3 ' Abort button pressed Global Const IDRETRY = 4 ' Retry button pressed Global Const IDIGNORE = 5 ' Ignore button pressed Global Const ID YES = 6 ' Yes button pressed Global Const IDNO = 7 ' No button pressed ' Module - PlayConfigures Option Explicit Type FOURCC Chars As String * 4 End Type Type MCI_WAVE_OPEN_PARMS dwCallback As Long wDevicelD As Integer IpstrDeviceType As String IpstrElementName As String IpstrAlias As String dwBufferSeconds As Long End Type Type MCI_SET_PARMS dwCallback As Long dwTimeFormat As Long dwAudio As Long End Type Type MCI_PLAY_P ARMS dwCallback As Long dwFrom As Long dwTo As Long End Type Type MCI_RECORD_PARMS dwCallback As Long dwFrom As Long dwTo As Long End Type Type MCI_SAVE_PARMS dwCallback As Long IpstrElementName As String End Type Type MCI_WAVE_SET_PARMS dwCallback As Long dwTimeFormat As Long dwAudio As Long wlnput As Long wOutput As Long wFormatTag As Integer wReserved2 As Integer nChannels As Integer wReserved3 As Integer nSamplesPerSec As Long nAvgBytesPerSec As Long nBlockAlign As Integer wReserved4 As Integer nBitsPerSample As Integer wReserved5 As Integer End Type Type WaveFormat wFormatTag As Integer nChannels As Integer nSamplesPerSec As Long nAvgBytesPerSec As Long nBlockAlign As Integer End Type Type WAVEOUTCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * 32 dwFormats As Long wChannels As Integer dwSupport As Long End Type Type WAVEHDR lpData As Long dwBufferLength As Long dwBytesRecorded As Long dwUser As Long dwFlags As Long dwLoops As Long lpNext As Long reserved As Long End Type Type pcmWaveFormat wf As WaveFormat wBitsPerSample As Integer End Type Type MMIOINFO dwFlags As Long fccIOProc As Long plOProc As Long wErrorRet As Long htask As Long cchBuffer As Long pchBuffer As String pchNext As String pchEndRead As String pchEndWrite As String lBufOffset As Long IDiskOffset As Long adwInfo(4) As Long dwReservedl As Long dwReserved2 As Long hmmio As Long End Type Type MMCKINFO ckid As FOURCC ' chunk ID ckSize As Long ' chunk size fccType As FOURCC ' form type or list type dwDataOffset As Long ' offset of data portion of chunk dwFlags As Long ' flags used by MMIO functions End Type Type MMTIME wType As Long u As Long End Type ' values for wType field in MMTIME struct Public Const TIME MS = &H1 ' time in Milliseconds Public Const TIME_SAMPLES = &H2 ' number of wave samples Public Const TIME_BYTES = &H4 ' current byte offset Public Const TIME_SMPTE = &H8 ' SMPTE time Public Const TIME_MIDI = &H10 ' MIDI time #If Win32 Then Private Declare Function Iparraycpy Lib "kernel32" Alias "lstrcpy" (IpStringl As Any, IpString2 As Any) As Long Private Declare Function mmioAscend Lib "winmm.dll" (ByVal hmmio As Long, Ipck As Any, ByVal uFlags As Long) As Long Private Declare Function mmioClose Lib "winmm.dll" (ByVal hmmio As Long, ByVal uFlags As Long) As Long Private Declare Function mmioDescend Lib "winmm.dll" (ByVal hmmio As Long, Ipck As Any, lpckParent As Any, ByVal uFlags As Long) As Long Private Declare Function mmioOpen Lib "winmm.dll" Alias "mmioOpenA" (ByVal szFileName As String, lpmmioinfo As Any, ByVal dwOpenFlags As Long) As Long Private Declare Function mmioRead Lib "winmm.dll" (ByVal hmmio As Long, pch As Any, ByVal cch As Long) As Long Private Declare Function waveOutClose Lib "winmm.dll" (ByVal hWaveOut As Long) As Long Public Declare Function waveOutGetDevCaps Lib "winmm.dll" Alias "waveOutGetDevCapsA" (ByVal uDevicelD As Long, lpCaps As WAVEOUTCAPS, ByVal uSize As Long) As Long Private Declare Function waveOutOpen Lib "winmm.dll" (lphWaveOut As Long, ByVal uDevicelD As Long, lpFormat As pcmWaveFormat, ByVal dwCallback As Long, ByVal dwlnstance As Long, ByVal dwFlags As Long) As Long Private Declare Function waveOutPrepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, IpWaveOutHdr As Any, ByVal uSize As Long) As Long Private Declare Function waveOutUnprepareHeader Lib "winmm.dll" (ByVal hWaveOut As Long, IpWaveOutHdr As Any, ByVal uSize As Long) As Long Private Declare Function waveOutWrite Lib "winmm.dll" (ByVal hWaveOut As Long, IpWaveOutHdr As Any, ByVal uSize As Long) As Long Private Declare Function waveOutPause Lib "winmm.dll" (ByVal hWaveOut As Long) As Long Private Declare Function mmioReadToGlobal Lib "winmm.dll" Alias "mmioRead" (ByVal hmmio As Long, ByVal lpBuffer As Long, ByVal cch As Long) As Long Private Declare Function waveOutGetPosition Lib "winmm.dll" (ByVal hWaveOut As Long, lplnfo As MMTIME, ByVal uSize As Long) As Long Private Declare Function waveOutGetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Long, lpdwRate As Long) As Long Private Declare Function waveOutSetPlaybackRate Lib "winmm.dll" (ByVal hWaveOut As Long, ByVal dwRate As Long) As Long #Else Public Declare Function waveOutGetDevCaps Lib "MMSystem" (ByVal wDevicelD As Integer, lpCaps As WAVEOUTCAPS, By Val wSize As Integer) As Integer Private Declare Function waveOutOpen Lib "MMSystem" (lphWaveOut As Integer, ByVal wDevicelD As Integer, lpFormat As Any, By Val dwCallback As Long, ByVal dwCallback As Long, ByVal dwFlags As Long) As Integer Private Declare Function waveOutClose Lib "MMSystem" (ByVal hWaveOut As Integer) As Integer Private Declare Function waveOutPrepareHeader Lib "MMSystem" (ByVal hWaveOut As Integer, IpWaveOutHdr As Any, ByVal wSize As Integer) As Integer Private Declare Function waveOutUnprepareHeader Lib "MMSystem" (ByVal hWaveOut As Integer, IpWaveOutHdr As Any, ByVal wSize As Integer) As Integer Private Declare Function waveOutWrite Lib "MMSystem" (ByVal hWaveOut As Integer, IpWaveOutHdr As Any, ByVal wSize As Integer) As Integer 'Private Declare Function waveOutClose Lib "mmsystem" (ByVal hWaveOut As Integer) As Integer Private Declare Function mmioOpen Lib "MMSystem" (ByVal szFileName As String, lpmmioinfo As Any, ByVal dwOpenFlags As Long) As Integer Private Declare Function mmioClose Lib "MMSystem" (ByVal hmmio As Integer, ByVal wFlags As Integer) As Integer Private Declare Function mmioDescend Lib "MMSystem" (ByVal hmmio As Integer, Ipck As Any, lpckParent As Any, ByVal wFlags As Integer) As Integer Private Declare Function mmioAscend Lib "MMSystem" (ByVal hmmio As Integer, Ipck As Any, ByVal wFlags As Integer) As Integer Private Declare Function mmioRead Lib "MMSystem" (ByVal hmmio As Integer, pch As Any, ByVal cch As Long) As Long Private Declare Function mmioReadToGlobal Lib "MMSystem" Alias "mmioRead" (ByVal hmmio As Integer, ByVal lpBuffer As Long, ByVal cch As Long) As Long Private Declare Function iparraycpy Lib "Kernel" Alias "lstrcpy" (IpStringl As Any, lpString2 As Any) As Long #End If Global Const WAVE_MAPPER = -1 ' Device ID for Wave Mapper Global Const MMIO_READ = &H0& Global Const MMIO_WRITE = &H1& Global Const MMIO_READ WRITE = &H2& Global Const MMIO_FINDCHUNK = &H10 ' mmioDescend: find a chunk by ID Global Const MMIO_FINDRIFF = &H20 ' mmioDescend: find a LIST chunk Global Const WHDR_DONE = &H1 ' done bit ' flags for dwFlags parameter in waveOutOpenO and wavelnOpenO Global Const WAVE_FORMAT_QUERY = &H1 Global Const WAVECAPS PITCH = &H1 ' Supports pitch control Global Const WAVECAPS_PLAYBACKRATE = &H2 ' Supports playback rate control Global Const WAVECAPS_VOLUME = &H4 ' Supports volume control Global Const WAVECAPS LR VOLUME = &H8 ' Supports separate left-right volume control Global Const WAVECAPS_SYNC = &H10 Global Const WAVEJNVALIDFORMAT = &H0 ' Invalid Format Global Const WAVE_FORMAT_1M08 = &H1 ' 11.025 kHz, Mono, 8 bit Global Const WAVE_FORMAT_1S08 = &H2 ' 11.025 kHz, Stereo, 8 bit Global Const W A VE_FORMAT_lM16 = &H4 ' 11.025 kHz, Mono, 16 bit Global Const WAVE_FORMAT_lS16 = &H8 ' 11.025 kHz, Stereo, 16 bit Global Const WAVE_FORMAT_2M08 = &H10 ' 22.05 kHz, Mono, 8 bit Global Const WAVE_FORMAT_2S08 = &H20 ' 22.05 kHz, Stereo, 8 bit Global Const WAVE_FORMAT_2M16 = &H40 ' 22.05 kHz, Mono, 16 bit Global Const WAVE_FORMAT_2S16 = &H80 ' 22.05 kHz, Stereo, 16 bit Global Const W A VE_FORMAT_4M08 = &H100 ' 44.1 kHz, Mono, 8 bit Global Const WAVE_FORMAT_4S08 = &H200 ' 44.1 kHz, Stereo, 8 bit Global Const WAVE_FORMAT_4Ml 6 = &H400 ' 44.1 kHz, Mono, 16 bit Global Const W A VE_FORM AT_4S 16 = &H800 ' 44.1 kHz, Stereo, 16 bit Global Const MCI_OPEN = &H803 Global Const MCI_STOP = &H808 Global Const MCI_PLAY = &H806 Global Const MCI_CLOSE = &H804 Global Const MCI_RECORD = &H80F Global Const MCI_SET = &H80D Global Const MCI_SAVE = &H813 Global Const MCI FROM& = &H4& Global Const MCI_TO& = &H8& Global Const MIC_SAVE_FILE& = &H100& Global Const MCI_OPEN_TYPE& = &H2000& Global Const MCI_OPEN_ELEMENT& = &H200& Global Const MCI_WAIT& = &H2& Global Const MCI_NOTIFY& = &H1 & Public Const MCI_WAVE_SET_FORMATTAG = &H10000 Global Const MCI_WAVE_SET_CHANNELS = &H20000 Global Const MCI_WAVE_SET_SAMPLESPERSEC = &H40000 Global Const MCI_WAVE_SET_AVGBYTESPERSEC = &H80000 Global Const MCI WAVE SET BITSPERSAMPLE = &H200000 Global Const MCI_WAVE_SET_BLOCK ALIGN = &H100000 Global Const MCI_WAVE_INPUT = &H400000 Global Const MCI_WAVE_OFFSET = 1152 Global Const WAVE_FORMAT_PCM = 1 Global Const MM_MCINOTIFY = &H3B9 ' Global Const WAVE_FORMAT_PCM = MCI_WAVE_OFFSET + 0 Global Const MCI_SET_TIME_FORMAT = &H400& Global Const MCI_FORMAT_MILLISECONDS = 0 Type MonoEightBitSamples Char As Byte End Type Type StereoEightBitSamples LeftChar As Byte RightChar As Byte End Type Type MonoSixteenBitSamples Sample As Long End Type Type StereoSixteenBitSamples LeftSample As Long RightSample As Long End Type Dim WaveBufferO As Byte Dim hWaveOut As Long Dim WaveHeader As WAVEHDR Global PCMWaveFmtRecord As pcmWaveFormat Function AddEcho (Delay As Integer, EchoGain As Integer) Dim EchoPeriod As Long Dim GainFactor As Single Dim lpTheWaveSampleData As Long Dim lpNewWaveSampleData As Long Dim LastSamplePosition As Long Dim Position As Long Dim Dummy As Long Dim NewBufferLength As Long Dim MonoEightBitSample As MonoEightBitSamples Dim PrevMonoEightBitSample As MonoEightBitSamples Dim StereoEightBitSample As StereoEightBitSamples Dim PrevStereoEightBitSample As StereoEightBitSamples Dim MonoSixteenBitSample As MonoSixteenBitSamples Dim PrevMonoSixteenBitSample As MonoSixteenBitSamples Dim StereoSixteenBitSample As StereoSixteenBitSamples Dim PrevStereoSixteenBitSample As StereoSixteenBitSamples Const TrailingEchoes = 2 GainFactor = EchoGain / 50 EchoPeriod = Delay * PCM WaveFmtRecord.wf. nSamplesPerSec \ 1000 Select Case WaveFormatConstantFromFormat(PCMWaveFmtRecord) Case WAVE_FORMAT_1M08, WAVE_FORMAT_2M08, WAVE FORMAT 4M08 ' Mono 8-bit NewBufferLength = WaveHeader.dwBufferLength + EchoPeriod * TrailingEchoes.- 1 ReDim Preserve WaveBuffer(NewBufferLength) PrevMonoEightBitSample.Char = 128 ' Initialize new bytes to midpoint value. For Position = WaveHeader.dwBufferLength To NewBufferLength WaveBuffer(Position) = PrevMonoEightBitSample.Char Next Position ' Mix in echo. For Position = EchoPeriod To NewBufferLength MonoEightBitSample.Char = WaveBuffer(Position) ' Retrieve contents of byte at (Position-Period). PrevMonoEightBitSample.Char = WaveBuffer(Position - EchoPeriod) WaveBuffer(Position) = ((MonoEightBitSample.Char - 128) + (PrevMonoEightBitSample.Char - 128) * GainFactor) \ 2 + 128 Next Position WaveHeader.dwBufferLength = NewBufferLength + 1 MsgBox "Completed " + Str$ (Position) + " iterations out of " + Str$(WaveHeader.dwBufferLength) Case WAVE_FORMAT_1S08, WAVE_FORMAT_2S08, WAVE_FORMAT_4S08 ' Stereo 8-bit EchoPeriod = EchoPeriod * 2 NewBufferLength = WaveHeader.dwBufferLength + EchoPeriod * TrailingEchoes - 1 ReDim Preserve WaveBuffer(NewBufferLength) PrevStereoEightBitSample.LeftChar = 128 PrevStereoEightBitSample.RightChar = 128 ' Initialize new bytes to midpoint value. For Position = WaveHeader.dwBufferLength To NewBufferLength Step 2 WaveBuffer(Position) = PrevStereoEightBitSample.LeftChar WaveBuff er(Position + 1) = PrevStereoEightBitSample.RightChar Next Position 1 Mix in echo. For Position = EchoPeriod To NewBufferLength Step 2 StereoEightBitSample.LeftChar = WaveBuffer(Position) StereoEightBitSample.RightChar = WaveBuffer(Position -t- 1) ' Retrieve contents of byte at (Position-Period). PrevStereoEightBitSample.LeftChar = WaveBuffer(Position - EchoPeriod) PrevStereoEightBitSample.RightChar = WaveBuffer(Position - EchoPeriod + 1) WaveBuffer(Position) = ((StereoEightBitSample.LeftChar - 128) + (PrcvStereoEightBitSample.LeftChar - 128) * GainFactor) \ 2 + 128 WaveBuffer(Position + 1) = ((StereoEightBitSample.RightChar - 128) + (PrevStereoEightBitSample.RightChar - 128) * GainFactor) \ 2 + 128 Next Position WaveHeader.dwBufferLength = NewBufferLength + 1 MsgBox "Completed " + Str$ (Position) + " iterations out of " + Str$(WaveHeader.dwBufferLength) Case WAVE FORMAT 1M16, WAVE_FORMAT_2M16, WAVE_FORMAT_4M16 ' Mono 16-bit EchoPeriod = EchoPeriod * 2 NewBufferLength = WaveHeader.dwBufferLength + EchoPeriod * TrailingEchoes - 1 ReDim Preserve WaveBuffer(NewBufferLength + 1) ' Mix in echo. For Position = EchoPeriod To NewBufferLength Step 2 MonoSixteenBitSample.SampIe = CLng(WaveBuffer(Position + 1)) * 256 + WaveBuffer(Position) If MonoSixteenBitSample.SampIe > 32767 Then MonoSixteenBitSample.SampIe = MonoSixteenBitSample.SampIe - 65535 PrevMonoSixteenBitSample.Sample = CLng(WaveBuffer(Position + 1 - EchoPeriod)) * 256 + WaveBuffer(Position - EchoPeriod) If PrevMonoSixteenBitSample. Sample > 32767 Then PrevMonoSixteenBitSample.Sample = PrevMonoSixteenBitSample.Sample - 65535 MonoSixteenBitSample.SampIe = (MonoSixteenBitSample.SampIe + PrevMonoSixteenBitSample.Sample * GainFactor) \ 2 If MonoSixteenBitSample.SampIe < 0 Then MonoSixteenBitSample.SampIe = 65535 + MonoSixteenBitSample.SampIe WaveBuffer(Position + 1) = MonoSixteenBitSample.SampIe \ 256 WaveBuffer(Position) = MonoSixteenBitSample.SampIe Mod 256 Next Position WaveHeader.dwBufferLength = NewBufferLength + 1 MsgBox "Completed " + Str$ (Position) + " iterations out of " + Str$ (WaveHeader.dwBufferLength) Case WAVE_F0RMAT_1S16, WAVE_FORMAT_2S16, WAVE_FORMAT_4S16 ' Stereo 16-bit EchoPeriod = EchoPeriod * 4 NewBufferLength = WaveHeader.dwBufferLength + EchoPeriod * TrailingEchoes - 4 ReDim Preserve WaveBuffer(NewBufferLength) For Position = EchoPeriod To NewBufferLength - 4 Step 4 ' Left Channel StereoSixteenBitSample.LeftSample = CLng(WaveBuffer(Position + 1)) * 256 + WaveBuffer(Position) If StereoSixteenBitSample.LeftSample > 32767 Then StereoSixteenBitSample.LeftSample = StereoSixteenBitSample.LeftSample - 65535 PrevStereoSixteenBitSample.LeftSample = CLng(WaveBuffer(Position + 1 - EchoPeriod)) * 256 + WaveBuffer(Position - EchoPeriod) If PrevStereoSixteenBitSample.LeftSample > 32767 Then PrevStereoSixteenBitSample.LeftSampIe = PrevStereoSixteenBitSample.LeftSample - 65535 StereoSixteenBitSample.LeftSample = (StereoSixteenBitSample.LeftSample + PrevStereoSixteenBitSample.LeftSample * GainFactor) \ 2 If StereoSixteenBitSample.LeftSample < 0 Then StereoSixteenBitSample.LeftSample = 65535 + StereoSixteenBitSample.LeftSample WaveBuffer(Position + 1) = StereoSixteenBitSample.LeftSample \ 256 WaveBuffer(Position) = StereoSixteenBitSample.LeftSample Mod 256 ' Right Channel StereoSixteenBitSample.RightSample = CLng(WaveBuffer(Position + 3)) * 256 + WaveBuffer(Position + 2) If StereoSixteenBitSample.RightSample > 32767 Then StereoSixteenBitSample.RightSample = StereoSixteenBitSample.RightSample - 65535 PrevStereoSixteenBitSample.RightSample = CLng(WaveBuffer(Position + 3 - EchoPeriod)) * 256 + WaveBuffer(Position + 2 - EchoPeriod) If PrevStereoSixteenBitSample.RightSample > 32767 Then PrevStereoSixteenBitSample.RightSample = PrevStereoSixteenBitSample.RightSample - 65535 StereoSixteenBitSample.RightSample = (StereoSixteenBitSample.RightSample + PrevStereoSixteenBitSample.RightSample * GainFactor) \ 2 If StereoSixteenBitSample.RightSample < 0 Then StereoSixteenBitSample.RightSample = 65535 + StereoSixteenBitSample.RightSample WaveBuffer(Position + 3) = StereoSixteenBitSample.RightSample \ 256 WaveBuffer(Position + 2) = StereoSixteenBitSample.RightSample Mod 256 Next Position WaveHeader.dwBufferLength = NewBufferLength MsgBox "Completed " + Str$(Position) 4- " iterations out of " + Str$ (WaveHeader.dwBufferLength) End Select End Function Sub ChangeLevel (Level Change As Integer) Dim Position As Long Dim LevelFactor As Single Dim Temp Value As Integer Dim MonoEightBitSample As MonoEightBitSamples Dim StereoEightBitSample As StereoEightBitSamples Dim MonoSixteenBitSample As MonoSixteenBitSamples Dim StereoSixteenBitSample As StereoSixteenBitSamples Dim Templong As Long LevelFactor = 1 + LevelChange / 100 Select Case WaveFormatConstantFromFormat(PCMWaveFmtRecord) Case WAVE_FORMAT_1M08, WAVE_FORMAT_2M08, WAVE_FORMAT_4M08 ' Mono 8-bit For Position = 0 To (WaveHeader.dwBufferLength - 1) MonoEightBitSample.Char = WaveBuffer(Position) Temp Value = (MonoEightBitSample.Char - 128) * LevelFactor MonoEightBitSample.Char = MaxInt(MinInt(TempValue, 127), -128) + 128 WaveBuffer(Position) = MonoEightBitSample.Char Next Position Case WA VE_FORMAT_l S08, WAVE_FORM AT_2S08, WA VE_FORMAT_4S08 ' Stereo 8-bit For Position = 0 To (WaveHeader.dwBufferLength - 2) Step 2 StereoEightBitSample.LeftChar = WaveBuffer(Position) StereoEightBitSample.RightChar = WaveBuffer(Position + 1) Temp Value = (StereoEightBitSample.LeftChar - 128) * LevelFactor StereoEightBitSample.LeftChar = MaxInt(MinInt(TempValue, 127), -128) + 128 Temp Value = (StereoEightBitSample.RightChar - 128) * LevelFactor StereoEightBitSample.RightChar = MaxInt(MinInt(TempValue, 127), -128) + 128 WaveBuffer(Position) = StereoEightBitSample.LeftChar WaveBuffer(Position + 1) = StereoEightBitSample.RightChar Next Position Case WAVE_F0RMAT_1M16, WAVE_FORMAT_2M16, WAVE_FORMAT_4M16 ' Mono 16-bit For Position = 0 To (WaveHeader.dwBufferLength - 2) Step 2 MonoSixteenBitSample.SampIe = CLng(WaveBuffer(Position + 1)) * 256 + WaveBuffer(Position) If MonoSixteenBitSample.SampIe > 32767 Then MonoSixteenBitSample.SampIe = MonoSixteenBitSample.SampIe - 65535 MonoSixteenBitSample.SampIe = MaxLong(MinLong(MonoSixteenBitSample.Samρle * LevelFactor, 32767), -32768) If MonoSixteenBitSample.SampIe < 0 Then MonoSixteenBitSample.SampIe = 65535 + MonoSixteenBitSample.SampIe WaveBuffer(Position + 1) = MonoSixteenBitSample.SampIe \ 256 WaveBuffer(Position) = MonoSixteenBitSample.SampIe Mod 256 Next Position Case WAVE_F0RMAT_1S16, WAVE_FORMAT_2S16, WAVE_FORMAT_4S16 ' Stereo 16-bit For Position = 0 To (WaveHeader.dwBufferLength - 4) Step 4 'Left Channel StereoSixteenBitSample.LeftSample = CLng(WaveBuffer(Position + 1)) * 256 + WaveBuffer(Position) If StereoSixteenBitSample.LeftSample > 32767 Then StereoSixteenBitSample.LeftSample = StereoSixteenBitSample.LeftSample - 65535 StereoSixteenBitSample.LeftSample = MaxLong(MinLong(StereoSixteenBitSample.LeftSampIe * LevelFactor, 32767), -32768) If StereoSixteenBitSample.LeftSample < 0 Then StereoSixteenBitSample.LeftSample = 65535 + StereoSixteenBitSample.LeftSample WaveBuffer(Position + 1) = StereoSixteenBitSample.LeftSample \ 256 WaveBuffer(Position) = StereoSixteenBitSample.LeftSample Mod 256 'Right Channel StereoSixteenBitSample.RightSample = CLng(WaveBuffer(Position + 3)) * 256 + WaveBuffer(Position + 2) If StereoSixteenBitSample.RightSample > 32767 Then StereoSixteenBitSample.RightSample = StereoSixteenBitSample.RightSample - 65535 StereoSixteenBitSample.RightSample = MaxLong(MinLong(StereoSixteenBitSample.RightSample * LevelFactor, 32767), -32768) If StereoSixteenBitSample.RightSample < 0 Then StereoSixteenBitSample.RightSample = 65535 + StereoSixteenBitSample.RightSample WaveBuffer(Position + 3) = StereoSixteenBitSample.RightSample \ 256 WaveBuffer(Position + 2) = StereoSixteenBitSample.RightSample Mod 256 Next Position End Select End Sub Sub ChangeSpeed(SpeedChange As Integer) Dim ReturnCode As Long Dim .Volume As Long ' Open the wave device. ReturnCode = waveOutOpen(hWaveOut, WAVE_MAPPER, PCMWaveFmtRecord, 0&, 0&, 0&) If ReturnCode = 0 Then ReturnCode = waveOutGetPlaybackRate(hWaveOut, lVolume) End If ReturnCode = waveOutClose(hWaveOut) Debug.Print "volume set = ", lVolume lVolume = 1 End Sub Public Function Open WaveFile(By Val FileNameAndPath As String) As Boolean Dim MMCKInfoParent As MMCK1NFO Dim MMCklnfoChild As MMCKINFO Dim hmmio As Long Dim ErrorCode As Long Dim BytesRead As Long Dim iCounter As Long Open WaveFile = False hmmio = mmioOpen(FileNameAndPath, ByVal 0&, MMIO_READ) If hmmio <> 0 Then ' Find WAVE Parent Chunk MMCKInfoParent.fccType.Chars = "WAVE" ErrorCode = mmioDescend(hmmio, MMCKInfoParent, ByVal 0&, MMIO_FINDRIFF) If ErrorCode = 0 Then ' Find fmt Chunk MMCklnfoChild.ckid.Chars = "fmt " ErrorCode = mmioDescend (hmmio, MMCklnfoChild, MMCKInfoParent, MMIO_FINDCHUNK) If ErrorCode = 0 Then ' Read PCM Wave Format Record BytesRead = mmioRead(hmmio, PCMWaveFmtRecord, MMCklnfoChild.ckSize) If BytesRead > 0 Then ErrorCode = waveOutOpen (hWaveOut, WAVE_MAPPER, PCMWaveFmtRecord, 0&, 0&, WAVE_FORMAT_QUERY) If ErrorCode = 0 Then ' Ascend back one level in the RIFF file. ErrorCode = mmioAscend(hmmio, MMCklnfoChild, 0) If ErrorCode = 0 Then ' Read data chunk. MMCklnfoChild.ckid.Chars = "data" ErrorCode = mmioDescend(hmmio, MMCklnfoChild, MMCKInfoParent, MMIO_FINDCHUNK) If ErrorCode = 0 Then ReDim WaveBuffer(MMCkInfoChild.ckSize - 1) BytesRead = mmioRead(hmmio, WaveBuffer(O), MMCklnfoChild.ckSize) If BytesRead > 0 Then ' Get a pointer to the Wave data and fill in Wave Header. WaveHeader.lpData = Iparraycpy (WaveBuffer(O), WaveBuffer(O)) WaveHeader.dwBufferLength = BytesRead WaveHeader.dwFlags = 0& WaveHeader.dwLoops = 0& Open WaveFile = True Else MsgBox "Couldn't read wave data.", MBJCONSTOP, "RIFF File Error" End If Else MsgBox "Couldn't find data chunk.", MBJCONSTOP, "RIFF File Error" End If Else MsgBox "Couldn't ascend from fmt chunk.", MBJCONSTOP, "RIFF File Error" End If Else MsgBox "Format not supported by Wave device.", MBJCONSTOP, "Wave Data Error" End If Else MsgBox "Couldn't read wave format record.", MBJCONSTOP, "RIFF File Error" End If Else MsgBox "Couldn't find fmt chunk.", MBJCONSTOP, "RIFF File Error" End If Else MsgBox "Couldn't find WAVE parent chunk.", MBJCONSTOP, "RIFF File Error" End If ' Close WAVE file. ErrorCode = mmioClose(hmmio, 0) Else MsgBox "Couldn't open file.", MBJCONSTOP, "RIFF File Error" End If End Function Function WaveFormatConstantFromFormat(ThePCMWaveFormatRecord As pcmWaveFormat) As Long Dim SampleRateFactor As Long Dim ResolutionFactor As Long Dim ChannelsFactor As Long SampleRateFactor = (Log(ThePCMWaveFormatRecord.wf.nSamplesPerSec \ 11025) / Log(2)) * 4 ResolutionFactor = (ThePCMWaveFormatRecord.wBitsPerSampIe \ 8 - 1) * 2 ChannelsFactor = ThePCMWaveFormatRecord.wf.nChannels - 1 WaveFormatConstantFromFormat = 2 (SampleRateFactor + ResolutionFactor + ChannelsFactor) End Function Function WaveFormalStringFromConstant(FormatNumber As Long) Dim Result As String Select Case FormatNumber Case WAVE_FORMAT_1M08 Result = "11.025 kHz, Mono, 8 bit" Case WAVE FORMATJS08 Result = "11.025 kHz, Stereo, 8 bit" Case WAVE FORMATJM16 Result = "11.025 kHz, Mono, 16 bit" Case WAVE FORMATJS16 Result = "11.025 kHz, Stereo, 16 bit" Case WAVEJORMAT _2M08 Result = "22.05 kHz, Mono, 8 bit" Case WAVE_FORMAT_2S08 Result = "22.05 kHz, Stereo, 8 bit" Case WAVE_FORMAT_2M16 Result = "22.05 kHz, Mono, 16 bit" Case WAVE_FORMAT_2S16 Result = "22.05 kHz, Stereo, 16 bit" Case WAVE_FORMAT_4M08 Result = "44.1 kHz, Mono, 8 bit" Case WAVE FORMAT 4S08 Result = "44.1 kHz, Stereo, 8 bit" Case WAVE_FORMAT_4M16 Result = "44.1 kHz, Mono, 16 bit" Case WAVE_FORMAT_4S16 Result = "44.1 kHz, Stereo, 16 bit" Case Else Result = "Invalid Wave Format" End Select WaveFormatStringFromConstant = Result End Function Function WaveFunctionStringFromConstant(FunctionNumber As Long) Dim Result As String Select Case FunctionNumber Case WAVECAPSJ TCH Result = "Pitch Control" Case WAVECAPSJ > LAYBACKRATE Result = "Playback Rate Control" Case WAVECAPSJ-/OLUME Result = "Volume Control" Case WAVECAPSJ..RVOLUME Result = "Separate Left-Right Volume Control" Case WAVECAPSJ YNC Result = "Synchronization" Case Else Result = "Invalid Function" End Select WaveFunctionStringFromConstant = Result End Function Sub WaveCloseForceO Dim ReturnCode As Long ReturnCode = waveOutPause(hWaveOut) ReturnCode = waveOutClose(hWaveOut) End Sub Sub WaveOutA () Dim ReturnCode As Long Dim ReturnCodel As Long Dim uData As Long Dim mtime As MMTIME ' Open the wave device. If bDownSpeed Then PCMWaveFmtRecord.wf.nSamplesPerSec = Int(PCMWaveFmtRecord.wf.nSamplesPerSec / 2) End If If bUpSpeed Then PCMWaveFmtRecord. wf.nSamplesPerSec = Int(PCMWaveFmtRecord.wf.nSamρlesPerSec * 2) End If ReturnCode = waveOutOpen(hWaveOut, WAVE MAPPER, PCMWaveFmtRecord, 0&, 0&, 0&) If ReturnCode = 0 Then ' Prepare the wave output header. ReturnCode = waveOutPrepareHeader(hWaveOut, WaveHeader, Len(WaveHeader)) If ReturnCode = 0 Then 'mtime.wType = TIME_MS ' ReturnCodel = waveOutGetPosition(hWaveOut, mtime, Len(mtime)) ' Write the wave data to the o.utput device. ReturnCode = waveOutWrite(hWaveOut, WaveHeader, Len(WaveHeader)) ' Wait until finished playing. If ReturnCode = 0 Then ' Dim ism Do Until (WaveHeader.dwFlags And WHDR DONE) DoEvents ' Debug.Print mtime.u Loop End If ' Unprepare the wave output header. ReturnCode = waveOutUnprepareHeader(hWaveOut, WaveHeader, Len (WaveHeader)) If ReturnCode <> 0 Then MsgBox "Unable to Unprepare Wave Header", MBJCONSTOP, "Wave Error" End If WaveHeader.dwFlags = 0 ' Close the wave device. ReturnCode = waveOutClose(hWaveOut) If ReturnCode <> 0 Then MsgBox "Unable to Close Wave Device", MBJCONSTOP, "Wave Error" End If Else ' Couldn't prepare the header, so close the device. MsgBox "Unable to Prepare Wave Header", 0, "Wave Error" ReturnCode = waveOutClose(hWaveOut) If ReturnCode <> 0 Then MsgBox "Unable to Close Wave Device", MBJCONSTOP, "Wave Error" End If End If Else ' Couldn't open the device so do nothing. MsgBox "Unable to Open Wave Device", MBJCONSTOP, "Wave Error" End If End Sub Sub SaveDiskO Dim iCounter As Long Dim Position As Long Dim TempValue As Integer Dim MonoEightBitSample As MonoEightBitSamples Dim StereoEightBitSample As StereoEightBitSamples Dim MonoSixteenBitSample As MonoSixteenBitSamples Dim StereoSixteenBitSample As StereoSixteenBitSamples Dim Templong As Long Dim StepSize As Integer Dim LevelFactor As Single Dim OutBreak As Long Dim argl As Integer Dim arg2 As Integer Dim arg3 As Long Dim arg4 As Integer Dim arg5 As Integer Dim argό As Long Open "c:\wavedata.dat" For Output As #2 StepSize = 100 LevelFactor = 1 ' MsgBox " buffersize= " + Str(WaveHeader.dwBufferLength) Select Case WaveFormatConstantFromFoπnat(PCMWaveFmtRecord) Case WAVE FORMATJM08, WAVEJORMAT 2M08, WAVE_FORMAT_4M08 ' Mono 8-bit Screen.MousePointer = 11 For Position = 0 To (WaveHeader.dwBufferLength - 1) Step StepSize Print #2, Str(CLng(WaveBuffer(Position))) Next Position Close #2 Screen.MousePointer = 0 Case WAVEJFORMATJS08, WAVE_FORMAT_2S08, WAVE_FORMAT_4S08 ' Stereo 8-bit Screen.MousePointer = 11 For Position = 0 To (WaveHeader.dwBufferLength - 2) Step StepSize * 2 Print #2, Str(CLng(WaveBuffer(Position))); Str(CLng(WaveBuffer(Position + 1))) Next Position Close #2 Screen.MousePointer = 0 Case WAVE FORMAT 1M16, WAVEJ^ORMATJiMlό, WAVE_FORMAT_4M16 ' Mono 16-bit Screen.MousePointer = 11 For Position = 0 To (WaveHeader.dwBufferLength - 2) Step 2 If Position = OutBreak Then argl = CInt(WaveBuffer(Position)) arg2 = CInt(WaveBuffer(Position + 1)) arg3 = BytesRead (argl, arg2) Print #2, arg3 OutBreak = StepSize * 2 + Position End If Next Position Close #2 Screen.MousePointer = 0 Case WAVE_FORMAT_lS16, WAVE_FORMAT_2S16, WAVE_FORMAT_4S16 ' Stereo 16-bit Screen.MousePointer = 11 For Position = 0 To (WaveHeader.dwBufferLength - 4) Step 4 Screen.MousePointer = 11 If Position = OutBreak Then 'Left Channel argl = CInt(WaveBuffer(Position)) arg2 = CInt(WaveBuffer(Position + 1)) arg3 = BytesRead (argl, arg2) 'Right Channel arg4 = CInt(WaveBuffer(Position + 2)) arg5 = CInt(WaveBuffer(Position + 3)) arg6 = BytesRead (argl, arg2) Print #2, arg3; arg6 OutBreak = StepSize * 4 + Position End If Next Position Close #2 Screen.MousePointer = 0 End Select ' close open file End Sub Sub SaveFileAsciiO Dim iCounter As Long Dim Position As Long Dim TempValue As Integer Dim MonoEightBitSample As MonoEightBitSamples Dim StereoEightBitSample As StereoEightBitSamples Dim MonoSixteenBitSample As MonoSixteenBitSamples Dim StereoSixteenBitSample As StereoSixteenBitSamples Dim Templong As Long Dim StepSize As Integer Dim LevelFactor As Single m OutBreak As Long m argl As Integer m arg2 As Integer m arg3 As Long m arg4 As Integer m arg5 As Integer m argό As Long LevelFactor = 1 Select Case WaveFormatConstantFromFormat(PCMWaveFmtRecord) Case WAVE FORMAT 1M08, WAVE FORMAT 2M08, WAVE FORMAT 4M08 ' Mono 8-bit Screen.MousePointer = 11 iCounter = 0 StepSize = giSampleSelectCoffe If StepSize < 1 Then MsgBox " Wrong way to reduce frequency ! " Screen.MousePointer = 0 GoTo LastLine End If gArrDimension = WaveHeader.dwBufferLength \ StepSize ReDim gSignalX(gArrDimension) For Position = 0 To (WaveHeader.dwBufferLength - 1) Step StepSize gSignalX(iCounter) = CDbl(WaveBuffer(Position)) iCounter = iCounter + 1 Next Position Screen.MousePointer = 0 Case WAVE_FORMAT_1S08, WAVEJORMAT_2S08, WAVE_FORMAT_4S08 ' Stereo 8-bit Screen.MousePointer = 11 iCounter = 0 StepSize = giSampleSelectCoffe If StepSize < 1 Then MsgBox " Wrong way to reduce frequency ! " Screen.MousePointer = 0 GoTo LastLine End If gArrDimension = WaveHeader.dwBufferLength \ (StepSize * 2) ReDim gSignalX(gArrDimension) ReDim gSignalY(gArrDimension) For Position = 0 To (WaveHeader.dwBufferLength - 2) Step StepSize * 2 gSignalX(iCounter) = CDbI(WaveBuffer(Position)) gSignalY(iCounter) = CDbl(WaveBuffer(Position + 1)) iCounter = iCounter + 1 Next Position Screen.MousePointer = 0 Case WAVE_FORMAT J M16, WAVEJORMAT_2M16. WAVE_FORMAT_4M16 ' Mono 16-bit Screen.MousePointer = 11 iCounter = 0 StepSize = giSampleSelectCoffe If StepSize < 1 Then MsgBox " Wrong way to reduce frequency ! " Screen.MousePointer = 0 GoTo LastLine End If gArrDimension = WaveHeader.dwBufferLength \ (StepSize * 2) ReDim gSignalX(gArrDimension) For Position = 0 To (WaveHeader.dwBufferLength - 2) Step StepSize * 2 argl = CInt(WaveBuffer(Position)) arg2 = CInt(WaveBuffer(Position + 1)) arg3 = BytesRead(argl, arg2) gSignalX(iCounter) = CDbl(arg3) iCounter = iCounter + 1 Next Position Screen.MousePointer = 0 Case WAVEJORMATJS16, WAVE FORMAT 2S16, WAVE_FORMAT_4S16 ' Stereo 16-bit Screen.MousePointer = 11 iCounter = 0 StepSize = giSampleSelectCoffe If StepSize < 1 Then MsgBox " Wrong way to reduce frequency !" Screen.MousePointer = 0 GoTo LastLine End If gArrDimension = WaveHeader.dwBufferLength \ (StepSize * 4) ReDim gSignalX (gArrDimension) ReDim gSignalY(gArrDimension) For Position = 0 To (WaveHeader.dwBufferLength - 4) Step StepSize * 4 'Left Channel argl = CInt(WaveBuffer(Position)) arg2 = CInt(WaveBuffer(Position + 1)) arg3 = BytesRead (argl, arg2) gSignalX(iCounter) = CDbl(arg3) 'Right Channel arg4 = CInt(WaveBuffer(Position + 2)) arg5 = CInt(WaveBuffer(Position + 3)) arg6 = BytesRead (arg4, arg5) gSignalY(iCounter) = CDbl(argό) iCounter = iCounter + 1 Next Position Screen.MousePointer = 0 End Select bAsciiFileSaved = True ' close open file ' MsgBox " buffersize in save file to ascii " + Str(WaveHeader.dwBufferLength) ' MsgBox "Step Size is = " & Str(StepSize) ' MsgBox "array dimension is = " & Str(gArrDimension) LastLine: End Sub Public Function BytesRead (ByVal argl As Integer, ByVal arg2 As Integer) As Long Dim arg3 As Long Dim iO As Integer Dim iPower(16) As Long Dim iRemainder(lό) As Integer Dim iCounter As Integer Dim iC As Integer iPower(O) = 1 If arg2 > 128 Then arg2 = 255 - arg2 iC = l End If For iCounter = 1 To 15 iPower(iCounter) = iPowerdCounter - 1) * 2 Next iCounter For iCounter = 0 To 7 iRemainder(iCounter) = argl Mod 2 iRemainder(8 + iCounter) = arg2 Mod 2 argl = argl \ 2 arg2 = arg2 \ 2 Next iCounter arg3 = 0 For iCounter = 0 To 14 arg3 = arg3 + iRemainder(iCounter) * iPower(iCounter) Next iCounter If iC = 1 Then arg3 = -arg3 End If BytesRead = arg3 End Function ' Module - AudioConfigure Sub MediaPropertiesO Dim T As Double On Error Resume Next T = Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl„0", 5) End Sub Sub SoundPropertiesO Dim RetumValue As Double On Error Resume Next RetumValue = Shell("sndrec32.exe", 5) AppActivate RetumValue SendKeys "%f", True SendKeys "o", True 'SendKeys "d:\music2.wav", True SendKeys gsFileName, True SendKeys "%o", True End Sub Sub volumePropertiesO Dim T As Double On Error Resume Next T = Shell("sndvol32.exe", 5) End Sub ********************************************************************** ' Module - ExcelSave Dim ExcelApp As Excel. Application Dim ExcelWorkbook As Excel. Workbook Dim ExcelSheetl As Excel. Worksheet Dim ExcelSheet2 As Excel. Worksheet Dim sFreqEx As Single Dim FSizeEx As Long Sub SaveToExcel(FreqEx As Single, FFTSize As Long) sFreqEx = FreqEx FSizeEx = FFTSize On Error GoTo activeXProblem Set ExcelApp = CreateObject("Excel. Application") Set ExcelWorkbook = ExcelApp. Workbooks. Add Set ExcelSheetl = ExcelWorkbook. Worksheets(l) Set ExcelSheet2 = ExcelWorkbook. Worksheets(2) ExcelApp. Visible = True CopyToExcel DrawExcelChart MsgBox "Save" ExcelSheet.Application.Quit activeXProblem: Set ExcelApp = Nothing Set ExcelWorkbook = Nothing Set ExcelSheet = Nothing End Sub Sub CopyToExcel () Dim i As Long ExcelSheetl.Range("$A$l:$G$l ").Font.Bold = True ' Defined area for the result on Sheet 1 ExcelSheetl. ColumnsC A"). Column Width = 12 ExcelSheetl.Columns("B").ColumnWidth = 12 ExcelSheetl.Columns("C").Column Width = 12 ExcelSheetl.Columns("D").ColumnWidth = 12 ExcelSheetl .Columns("E").ColumnWidth = 12 ExcelSheetl .Columns("F").Column Width = 12 ExcelSheetl. ColumnsC'G"). Column Width = 12 ExcelSheetl.Columns("H").ColumnWidth = 12 ExcelSheetl. Cells(l, 5) .Value = "Results" ExcelSheetl. Cells(2, 1) .Value = "Frequency" ExcelSheetl. Cells(2, 2).Value = "AutoSpecX" ExcelSheetl. Cells(2, 3) .Value = "Frequency" ExcelSheetl. Cells(2, 4) .Value = "AutoSpecY" ExcelSheetl. Cells(2, 5)Nalue = "Frequency" ExcelSheetl. Cells(2, 6) .Value = "Coherence" ExcelSheetl. Cells(2, 7) .Value = "Second" ExcelSheetl. Cells(2, 8)Nalue = "CrossCorre" ' input the resulte to cells For i = 0 To FSizeEx - 1 If i < FSizeEx / 2 Then ExcelSheetl. Cells(3 + i, 1) .Value = sFreqEx / CSng(FSizeEx) * i ExcelSheetl. Cells(3 + i, 2)Nalue = aveoutX(i) ExcelSheetl. Cells(3 + i, 3)Nalue = sFreqEx / CSng(FSizeEx) * i ExcelSheetl. Cells(3 + i, 4)Nalue = aveoutY(i) ExcelSheetl. Cells(3 + i, 5)Nalue = sFreqEx / CSng(FSizeEx) * i ExcelSheetl. Cells(3 + i, 6)Nalue = cohefunc(i) ExcelSheetl. Cells(3 + i, 7) .Value = -1 + 2 / CSng(FSizeEx) * i ExcelSheetl. Cells(3 + i, 8) .Value = CrossCorrelation(i).re Else ExcelSheetl. Cells(3 + i, 7) .Value = -1 + 2 / CSng(FSizeEx) * i ExcelSheetl. Cells(3 + i, 8) .Value = CrossCorrelation(i).re End If Next i End Sub Sub DrawExcelChartO Dim newChartObjAutoX As ChartObject Dim newChartObjAutoY As ChartObject Dim newChartObjCoheR As ChartObject Dim newChartObjCrosC As ChartObject Dim newChartAutoX As Chart Dim newChartAutoY As Chart Dim newChartCoheR As Chart Dim newChartCrosC As Chart Set newChartObjAutoX = ExcelSheet2.ChartObjects.Add(0, 0, 300, 200) Set newChartObjAutoY = ExcelSheet2.ChartObjects.Add(300, 0, 300, 200) Set newChartObjCoheR = ExcelSheet2.ChartObjects.Add(0, 200, 300, 200) Set newChartObjCrosC = ExcelSheet2.ChartObjects.Add(300, 200, 300, 200) Set newChartAutoX = newChartObjAutoX. Chart Set newChartAutoY = newChartObjAutoY. Chart Set newChartCoheR = newChartObjCoheR. Chart Set newChartCrosC = newChartObjCrosC. Chart Dim lastco As String Dim lastcolumnl As Long lastco = Str(CLng(FSizeEx / 2) - 1) lastcolumnl = CLng(FSizeEx) - 1 newChartAutoX.ChartWizard ExcelSheetl.Range("$A$3:$B$512"), xlLine, 2, xlColumns, 1, 1 , False, " Channel 1: AutoSpectra ", "Hz" newChartAutoY.ChartWizard ExcelSheetl.Range("$C$3:$D$512"), xlLine, 2, xlColumns, 1, 1, False, " Channel 2: AutoSpectra ", "Hz" newChartCoheR.ChartWizard ExcelSheetl.Range("$E$3:$F$512"), xlLine, 2, xlColumns, 1, 1, False, " Coherence ", "Hz" newChartCrosC.ChartWizard ExcelSheetl.Range("$G$3:$H$1026"), xlLine, 2, xlColumns, 1, 1, False, " Cross-Correlation ", "Second" End Sub ' Module - FFTPart Option Explicit Public Type cmplx re As Double im As Double End Type Public Type Signal time As Double Yvalue As Double End Type Public Function cadd(X As cmplx, Y As cmplx) As cmplx cadd.re = X.re + Y.re cadd.im = X.im + Y.im End Function Public Function csub(X As cmplx, Y As cmplx) As cmplx csub.re = X.re - Y.re csub.im = X.im - Y.im End Function Public Function cequ(X As cmplx) As cmplx cequ.re = X.re cequ.im = X.im End Function Public Function ccnj(X As cmplx) As cmplx ccnj.re = X.re ccnj.im = -X.im End Function Public Function cmul(X As cmplx, Y As cmplx) As cmplx cmul.re = X.re * Y.re - X.im * Y.im cmul.im = X.re * Y.im + X.im * Y.re End Function Public Function cdiv(X As cmplx, Y As cmplx) As cmplx cdiv.re = (X.re * Y.re + X.im * Y.im) / (Y.re " 2 + Y.im ' 2) cdiv.im = (X.im * Y.re - X.re * Y.im) / (Y.re ~ 2 + Y.im * 2) End Function Public Function cinv(X As cmplx) As cmplx cinv.re = X.re / (X.re A 2 + X.im * 2) cinv.i = -X.im / (X.re " 2 + X.im * 2) End Function Public Function cabs(X As cmplx) As Double cabs = Sqr(X.re " 2 + X.im * 2) End Function Public Function cexp(X As cmplx) As cmplx cexp.re = Exp(X.re) * Cos(X.im) cexp.im = Exp(X.re) * Sin(X.im) End Function Public Function cr2x(r As Double, X As Double) As cmplx cr2x.re = r cr2x.im = X End Function Public Function cupoKX As Double) As cmplx cupol.re = Cos(X) cupol.im = Sin(X) End Function Sub FFT(ArratIn() As cmplx, ArrayOutO As cmplx, FFTSize As Long, ChoiceFFT As Long) Dim j As Long, i As Long, m As Long Dim 1 As Long, nl As Long, n2 As Long Dim w As cmplx, T As cmplx Dim ix() As Long, n ax As Long ReDim ix (FFTSize) nmax = Int(Log(FFTSize) / Log(2) + 0.1) ix(l) = 1 For j = 1 To nmax - 1 For i = 0 To 2 A j - 1 ix(i) = 2 * ix(i) ix(2 * j + i) = ix(i) + 1 Next i Next j For i = 0 To FFTSize - 1 Arrayθut(i) = Arratln(ixd)) Next i n2 = l For 1 = 0 To nmax - 1 nl = n2 n2 = 2 * nl Forj = 0 To nl - 1 w = cr2x(Cos(2 * 3.1415926536 * j / n2), -ChoiceFFT * Sin(2 * 3.1415926536 * j / n2)) For i = 0 To FFTSize - 1 Step n2 m =j + i 4- nl T = cmuKw, Arrayθut(m)) Arrayθut(m) = csub(ArrayOut(j + i), T) ArrayOut(j + i) = cadd(ArrayOut(j + i), T) Next i Nextj Next 1 If ChoiceFFT = -1 Then For i = 0 To FFTSize - 1 ArrayOut(i).re = ArrayOut(i).re / FFTSize ArrayOut(i).im = ArrayOut(i).im / FFTSize Next i End If End Sub Public Function AutoSpec(X As cmplx) As Double AutoSpec = X.re 2 + X.im A 2 End Function Sub CrossSpec( Array FFTXO As cmplx, ArrayFFTYO As cmplx, ArrayCrossSO As cmplx, FFTSize As Long) Dim i As Long Dim tempArrayO As cmplx Dim eg As Double ReDim tempArray(FFTSize) ' eg = 1 / (FFTSize * FSample) cg = l For i = 0 To FFTSize - 1 tempArray(i) = ccnj(ArrayFFTX(i)) ArrayCrossS(i).re = eg * cmuKtempArray(i), ArrayFFTY(i)).re ArrayCrossS(i).im = eg * cmul(tempArray(i), ArrayFFTY(i)).im Next i End Sub Sub Coherence ( Array AiitoXO As Double, Array AutoYO As Double, ArrayCrossSO As cmplx, ArrayCohO As Double, FFTSize As Long) Dim i As Long For i = 0 To FFTSize - 1 ArrayCoh(i) = cabs(ArrayCrossSG)) * 2 / (ArrayAutoX(i) * ArrayAutoY(i)) Next i End Sub ' Module - FilterPart Dim bO As Single Dim bl As Single Dim b2 As Single Dim time As Single Dim bzero As Single Dim al (l 2) As Double Dim a2(12) As Double Dim f3c As Single Dim fc As Single Dim y2(7) As Double Dim y 1 (7) As Double Dim y0(7) As Double Sub BWFilter(Yin() As Double, YoutO As Double, HLOption As String, NumPoles As Integer, CutFreq As Single, nPoints As Long, sFreq As Single) Dim TInterval As Single TInterval = 1 / sFreq If HLOption = "HiPass" Then CutFreq = sFreq / 2 - CutFreq End If Call Coeff(NumPoles, TInterval, CutFreq, HLOption) Call LHPass(Yin(), YoutO, nPoints, NumPoles) End Sub Subroutine Coeff to generate coefficients for High&Low Pass tangent f iltes Inputs are: MM-the order of the filter (Number of poles which must be even) T-Sampling interval in second B-cutoff of the filter in Hz lhfilter=0 for lowpass; lhfiler=l for highpass Sub Coeff (MM As Integer, T As Single, B As Single, Ihfilter As String) Dim m As Integer Dim ml As Integer Dim i As Integer Dim fn As Integer Dim fang As Single Dim f As Single Dim ang As Double Dim fact As Double Dim sector As Double Dim wedge As Double im am As Double im bm As Double im ams As Double im den As Double im sSamp As Single If Ihfilter = "LowPass" Then 'Lowpass butterworht filter b0 = l# bl = 2# b2 = l# End If If Ihfilter = "HiPass" Then 'Highpass butterworht filter b0 = l# bl = -2# b2 = l# End If m = MM fang = 3.14159265 *B*T ang = CDbl(fang) fact = CDbKSin(ang)) / CDbl(Cos(ang)) ml =m - m 12 f=l# f n = m sector = CDbl(3.14159265) / fn wedge = sector / CDbl (2#) For i = 1 To ml f n = i - 1 ang = CDbl(fn) * sector + wedge am = fact * CDbl(Sin(ang)) bm = fact * CDbl(Cos(ang)) ams = am * am den = (CDbl(l#) + bm) A 2 + ams al(i) = -CDbl(2#) * ((CDbl(l#) - bm * bm) - ams) / den a2(i) = ((CDbl(l#) - bm) * 2 + ams) / den f = f*(l# + al(i)+a2(i))/4# Next i If Ihfilter = "HiPass' Then 'forh ghpass only For i = IToml al(i) = -al(i) Nexti End If bzero = f End Sub ' this sub implements a digital filter with up to 12 poles; 3 nonrecursive and 2 recursive terms are allowed Copy from hipass3.for from TOAP4.FOR Modified by alex wang Feb.10th 1999 Sub LHPass(Y() As Double, Yres() As Double, NL As Long, MPoles As Integer) Dim i As Long Dim k As Integer Dim kl As Integer Dim MM As Integer Dim yit As Double Dim yi As Double 'initia the front data For k = 1 To 7 y2(k) = 0 yl(k)=0 yθ(k) = 0 Nextk MM = MPoles - MPoles / 2 For i = 1 To NL yO(l) = Y(i) For k = 1 To MM kl = k + l yit = bO * yθ(k) + bl * yl(k) + b2 * y2(k) yi = yit - al (k) * yθ(kl) - a2(k) * yl(kl) If Abs(yi) < 0.0000001 Then yi = 0 End If y2(kl) = yl (kl) yl (kl) = y0(kl) y0(kl) = yi Next k y2(l) = yl(l) yl (l) = y0(l) Yres(i) = yi * CDbl(bzero) Next i End Sub ' Module - SignalShowAll Sub ResultShow(Yvalue() As Double, nPoints As Long, pic What As Object) Dim iLowerBoundX As Long Dim iUpperBoundX As Long Dim iLowerBoundY As Long Dim iUpperBoundY As Long Dim iCount As Long Dim iXl As Long Dim iYl As Long Dim iX2 As Long Dim iY2 As Long Dim MaxofYalue As Double Dim MinofYalue As Double Dim YTotal As Double Dim XvalueO As Double Dim Yscal As Double Dim Yadjust As Long ReDim Xvalue(nPoints) 'Clean all the graphics first picWhat.Cls ' sign x value MaxofYvalue = 0 MinofYvalue = 0 For iCount = 0 To nPoints - 1 Xvalue(iCount) = iCount / nPoints If Yvalue(iCount) > MaxofYvalue Then 'find the maximum value MaxofYvalue = Yvalue(iCount) End If If Yvalue(iCount) < MinofYvalue Then 'find the minimum value MinofYvalue = Yvalue(iCount) End If Next iCount If Abs(MaxofYvalue) < Abs(MinofYvalue) Then YTotal = 2 * Abs(MinofYvalue) Else YTotal = 2 * Abs(MaxofYvalue) End If If MinofYvalue >= 0 Then YTotal = MaxofYvalue End If picWhat.DrawWidth = 1 'Small size points pic What. ScaleMode = 3 ' Set ScaleMode to pixels. 'Setup an appropriate scale inside the Picture region picWhat.Scale (0, 0)-(1024, 500) With pic What iLowerBoundX = .ScaleLeft iUpperBoundX = .ScaleLeft + .ScaleWidth iLowerBoundY = .ScaleTop iUpperBoundY = .ScaleTop + .ScaleHeight End With ' set horizatal x iXl = iLowerBoundX iYl = iUpperBoundY / 2 iX2 = iUpperBoundX iY2 = iUpperBoundY / 2 'picWhat.ForeColor = QBColor(12) ' Set foreground color. 'picWhat.Line (iXl, iYl)-(iX2, iY2), , BF picWhat.ForeColor = QBColor(14) If MinofYvalue >= 0 Then Yadjust = 500 ' only for unsign data Else Yadjust = 500 / 2 ' for signed data End If For iCount = 0 To nPoints - 2 Step 1 ' set position iXl = (iUpperBoundX - iLowerBoundX) * Xvalue(iCount) + iLowerBoundX Yscal = CDbldUpperBoundY - iLowerBoundY) * CDbl(Yvalue(iCount)) / CDbl(YTotal) iYl = Yadjust - CLng(Yscal) + iLowerBoundY iX2 = (iUpperBoundX - iLowerBoundX) * XvaluedCount + 1) + iLowerBoundX Yscal = CDbldUpperBoundY - iLowerBoundY) * CDbl(Yvalue(iCount + 1)) / CDbl(YTotal) iY2 = Yadjust - CLng(Yscal) + iLowerBoundY picWhat.Line (iX2, iY2)-(iXl, iYl) ' Debug.Print iCount, iYl Next iCount End Sub ' Module - VolumeControl Public Const MMSYSERR NOERROR = 0 Public Const MAXPNAMELEN = 32 Public Const MIXER_LONG_NAME_CHARS = 64 Public Const MIXER_SHORT_NAME_CHARS = 16 Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3& Public Const MIXER J3ETCONTROLDETAILSF_VALUE = &H0& Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2& Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0& Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000& Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _ (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4) Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _ (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3) Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _ (MIXERLINE COMPONENTTYPE SRC FIRST 4- 2) Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000 Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000 Public Const MIXERCONTROL_CONTROLTYPE_FADER = _ (MIXERCONTROL_CT_CLASS_FADER Or _ MIXERCONTROL_CT UNITS UNSIGNED) Public Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE FADER + 1) Declare Function mixerClose Lib "winmm.dll" _ (ByVal hmx As Long) As Long Declare Function mixerGetControlDetails Lib "winmm.dll" Alias "mixerGetControlDetailsA" _ (ByVal hmxobj As Long, _ pmxcd As MIXERCONTROLDETAILS, _ ByVal fdwDetails As Long) As Long Declare Function mixerGetDevCaps Lib "winmm.dll" _ Alias "mixerGetDevCapsA" _ (ByVal uMxId As Long, _ ByVal pmxcaps As MIXERCAPS, _ ByVal cbmxcaps As Long) As Long Declare Function mixerGetID Lib "winmm.dll" _ (ByVal hmxobj As Long, _ pumxID As Long, _ ByVal fdwld As Long) As Long Declare Function mixerGetLineControls Lib "winmm.dll" _ Alias "mixerGetLineControlsA" _ (ByVal hmxobj As Long, _ pmxlc As MIXERLINECONTROLS, _ ByVal fdwControls As Long) As Long Declare Function mixerGetLinelnfo Lib "winmm.dll" _ Alias "mixerGetLinelnfoA" _ (ByVal hmxobj As Long, _ pmxl As MIXERLINE, _ ByVal fdwlnfo As Long) As Long Declare Function mixerGetNumDevs Lib "winmm.dll" () As Long Declare Function mixerMessage Lib "winmm.dll" _ (ByVal hmx As Long, _ ByVal uMsg As Long, _ ByVal dwParaml As Long, _ ByVal dwParam2 As Long) As Long Declare Function mixerOpen Lib "winmm.dll" _ (phmx As Long, _ ByVal uMxId As Long, _ ByVal dwCallback As Long, _ ByVal dwlnstance As Long, _ ByVal fdwOpen As Long) As Long Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, _ pmxcd As MIXERCONTROLDETAILS, _ ByVal fdwDetails As Long) As Long Declare Sub CopyStructFromPtr Lib "kernel32" _ Alias "RtlMoveMemory" _ (struct As Any, _ ByVal ptr As Long, ByVal cb As Long) Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal ptr As Long, _ struct As Any, _ ByVal cb As Long) Declare Function GlobalAUoc Lib "kcrnel32" _ (ByVal wFlags As Long, _ ByVal dwBytes As Long) As Long Declare Function GlobalLock Lib "kerne!32" (ByVal hmem As Long) As Long Declare Function GlobalFree Lib "kernel32" _ (ByVal hmem As Long) As Long Type MIXERCAPS wMid As Integer ' manufacturer id wPid As Integer ' product id vDriverVersion As Long ' version of the driver szPname As String * MAXPNAMELEN ' product name fdwSupport As Long ' misc. support bits cDestinations As Long ' count of destinations End Type Type MIXERCONTROL cbStruct As Long ' size in Byte of MIXERCONTROL dwControlID As Long ' unique control id for mixer device dwControlType As Long ' MIXERCONTROL_CONTROLTYPE_xxx fdwControI As Long ' MIXERCONTROL ONTROLF_xxx cMultipleltems As Long ' if MIXERCONTROL CONTROLF MULTIPLE set szShortName As String * MIXER_SHORT_NAME_CHARS ' short name of control szName As String * MIXER_LONG_NAME_CHARS ' long name of control Minimum As Long ' Minimum value Maximum As Long ' Maximum value reserved (10) As Long ' reserved structure space End Type Type MIXERCONTROLDETAILS cbStruct As Long ' size in Byte of MIXERCONTROLDETAILS dwControlID As Long ' control id to get/set details on cChannels As Long ' number of channels in paDetails array item As Long ' hwndOwner or cMultipleltems cbDetails As Long ' size of _one_ details_XX struct paDetails As Long ' pointer to array of details_XX structs End Type Type MIXERCONTROLDETAILS JJNSIGNED dwValue As Long ' value of the control End Type Type MIXERLINE cbStruct As Long ' size of MIXERLINE structure dwDestination As Long ' zero based destination index dwSource As Long ' zero based source index (if source) dwLinelD As Long ' unique line id for mixer device fdwLine As Long ' state/information about line dwUser As Long ' driver specific information dwComponentType As Long ' component type line connects to cChannels As Long ' number of channels line supports cConnections As Long ' number of connections (possible) cControls As Long ' number of controls at this line szShortName As String * MIXER _SHORT_NAME_CHARS szName As String * MIXER_LONG_NAME_CHARS dwType As Long dwDevicelD As Long wMid As Integer wPid As Integer vDriverVersion As Long szPname As String * MAXPNAMELEN End Type Type MIXERLINECONTROLS cbStruct As Long ' size in Byte of MIXERLINECONTROLS dwLinelD As Long ' line id (from MIXERLINE.dwLinelD) ' MIXER_GETLINECONTROLSF_ONEBYID or dwControl As Long ' MIXER J5ETLINECONTROLSF ONEBYTYPE cControls As Long ' count of controls pmxctrl points to cbmxctrl As Long ' size in Byte of _one_ MIXERCONTROL pamxctrl As Long ' pointer to first MIXERCONTROL array End Type Function GetVolumeControl(By Val hmixer As Long, _ ByVal componentType As Long, _ ByVal ctrlType As Long, _ ByRef mxc As MIXERCONTROL) As Boolean ' This function attempts to obtain a mixer control. Returns True if successful. Dim mxlc As MIXERLINECONTROLS Dim mxl As MIXERLINE Dim hmem As Long Dim re As Long mxl.cbStruct = Len(mxl) mxl.dwComponentType = componentType ' Obtain a line corresponding to the component type re = mixerGetLinelnfodimixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) If (MMSYSERR_NOERROR = re) Then mxlc.cbStruct = Len(mxlc) mxlc.dwLinelD = mxl.dwLinelD mxlc.dwControl = ctrlType mxlc.cControls = 1 mxlc.cbmxctrl = Len(mxc) ' Allocate a buffer for the control hmem = Global Alloc(&H40, Len(mxc)) mxlc.pamxctrl = GlobalLock(hmem) mxc. cbStruct = Len(mxc) ' Get the control re = mixerGetLineControls(hmixer, _ mxlc, _ MIXER JETLINECONTROLSFJDNEBYTYPE) If (MMSYSERR TOERROR = re) Then GetVolumeControI = True ' Copy the control into the destination structure CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc) Else GetVolumeControI = False End If GlobalFree (hmem) Exit Function End If GetVolumeControI = False End Function Function SetVolumeControl(ByVal hmixer As Long, _ mxc As MIXERCONTROL, _ ByVal volume As Long) As Boolean 'This function sets the value for a volume control. Returns True if successful Dim mxcd As MIXERCONTROLDETAILS Dim vol As MIXERCONTROLDETAILSJJNSIGNED mxcd. item = 0 mxcd.dwControlID = mxc.dwControlID mxcd. cbStruct = Len(mxcd) mxcd.cbDetails = Len(vol) ' Allocate a buffer for the control value buffer hmem = GlobalAlloc(&H40, Len(vol)) mxcd. paDetails = GlobalLock(hmem) mxcd. cChannels = 1 vol.dwValue = volume ' Copy the data into the control value buffer CopyPtrFromStruct mxcd. paDetails, vol, Len(vol) ' Set the control value re = mixerSetControlDetaiIs(hmixer, mxcd, _ MIXER_SETCONTROLDETAILSF_VALUE) GlobalFree (hmem) If (MMSYSERR JMOERROR = re) Then SetVolumeControl = True Else SetVolumeControl = False End If End Function

Claims: Claims What is claimed is: 1. A method of detecting leaks in pipes comprising the steps of: listening to a leak in a water pipe from a first location and from a second location simultaneously to provide first and second signals respectively, the first and second location separated by a known distance of pipe; and, calculating an impulse response over a finite range of frequencies based on the first and second signals and using the channel having a lower amplitude as the reference signal to determine a leak location within the pipe, the leak location a distance from the first location. 2. A method as defined in claim 1 wherein the finite range is range over which amplitude is non-negligeable 3. A method as defined in claim 2 comprising the step of automatically determining the range and analysing only that range within the leak signals. 4. A method as defined in claim 1 wherein the method is implemented in a personal computer having a sound circuit therein for digitising sound signals and for providing sound signals to speakers for playback of recorded sounds. 5. A method of detecting leaks in pipes comprising the steps of: listening to a leak in a water pipe from a first location and from a second location simultaneously to provide first and second signals respectively, the first and second location separated by a known distance of pipe; and, calculating a leak location within the pipe absent a step of filtering the signals to reduce a noise content of the signals. 6. A method as defined in claim 5 wherein the step of calculating is performed using a cross-correlation function. 7. A method as defined in claim 6 comprising the step of filtering a result of the cross correlation function. 8. A method as defined in claim 5 wherein the step of calculation includes the step of calculating an impulse response over finite range 9. A method of detecting leaks in pipes as defined in claim 8 wherein a reference channel is selected for the impulse response calculation as the leak signal having a lower amplitude in order to reduce effects of noise upon a result. 10. A method as defined in claim 5 wherein the step of listening is performed using an acoustic sensor coupled to a sound circuit within a personal computer. 11. A method as defined in claim 10 wherein the sound circuit is a commercially available sound card for providing sound functionality to the personal computer. 12. A method as defined in claim 10 wherein the sound circuit forms an integral part of the motherboard of the personal computer. 13. A method for determining the location of a leak in a pipe comprising the steps of: providing first and second sensor means operably connected to said conduit for generating signals related to sensing vibrations of said conduit; recording said signals as a function of time; determining the time difference between arrival of vibrations which generate signals at said first sensor means and said second sensor means, respectively, by subjecting a plurality of multiple point consecutive time records for each signal to fast Fourier transform analysis of the time domain data to produce auto spectra values of said first sensor signal, G aa . and said second sensor signal, G rr , respectively; calculating the cross spectra values, G ar , of the respective series of time records of said first and second signals, respectively; summing the auto spectra values and the cross spectra values aftά determining averages of each, respectively; calculating the impulse response over a finite range by determining the inverse Fourier transform of the ratio of the averaged cross spectra to the averaged auto spectra of at least one of said auto spectra over a finite range; determining a peak value of such resultant values from time=0 to determine said time difference; and determining the location of said event based on said time difference and the acoustic velocity of a stress wave in the pipe. 14. A method of detecting leaks in pipes as defined in claim 13 wherein a reference channel is selected for the impulse response calculation as the leak signal having a lower amplitude in order to reduce effects of noise upon a result. 15. A method as defined in claim 13 wherein the finite range is range over which amplitude is non-negligible. 16. A method as defined in claim 15 comprising the step of automatically determining the range and analysing only that range within the leak signals. 17. A method as defined in claim 13 wherein the method is implemented in a personal computer having a sound circuit therein for digitising sound signals and for providing sound signals to speakers for playback of recorded sounds. 18. A method of detecting leaks in pipes comprising the steps of: listening to a leak in a water pipe using an acoustic sensor to form leak signals from a first location and from a second location simultaneously to provide first and second signals respectively, the first and second location separated by a known distance of pipe; digitising the leak signals using a sound circuit within a personal computer, sound circuit introducing significant noise into the signals; and, calculating a leak location within the pipe using a method of calculation that reduces effects of the noise introduced by the sound circuit and absent a step of filtering the leak signals. 19. A method of detecting leaks in pipes as defined in claim 18 wherein the step of calculating a leak location is performed by performing a cross correlation between the leak signals and filtering the result. 20. A method of detecting leaks in pipes as defined in claim 19 wherein the result is filtered by the steps of iteratively filtering the result with different filters to determine a suitable peak from which to derive leak location data. 21. A method of detecting leaks in pipes as defined in claim 19 wherein the result is filtered by the steps of iteratively filtering the result with different filters and selecting a filtered result having a most pronounced peak indicative of a leak location. 22. A method of detecting leaks in pipes as defined in claim 18 wherein the step of calculating a leak location is performed by performing an impulse response function on the signals over finite range. 23. A method of detecting leaks in pipes as defined in claim 22 wherein a reference channel is selected as the leak signal having a lower amplitude in order to reduce effects of noise upon a result. 24. A method as defined in claim 18 wherein the sound circuit is a commercially available sound card for use in a personal computer including an analogue to digital converter and a digital to analogue converter. 25. A method as defined in claim 24 wherein the sound circuit is also for providing an audible output representative of the leak signal. 26. A method of detecting leaks in pipes comprising the steps of: listening to a leak in a water pipe using an acoustic sensor to form a leak signal from a first location to provide a first signal, digitising at a first sampling rate the leak signal using a sound circuit; and, playing the leak signal at a second different sampling rate than the rate at which it was digitised in order to shift sounds at inaudible frequencies to frequencies at which they are audible.

Inventors: HUNAIDI OSAMA, HUNAIDI, OSAMA
Applicants: CANADA NAT RES COUNCIL, HUNAIDI OSAMA, HUNAIDI, OSAMA, NATIONAL RESEARCH COUNCIL OF CANADA
Application year: 2001
Main classification: G01M
IPC codes: G01M3