大概是這樣的，就是在x-y坐標圖上有1448個點連接成的一條曲線
，然后因為有毛刺不是光順的，現在我要對這條曲線進行傅里葉光順，然后我在網上百度了2個程式 不知道哪個能用，還請高手幫我修改一下。占用你們一點點時間會幫我解決大問題謝謝。第一個程式
Public Function fft(ByRef Data() As Double) As Double()
ReDim ffft(128, 2) As Double
Dim length As Integer
length = UBound(Data, 1) + 1
' Dim numArray(length - 1, 2) As Double
Dim index As Integer
Dim num5 As Integer
Dim num6 As Integer
Dim num7 As Integer
Dim num10 As Integer
Dim num3 As Integer
Dim num2 As Integer
Dim num11 As Integer
Dim num9 As Integer
num9 = length
Dim num8 As Integer
num8 = CInt(Math.Log(CDbl(num9)) / Math.Log(2#))
Dim numArray2(128) As Double
Dim numArray3(128) As Double
Dim numArray4(128) As Double
Dim numArray5(128) As Double
For index = 0 To num9 - 1
numArray2(index) = Data(index)
numArray3(index) = 0#
Next
Dim a As Double
Dim num14 As Double
num14 = 6.28318530717959 / CDbl(num9)
index = 0
While index < (num9 \ 2)
numArray4(index) = Math.Sin(a)
numArray5(index) = Math.Cos(a)
a = a + num14
index = index + 1
Wend
num7 = num9
num3 = 1
For num2 = 1 To num8
num7 = num7 / 2
num6 = 0
For num11 = 1 To num3
num10 = 0
index = num6
While index <= ((num7 + num6) - 1)
num5 = index + num7
a = numArray2(index) - numArray2(num5)
num14 = numArray3(index) - numArray3(num5)
numArray2(index) = numArray2(index) + numArray2(num5)
numArray3(index) = numArray3(index) + numArray3(num5)
If num10 = 0 Then
numArray2(num5) = a
numArray3(num5) = num14
Else
numArray2(num5) = (a * numArray5(num10)) + (num14 * numArray4(num10))
numArray3(num5) = (num14 * numArray5(num10)) - (a * numArray4(num10))
End If
num10 = num10 + num3
index = index + 1
Wend
num6 = (num6 + num7) + num7
Next
num3 = num3 + num3
Next
num5 = num9 \ 2
For index = 1 To (num9 - 1)
num6 = num9
If num5 < index Then
Dim num12 As Double
num12 = numArray2(index)
numArray2(index) = numArray2(num5)
numArray2(num5) = num12
num12 = numArray3(index)
numArray3(index) = numArray3(num5)
numArray3(num5) = num12
End If
num6 = num6 / 2
Do While num5 >= num6
num5 = num5 - num6
num6 = num6 / 2
If num5 = 0 Then
Exit Do
End If
Loop
num5 = num5 + num6
Next
For index = 0 To num9 - 1
numArray(index, 0) = numArray2(index)
numArray(index, 1) = numArray3(index)
numArray(index, 2) = ((numArray2(index)) ^ 2# + (numArray3(index)) ^ 2#) ^ 0.5
Next
fft = numArray
End Function
第二個程式
表單上放一個picturebox，名稱改為picI_FFT。
在表單中輸入以下代碼
Option Explicit
'*模塊********************************************************
'FFT0 陣列下標以0開始
'AR() 資料實部 AI() 資料虛部
'N 資料點數，為2的整數次冪
'NI 變換方向 1為正變換，-1為反變換
'***************************************************************
Const fftIn = 128
Const Pi = 3.1415926
Public Function FFT0(AR() As Double, AI() As Double, N As Long, ni As Long)
Dim i As Long, j As Long, k As Long, L As Long, M As Long
Dim IP As Long, LE As Long
Dim L1 As Long, N1 As Long, N2 As Long
Dim SN As Double, TR As Double, TI As Double, WR As Double, WI As Double
Dim UR As Double, UI As Double, US As Double
M = NTOM(N)
N2 = N / 2
N1 = N - 1
SN = ni
j = 1
For i = 1 To N1
If i < j Then
TR = AR(j - 1)
AR(j - 1) = AR(i - 1)
AR(i - 1) = TR
TI = AI(j - 1)
AI(j - 1) = AI(i - 1)
AI(i - 1) = TI
End If
k = N2
While (k < j)
j = j - k
k = k / 2
Wend
j = j + k
Next i
For L = 1 To M
LE = 2 ^ L
L1 = LE / 2
UR = 1#
UI = 0#
WR = Cos(Pi / L1)
WI = SN * Sin(Pi / L1)
For j = 1 To L1
For i = j To N Step LE
IP = i + L1
TR = AR(IP - 1) * UR - AI(IP - 1) * UI
TI = AI(IP - 1) * UR + AR(IP - 1) * UI
AR(IP - 1) = AR(i - 1) - TR
AI(IP - 1) = AI(i - 1) - TI
AR(i - 1) = AR(i - 1) + TR
AI(i - 1) = AI(i - 1) + TI
Next i
US = UR
UR = US * WR - UI * WI
UI = UI * WR + US * WI
Next j
Next L
If SN <> -1 Then
For i = 1 To N
AR(i - 1) = AR(i - 1) / N
AI(i - 1) = AI(i - 1) / N
Next i
End If
End Function
Private Function NTOM(N As Long) As Long
Dim ND As Single
ND = N
NTOM = 0
While (ND > 1)
ND = ND / 2
NTOM = NTOM + 1
Wend
End Function
Private Sub Form_Load()
'*使用**********
Dim i As Integer
Dim xr(128) As Double
Dim xi(128) As Double
Dim IaIn(128) As Double
'賦值，IaIn(i)是采得的資料。
For i = 0 To 128
IaIn(i) = Sin(i) + 0.5 * Sin(10 * i)
xr(i) = 100 * IaIn(i)
xi(i) = 0
Next
'FFT變換
Call FFT0(xr(), xi(), 128, 1)
'繪圖
picI_FFT.Scale (0, 100)-(fftIn - 1, -10)
picI_FFT.DrawWidth = 2
For i = 0 To fftIn - 1
picI_FFT.Line (i, Abs(xr(i)))-(i + 1, Abs(xr(i + 1))), vbRed
' picI_FFT.Line (i, Abs(xi(i)))-(i + 1, Abs(xi(i + 1))), vbBlue
' picI_FFT.Line (i, (xr(i) * xr(i) + xi(i) * xi(i)) \ 128)-(i + 1, (xr(i + 1) * xr(i + 1) + xi(i + 1) * xi(i + 1)) \ 128), vbBlack
Next i
End Sub
uj5u.com熱心網友回復：
抗鋸齒的演算法有多種，VB 自己去實作有點本末倒置了，而且那個效率會降個數量級，當然視覺效果很好（線形稍微要粗點）追求簡易可以用dNet，它自帶抗鋸齒。
自己做也可以，就是使用計算顏色疊加的公式，具體演算法自己可以google
通用抗鋸齒演算法會用抽樣模擬，你這里可以使用距離陰影計算顏色分量。你不怕麻煩可以自己搞，很過癮的。
uj5u.com熱心網友回復：
但是現在要求就是要用VB做的，所以麻煩大哥幫我看一下上面我發的程式謝謝uj5u.com熱心網友回復：
呼叫GDIplus，僅供參考：Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromScan0 Lib "gdiplus" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, bitmap As Long) As Long
Private Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal color As Long, ByVal Width As Single, ByVal unit As Long, pen As Long) As Long
Private Declare Function GdipGetImageGraphicsContext Lib "gdiplus" (ByVal Image As Long, graphics As Long) As Long
Private Declare Function GdipDrawLine Lib "gdiplus" (ByVal graphics As Long, ByVal pen As Long, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Any) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipDeletePen Lib "gdiplus" (ByVal pen As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Sub Command1_Click()
Const PNGFile As String = "D:\1.png"
Const PixelFormat32bppARGB As Long = &H26200A
Const CLSID_PNG As String = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
Dim token As Long
Dim GpInput As GdiplusStartupInput
Dim ReturnValue As Long
Dim bitmap As Long
Dim graphics As Long
Dim pen As Long
Dim PngClsid(15) As Byte
Dim Params(7) As Long
'初始化GDI
GpInput.GdiplusVersion = 1
ReturnValue = GdiplusStartup(token, GpInput)
If ReturnValue <> 0 Then MsgBox "GDI初始化失敗": Exit Sub
'新建Bitmap
GdipCreateBitmapFromScan0 100, 100, 0, PixelFormat32bppARGB, ByVal 0, bitmap
'新建pen
GdipCreatePen1 &H80FF0000, 10, 0, pen '半透明的紅色
'畫線
GdipGetImageGraphicsContext bitmap, graphics
GdipDrawLine graphics, pen, 10, 20, 60, 70
'保存為PNG
CLSIDFromString StrPtr(CLSID_PNG), PngClsid(0)
GdipSaveImageToFile bitmap, StrPtr(PNGFile), PngClsid(0), Params(0)
'掃地作業
GdipDeletePen pen
GdipDeleteGraphics graphics
GdipDisposeImage bitmap
GdiplusShutdown token
End Sub
uj5u.com熱心網友回復：
你這個曲線圖比較簡單，直接用MSChart控制元件顯示好了。uj5u.com熱心網友回復：
MSChart控制元件也不光順吧。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/95295.html
標籤：API
上一篇：VBA使用WMI得到計算機的資訊