Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
PCM_MATH_FFT_Class.cls
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 26.02.2009 20:01:53 |
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "PCMM_FFT_Class"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Type Sample
Real As Double
Imag As Double
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Const HIGH_PRIORITY_CLASS As Long = &H80
Private Const MCHex As String = "31 C0 8B 54 24 08 8B 4C 24 0C 67 E3 06 D1 DA 11 C0 E2 FA 8B 54 24 10 89 02 C2 10 00"
Private Const MirrorOffset As Long = 28 + 4 * 10
Private PrevPrioCls As Long
Private MCBin() As Byte
Private UBSamples As Long
Private NumBits As Long
Private StageSize As Long
Private NumButter As Long
Private i As Long
Private j As Long
Private k As Long
Private l As Long
Private Pi As Double
Private tmp As Double
Private UnknownSize As Boolean
Private NeedsDoing As Boolean
Private myReverse As Boolean
Private S As Sample
Private T As Sample
Private U As Sample
Private ValuesIn() As Sample
Private ValuesOut() As Sample
Private Sub Class_Initialize()
On Error Resume Next
Dim hx() As String
Dim VTableAddress As Long
Dim CodeAddress As Long
UnknownSize = True
ReDim ValuesIn(0)
ReDim ValuesOut(0)
NeedsDoing = True
hx = Split(MCHex, " ")
ReDim MCBin(0 To UBound(hx))
For i = 0 To UBound(hx)
MCBin(i) = Val("&H" & hx(i))
Next i
CodeAddress = VarPtr(MCBin(0))
MemCopy VarPtr(VTableAddress), ObjPtr(Me), 4
MemCopy VTableAddress + MirrorOffset, VarPtr(CodeAddress), 4
End Sub
Public Property Get ComplexOut(Index As Long) As Double
On Error Resume Next
With GetIt(Index)
ComplexOut = Sqr(.Real * .Real + .Imag * .Imag)
End With
End Property
Private Function GetIt(Index As Long) As Sample
On Error Resume Next
If UnknownSize Or Index < 1 Or Index > UBound(ValuesIn) + 1 Then
Else
If NeedsDoing Then
NeedsDoing = False
PrevPrioCls = GetPriorityClass(GetCurrentProcess)
SetPriorityClass GetCurrentProcess, HIGH_PRIORITY_CLASS
Pi = 4 * Atn(1)
If myReverse Then Pi = -Pi
UBSamples = UBound(ValuesIn)
NumBits = Log(UBSamples + 1) / Log(2)
For i = 0 To UBSamples
ValuesOut(Mirror(i, NumBits)) = ValuesIn(i)
Next i
StageSize = 1
Do
NumButter = StageSize
StageSize = NumButter * 2
T.Real = Pi / NumButter
S.Real = Sin(T.Real / 2)
S.Real = 2 * S.Real * S.Real
S.Imag = Sin(T.Real)
For i = 0 To UBSamples Step StageSize
U.Real = 1
U.Imag = 0
For j = i To i + NumButter - 1
k = j + NumButter
With ValuesOut(k)
T.Real = U.Real * .Real - U.Imag * .Imag
T.Imag = U.Imag * .Real + U.Real * .Imag
.Real = ValuesOut(j).Real - T.Real
.Imag = ValuesOut(j).Imag - T.Imag
End With
With ValuesOut(j)
.Real = .Real + T.Real
.Imag = .Imag + T.Imag
End With
tmp = S.Real * U.Real + S.Imag * U.Imag
U.Imag = U.Imag - (S.Real * U.Imag - S.Imag * U.Real)
U.Real = U.Real - tmp
Next
Next
Loop Until StageSize > UBSamples
If myReverse Then
tmp = UBSamples + 1
For i = 0 To UBSamples
With ValuesOut(i)
.Real = .Real / tmp
.Imag = .Imag / tmp
End With
Next i
End If
SetPriorityClass GetCurrentProcess, PrevPrioCls
End If
GetIt = ValuesOut(Index - 1)
End If
End Function
Public Property Let ImagIn(Index As Long, nuValueIn As Double)
On Error Resume Next
If UnknownSize Or Index < 1 Or Index > UBound(ValuesIn) + 1 Then
Else
ValuesIn(Index - 1).Imag = nuValueIn
NeedsDoing = True
End If
End Property
Public Property Get ImagOut(Index As Long) As Double
On Error Resume Next
ImagOut = GetIt(Index).Imag
End Property
Private Function Mirror(ByVal Index As Long, ByVal NumBits As Long) As Long
On Error Resume Next
Mirror = 0
End Function
Public Property Let NumberOfSamples(nuNumSam As Long)
On Error Resume Next
If nuNumSam > 1 And (nuNumSam - 1 And nuNumSam) = 0 Then
ReDim ValuesIn(0 To nuNumSam - 1)
ReDim ValuesOut(0 To nuNumSam - 1)
UnknownSize = False
NeedsDoing = True
End If
End Property
Public Property Let RealIn(Index As Long, nuValueIn As Double)
On Error Resume Next
If UnknownSize Or Index < 1 Or Index > UBound(ValuesIn) + 1 Then
Else
ValuesIn(Index - 1).Real = nuValueIn
NeedsDoing = True
End If
End Property
Public Property Get RealOut(Index As Long) As Double
On Error Resume Next
RealOut = GetIt(Index).Real
End Property
Public Property Let TransformReverse(nuReverse As Boolean)
On Error Resume Next
myReverse = CBool(nuReverse)
End Property