API tools faq
paste
Advertisement
Guest User

FFTW3.bas

a guest
Jul 31st, 2016
484
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 12.19 KB | None | 0 0
raw download clone embed print report
  1. Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  2. Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
  3. Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  4. Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Integer, ByRef prgpvarg As Long, ByRef pvargResult As Variant) As Long
  5.  
  6. Dim ProcAddresses As Collection
  7. Dim hDLL As Long
  8.  
  9.  
  10. Public Enum R2RTransformKinds
  11.     HalfComplexDFT = 0
  12.     HalfComplexIDFT = 1
  13.     DHT = 2
  14.     DCT1 = 3
  15.     DCT2 = 5
  16.     DCT3 = 4
  17.     DCT4 = 6
  18.     DST1 = 7
  19.     DST2 = 9
  20.     DST3 = 8
  21.     DST4 = 10
  22. End Enum
  23.  
  24.  
  25.  
  26. Public Sub InitFFTW()
  27.     hDLL = LoadLibrary("libfftw3-3.dll")
  28.     Set ProcAddresses = New Collection
  29.     With ProcAddresses
  30.         .Add GetProcAddress(hDLL, "fftw_plan_dft"), "fftw_plan_dft"
  31.         .Add GetProcAddress(hDLL, "fftw_plan_dft_1d"), "fftw_plan_dft_1d"
  32.         .Add GetProcAddress(hDLL, "fftw_plan_dft_2d"), "fftw_plan_dft_2d"
  33.         .Add GetProcAddress(hDLL, "fftw_plan_dft_3d"), "fftw_plan_dft_3d"
  34.         .Add GetProcAddress(hDLL, "fftw_plan_dft_r2c"), "fftw_plan_dft_r2c"
  35.         .Add GetProcAddress(hDLL, "fftw_plan_dft_r2c_1d"), "fftw_plan_dft_r2c_1d"
  36.         .Add GetProcAddress(hDLL, "fftw_plan_dft_r2c_2d"), "fftw_plan_dft_r2c_2d"
  37.         .Add GetProcAddress(hDLL, "fftw_plan_dft_r2c_3d"), "fftw_plan_dft_r2c_3d"
  38.         .Add GetProcAddress(hDLL, "fftw_plan_dft_c2r"), "fftw_plan_dft_c2r"
  39.         .Add GetProcAddress(hDLL, "fftw_plan_dft_c2r_1d"), "fftw_plan_dft_c2r_1d"
  40.         .Add GetProcAddress(hDLL, "fftw_plan_dft_c2r_2d"), "fftw_plan_dft_c2r_2d"
  41.         .Add GetProcAddress(hDLL, "fftw_plan_dft_c2r_3d"), "fftw_plan_dft_c2r_3d"
  42.         .Add GetProcAddress(hDLL, "fftw_plan_r2r"), "fftw_plan_r2r"
  43.         .Add GetProcAddress(hDLL, "fftw_plan_r2r_1d"), "fftw_plan_r2r_1d"
  44.         .Add GetProcAddress(hDLL, "fftw_plan_r2r_2d"), "fftw_plan_r2r_2d"
  45.         .Add GetProcAddress(hDLL, "fftw_plan_r2r_3d"), "fftw_plan_r2r_3d"
  46.         .Add GetProcAddress(hDLL, "fftw_execute"), "fftw_execute"
  47.         .Add GetProcAddress(hDLL, "fftw_execute_dft"), "fftw_execute_dft"
  48.         .Add GetProcAddress(hDLL, "fftw_execute_dft_r2c"), "fftw_execute_dft_r2c"
  49.         .Add GetProcAddress(hDLL, "fftw_execute_dft_c2r"), "fftw_execute_dft_c2r"
  50.         .Add GetProcAddress(hDLL, "fftw_execute_r2r"), "fftw_execute_r2r"
  51.         .Add GetProcAddress(hDLL, "fftw_destroy_plan"), "fftw_destroy_plan"
  52.         .Add GetProcAddress(hDLL, "fftw_cleanup"), "fftw_cleanup"
  53.     End With
  54. End Sub
  55.  
  56. Public Sub CloseFFTW()
  57.     FreeLibrary hDLL
  58.     hDLL = 0
  59.     Set ProcAddresses = Nothing
  60. End Sub
  61.  
  62. Private Function CallCDECL(ByVal FuncAddr As Long, ByRef Params() As Variant, ByVal ReturnType As VbVarType) As Variant
  63.     Dim ParamCount As Long
  64.     Dim ParamTypes() As Integer
  65.     Dim ParamPtrs() As Long
  66.     Dim n As Long
  67.    
  68.     ParamCount = UBound(Params) + 1
  69.     If ParamCount > 0 Then
  70.         ReDim ParamTypes(ParamCount - 1)
  71.         ReDim ParamPtrs(ParamCount - 1)
  72.         For n = 0 To ParamCount - 1
  73.             ParamTypes(n) = VarType(Params(n))
  74.             ParamPtrs(n) = VarPtr(Params(n))
  75.         Next n
  76.         DispCallFunc 0, FuncAddr, 1, ReturnType, ParamCount, ParamTypes(0), ParamPtrs(0), CallCDECL
  77.     Else
  78.         DispCallFunc 0, FuncAddr, 1, ReturnType, ParamCount, ByVal 0, ByVal 0&, CallCDECL
  79.     End If
  80. End Function
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87. Public Function PlanDFT(ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
  88.     Dim Params(6 - 1) As Variant
  89.     Params(0) = DimCount
  90.     Params(1) = VarPtr(DimSizes)
  91.     Params(2) = VarPtr(Src)
  92.     Params(3) = VarPtr(Dest)
  93.     Params(4) = Sign
  94.     Params(5) = Flags
  95.     PlanDFT = CallCDECL(ProcAddresses("fftw_plan_dft"), Params, vbLong)
  96. End Function
  97.  
  98. Public Function PlanDFT1D(ByVal Length As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
  99.     Dim Params(5 - 1) As Variant
  100.     Params(0) = Length
  101.     Params(1) = VarPtr(Src)
  102.     Params(2) = VarPtr(Dest)
  103.     Params(3) = Sign
  104.     Params(4) = Flags
  105.     PlanDFT1D = CallCDECL(ProcAddresses("fftw_plan_dft_1d"), Params, vbLong)
  106. End Function
  107.  
  108. Public Function PlanDFT2D(ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
  109.     Dim Params(5 - 1) As Variant
  110.     Params(0) = Height
  111.     Params(1) = Width
  112.     Params(2) = VarPtr(Src)
  113.     Params(3) = VarPtr(Dest)
  114.     Params(4) = Sign
  115.     Params(5) = Flags
  116.     PlanDFT2D = CallCDECL(ProcAddresses("fftw_plan_dft_2d"), Params, vbLong)
  117. End Function
  118.  
  119. Public Function PlanDFT3D(ByVal Depth As Long, ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Sign As Long, ByVal Flags As Long) As Long
  120.     Dim Params(7 - 1) As Variant
  121.     Params(0) = Depth
  122.     Params(1) = Height
  123.     Params(2) = Width
  124.     Params(3) = VarPtr(Src)
  125.     Params(4) = VarPtr(Dest)
  126.     Params(5) = Sign
  127.     Params(6) = Flags
  128.     PlanDFT3D = CallCDECL(ProcAddresses("fftw_plan_dft_3d"), Params, vbLong)
  129. End Function
  130.  
  131.  
  132.  
  133. Public Function PlanDFTR2C(ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  134.     Dim Params(5 - 1) As Variant
  135.     Params(0) = DimCount
  136.     Params(1) = VarPtr(DimSizes)
  137.     Params(2) = VarPtr(Src)
  138.     Params(3) = VarPtr(Dest)
  139.     Params(4) = Flags
  140.     PlanDFTR2C = CallCDECL(ProcAddresses("fftw_plan_dft_r2c"), Params, vbLong)
  141. End Function
  142.  
  143. Public Function PlanDFTR2C1D(ByVal Length As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  144.     Dim Params(4 - 1) As Variant
  145.     Params(0) = Length
  146.     Params(1) = VarPtr(Src)
  147.     Params(2) = VarPtr(Dest)
  148.     Params(3) = Flags
  149.     PlanDFTR2C1D = CallCDECL(ProcAddresses("fftw_plan_dft_r2c_1d"), Params, vbLong)
  150. End Function
  151.  
  152. Public Function PlanDFTR2C2D(ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  153.     Dim Params(5 - 1) As Variant
  154.     Params(0) = Height
  155.     Params(1) = Width
  156.     Params(2) = VarPtr(Src)
  157.     Params(3) = VarPtr(Dest)
  158.     Params(4) = Flags
  159.     PlanDFTR2C2D = CallCDECL(ProcAddresses("fftw_plan_dft_r2c_2d"), Params, vbLong)
  160. End Function
  161.  
  162. Public Function PlanDFTR2C3D(ByVal Depth As Long, ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  163.     Dim Params(6 - 1) As Variant
  164.     Params(0) = Depth
  165.     Params(1) = Height
  166.     Params(2) = Width
  167.     Params(3) = VarPtr(Src)
  168.     Params(4) = VarPtr(Dest)
  169.     Params(5) = Flags
  170.     PlanDFTR2C3D = CallCDECL(ProcAddresses("fftw_plan_dft_r2c_3d"), Params, vbLong)
  171. End Function
  172.  
  173.  
  174.  
  175. Public Function PlanDFTC2R(ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  176.     Dim Params(5 - 1) As Variant
  177.     Params(0) = DimCount
  178.     Params(1) = VarPtr(DimSizes)
  179.     Params(2) = VarPtr(Src)
  180.     Params(3) = VarPtr(Dest)
  181.     Params(4) = Flags
  182.     PlanDFTC2R = CallCDECL(ProcAddresses("fftw_plan_dft_c2r"), Params, vbLong)
  183. End Function
  184.  
  185. Public Function PlanDFTC2R1D(ByVal Length As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  186.     Dim Params(4 - 1) As Variant
  187.     Params(0) = Length
  188.     Params(1) = VarPtr(Src)
  189.     Params(2) = VarPtr(Dest)
  190.     Params(3) = Flags
  191.     PlanDFTC2R1D = CallCDECL(ProcAddresses("fftw_plan_dft_c2r_1d"), Params, vbLong)
  192. End Function
  193.  
  194. Public Function PlanDFTC2R2D(ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  195.     Dim Params(5 - 1) As Variant
  196.     Params(0) = Height
  197.     Params(1) = Width
  198.     Params(2) = VarPtr(Src)
  199.     Params(3) = VarPtr(Dest)
  200.     Params(4) = Flags
  201.     PlanDFTC2R2D = CallCDECL(ProcAddresses("fftw_plan_dft_c2r_2d"), Params, vbLong)
  202. End Function
  203.  
  204. Public Function PlanDFTC2R3D(ByVal Depth As Long, ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal Flags As Long) As Long
  205.     Dim Params(6 - 1) As Variant
  206.     Params(0) = Depth
  207.     Params(1) = Height
  208.     Params(2) = Width
  209.     Params(3) = VarPtr(Src)
  210.     Params(4) = VarPtr(Dest)
  211.     Params(5) = Flags
  212.     PlanDFTC2R3D = CallCDECL(ProcAddresses("fftw_plan_dft_c2r_3d"), Params, vbLong)
  213. End Function
  214.  
  215.  
  216.  
  217. Public Function PlanR2R(ByVal DimCount As Long, ByRef DimSizes As Long, ByRef Src As Double, ByRef Dest As Double, ByRef TransformKinds As R2RTransformKinds, ByVal Flags As Long) As Long
  218.     Dim Params(6 - 1) As Variant
  219.     Params(0) = DimCount
  220.     Params(1) = VarPtr(DimSizes)
  221.     Params(2) = VarPtr(Src)
  222.     Params(3) = VarPtr(Dest)
  223.     Params(4) = VarPtr(TransformKinds)
  224.     Params(5) = Flags
  225.     PlanR2R = CallCDECL(ProcAddresses("fftw_plan_r2r"), Params, vbLong)
  226. End Function
  227.  
  228. Public Function PlanR2R1D(ByVal Length As Long, ByRef Src As Double, ByRef Dest As Double, ByVal TransformKind As R2RTransformKinds, ByVal Flags As Long) As Long
  229.     Dim Params(5 - 1) As Variant
  230.     Params(0) = Length
  231.     Params(1) = VarPtr(Src)
  232.     Params(2) = VarPtr(Dest)
  233.     Params(3) = TransformKind
  234.     Params(4) = Flags
  235.     PlanR2R1D = CallCDECL(ProcAddresses("fftw_plan_r2r_1d"), Params, vbLong)
  236. End Function
  237.  
  238. Public Function PlanR2R2D(ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal TransformKindH As R2RTransformKinds, ByVal TransformKindW As R2RTransformKinds, ByVal Flags As Long) As Long
  239.     Dim Params(7 - 1) As Variant
  240.     Params(0) = Height
  241.     Params(1) = Width
  242.     Params(2) = VarPtr(Src)
  243.     Params(3) = VarPtr(Dest)
  244.     Params(4) = TransformKindH
  245.     Params(5) = TransformKindW
  246.     Params(6) = Flags
  247.     PlanR2R2D = CallCDECL(ProcAddresses("fftw_plan_r2r_2d"), Params, vbLong)
  248. End Function
  249.  
  250. Public Function PlanR2R3D(ByVal Depth As Long, ByVal Height As Long, Width As Long, ByRef Src As Double, ByRef Dest As Double, ByVal TransformKindD As R2RTransformKinds, ByVal TransformKindH As R2RTransformKinds, ByVal TransformKindW As R2RTransformKinds, ByVal Flags As Long) As Long
  251.     Dim Params(9 - 1) As Variant
  252.     Params(0) = Depth
  253.     Params(1) = Height
  254.     Params(2) = Width
  255.     Params(3) = VarPtr(Src)
  256.     Params(4) = VarPtr(Dest)
  257.     Params(5) = TransformKindD
  258.     Params(6) = TransformKindH
  259.     Params(7) = TransformKindW
  260.     Params(8) = Flags
  261.     PlanR2R3D = CallCDECL(ProcAddresses("fftw_plan_r2r_3d"), Params, vbLong)
  262. End Function
  263.  
  264.  
  265.  
  266. Public Sub FFTWExecute(ByVal Plan As Long)
  267.     Dim Params(0) As Variant
  268.     Params(0) = Plan
  269.     CallCDECL ProcAddresses("fftw_execute"), Params(), vbEmpty
  270. End Sub
  271.  
  272. Public Sub FFTWExecuteDFT(ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
  273.     Dim Params(3 - 1) As Variant
  274.     Params(0) = Plan
  275.     Params(1) = VarPtr(Src)
  276.     Params(2) = VarPtr(Dest)
  277.     CallCDECL ProcAddresses("fftw_execute_dft"), Params(), vbEmpty
  278. End Sub
  279.  
  280. Public Sub FFTWExecuteDFTR2C(ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
  281.     Dim Params(3 - 1) As Variant
  282.     Params(0) = Plan
  283.     Params(1) = VarPtr(Src)
  284.     Params(2) = VarPtr(Dest)
  285.     CallCDECL ProcAddresses("fftw_execute_dft_r2c"), Params(), vbEmpty
  286. End Sub
  287.  
  288. Public Sub FFTWExecuteDFTC2R(ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
  289.     Dim Params(3 - 1) As Variant
  290.     Params(0) = Plan
  291.     Params(1) = VarPtr(Src)
  292.     Params(2) = VarPtr(Dest)
  293.     CallCDECL ProcAddresses("fftw_execute_dft_c2r"), Params(), vbEmpty
  294. End Sub
  295.  
  296. Public Sub FFTWExecuteR2R(ByVal Plan As Long, ByRef Src As Double, ByRef Dest As Double)
  297.     Dim Params(3 - 1) As Variant
  298.     Params(0) = Plan
  299.     Params(1) = VarPtr(Src)
  300.     Params(2) = VarPtr(Dest)
  301.     CallCDECL ProcAddresses("fftw_execute_r2r"), Params(), vbEmpty
  302. End Sub
  303.  
  304.  
  305.  
  306. Public Sub FFTWDestroyPlan(ByVal Plan As Long)
  307.     Dim Params(0) As Variant
  308.     Params(0) = Plan
  309.     CallCDECL ProcAddresses("fftw_destroy_plan"), Params(), vbEmpty
  310. End Sub
  311.  
  312. Public Sub FFTWCleanup()
  313.     Dim Params(-1 To -1) As Variant
  314.     CallCDECL ProcAddresses("fftw_cleanup"), Params(), vbEmpty
  315. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!